ENH use latest dhall commit

This commit is contained in:
Nathan Dwarshuis 2023-04-16 20:09:13 -04:00
parent ae4f5795f8
commit 8c5a68a4b4
5 changed files with 64 additions and 49 deletions

View File

@ -81,19 +81,19 @@ library
, dhall >=1.41.2 , dhall >=1.41.2
, esqueleto , esqueleto
, filepath , filepath
, ghc >=9.0.2 , ghc
, hashable , hashable >=1.3.4.0
, lens >=5.0.1 , lens
, monad-logger >=0.3.36 , monad-logger >=0.3.36
, mtl , mtl
, optparse-applicative , optparse-applicative
, persistent >=2.13.3.1 , persistent >=2.13.3.1
, persistent-sqlite >=2.13.1.0 , persistent-sqlite
, recursion-schemes , recursion-schemes
, regex-tdfa , regex-tdfa
, rio >=0.1.21.0 , rio >=0.1.21.0
, template-haskell , template-haskell <=2.16.0.0
, text >=1.2.5.0 , text
, time >=1.9.3 , time >=1.9.3
default-language: Haskell2010 default-language: Haskell2010
@ -150,18 +150,18 @@ executable pwncash
, dhall >=1.41.2 , dhall >=1.41.2
, esqueleto , esqueleto
, filepath , filepath
, ghc >=9.0.2 , ghc
, hashable , hashable >=1.3.4.0
, lens >=5.0.1 , lens
, monad-logger >=0.3.36 , monad-logger >=0.3.36
, mtl , mtl
, optparse-applicative , optparse-applicative
, persistent >=2.13.3.1 , persistent >=2.13.3.1
, persistent-sqlite >=2.13.1.0 , persistent-sqlite
, recursion-schemes , recursion-schemes
, regex-tdfa , regex-tdfa
, rio >=0.1.21.0 , rio >=0.1.21.0
, template-haskell , template-haskell <=2.16.0.0
, text >=1.2.5.0 , text
, time >=1.9.3 , time >=1.9.3
default-language: Haskell2010 default-language: Haskell2010

View File

@ -7,7 +7,6 @@ where
import Data.Hashable import Data.Hashable
import Database.Persist.Class import Database.Persist.Class
import Database.Persist.Sql hiding (Single, Statement) import Database.Persist.Sql hiding (Single, Statement)
import GHC.Utils.Misc hiding (split)
import Internal.Statement import Internal.Statement
import Internal.Types hiding (sign) import Internal.Types hiding (sign)
import Internal.Utils import Internal.Utils

View File

@ -27,8 +27,10 @@ module Internal.Utils
, showT , showT
, lookupErr , lookupErr
, gregorians , gregorians
-- , uncurry3 , uncurry3
, fstOf3
, sndOf3
, thdOf3
, xGregToDay , xGregToDay
, plural , plural
, compileMatch , compileMatch
@ -318,23 +320,24 @@ acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
-- error display -- error display
showError :: InsertError -> [T.Text] showError :: InsertError -> [T.Text]
showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms) showError other = case other of
showError other = (: []) $ case other of (StatementError ts ms) -> (showTx <$> ts) ++ (showMatch <$> ms)
(BoundsError a b) -> (BoundsError a b) ->
T.unwords ["Could not create bounds from", showGregorian_ a, "and", showGreg b] [T.unwords ["Could not create bounds from", showGregorian_ a, "and", showGreg b]]
where where
showGreg (Just g) = showGregorian_ g showGreg (Just g) = showGregorian_ g
showGreg Nothing = "Inf" showGreg Nothing = "Inf"
(AccountError a ts) -> (AccountError a ts) ->
T.unwords [ T.unwords
[ "account type of key" [ "account type of key"
, singleQuote a , singleQuote a
, "is not one of:" , "is not one of:"
, ts_ , ts_
] ]
]
where where
ts_ = T.intercalate ", " $ NE.toList $ fmap atName ts ts_ = T.intercalate ", " $ NE.toList $ fmap atName ts
(PatternError s b r p) -> T.unwords [msg, "in pattern: ", pat] (PatternError s b r p) -> [T.unwords [msg, "in pattern: ", pat]]
where where
pat = pat =
keyVals $ keyVals $
@ -348,14 +351,14 @@ showError other = (: []) $ case other of
msg = case p of msg = case p of
ZeroLength -> "Zero repeat length" ZeroLength -> "Zero repeat length"
ZeroRepeats -> "Zero repeats" ZeroRepeats -> "Zero repeats"
(RegexError re) -> T.append "could not make regex from pattern: " re (RegexError re) -> [T.append "could not make regex from pattern: " re]
(ConversionError x) -> T.append "Could not convert to rational number: " x (ConversionError x) -> [T.append "Could not convert to rational number: " x]
(InsertIOError msg) -> T.append "IO Error: " msg (InsertIOError msg) -> [T.append "IO Error: " msg]
(ParseError msg) -> T.append "Parse Error: " msg (ParseError msg) -> [T.append "Parse Error: " msg]
(MatchValPrecisionError d p) -> (MatchValPrecisionError d p) ->
T.unwords ["Match denominator", showT d, "must be less than", showT p] [T.unwords ["Match denominator", showT d, "must be less than", showT p]]
(LookupError t f) -> (LookupError t f) ->
T.unwords ["Could not find field", f, "when resolving", what] [T.unwords ["Could not find field", f, "when resolving", what]]
where where
what = case t of what = case t of
SplitIDField st -> T.unwords ["split", idName st, "ID"] SplitIDField st -> T.unwords ["split", idName st, "ID"]
@ -369,15 +372,16 @@ showError other = (: []) $ case other of
matchName MatchNumeric = "numeric" matchName MatchNumeric = "numeric"
matchName MatchText = "text" matchName MatchText = "text"
(IncomeError dp) -> (IncomeError dp) ->
T.append "Income allocations exceed total: datepattern=" $ showT dp [T.append "Income allocations exceed total: datepattern=" $ showT dp]
(BalanceError t cur rss) -> (BalanceError t cur rss) ->
T.unwords [ T.unwords
[ msg [ msg
, "for currency" , "for currency"
, singleQuote cur , singleQuote cur
, "and for splits" , "and for splits"
, splits , splits
] ]
]
where where
msg = case t of msg = case t of
TooFewSplits -> "Need at least two splits to balance" TooFewSplits -> "Need at least two splits to balance"
@ -572,6 +576,15 @@ merge = first concat
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (a, b, c) = f a b c uncurry3 f (a, b, c) = f a b c
fstOf3 :: (a, b, c) -> a
fstOf3 (a, _, _) = a
sndOf3 :: (a, b, c) -> b
sndOf3 (_, b, _) = b
thdOf3 :: (a, b, c) -> c
thdOf3 (_, _, c) = c
-- lpad :: a -> Int -> [a] -> [a] -- lpad :: a -> Int -> [a] -> [a]
-- lpad c n s = replicate (n - length s) c ++ s -- lpad c n s = replicate (n - length s) c ++ s

View File

@ -67,20 +67,20 @@ dependencies:
- base >= 4.12 && < 10 - base >= 4.12 && < 10
- rio >= 0.1.21.0 - rio >= 0.1.21.0
- persistent >= 2.13.3.1 - persistent >= 2.13.3.1
- persistent-sqlite >= 2.13.1.0 - persistent-sqlite
- monad-logger >= 0.3.36 - monad-logger >= 0.3.36
- conduit >= 1.3.4.2 - conduit >= 1.3.4.2
- dhall >= 1.41.2 - dhall >= 1.41.2
- lens >= 5.0.1 - lens
- text >= 1.2.5.0 - text
- time >= 1.9.3 - time >= 1.9.3
- containers >= 0.6.4.1 - containers >= 0.6.4.1
- ghc >= 9.0.2 - ghc
- cassava - cassava
- regex-tdfa - regex-tdfa
- esqueleto - esqueleto
- template-haskell - template-haskell <= 2.16.0.0
- hashable - hashable >= 1.3.4.0
- optparse-applicative - optparse-applicative
- recursion-schemes - recursion-schemes
- data-fix - data-fix

View File

@ -20,7 +20,7 @@
# this resolver has persistent < version 2.13.3.4 which introduced a nasty # this resolver has persistent < version 2.13.3.4 which introduced a nasty
# name shadow bug # name shadow bug
resolver: lts-20.9 resolver: lts-18.28
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
@ -39,10 +39,13 @@ resolver: lts-20.9
# #
extra-deps: extra-deps:
# this version isn't on the LTS yet and has an instance for DayOfWeek # this version isn't on the LTS yet and has an instance for DayOfWeek
- dhall-1.41.2@sha256:556edac8997a5fcf451c9bbb151b1f04996318019799724cc71cc03a9a9122be,16281 # - dhall-1.41.2@sha256:556edac8997a5fcf451c9bbb151b1f04996318019799724cc71cc03a9a9122be,16281
- persistent-2.13.3.3@sha256:49dd5f7dc7bbd62390d95b749df29971ce84e410e1db58bceaef5a175366e840,6762 - persistent-2.13.3.3@sha256:49dd5f7dc7bbd62390d95b749df29971ce84e410e1db58bceaef5a175366e840,6762
# - git: https://github.com/commercialhaskell/stack.git # - template-haskell-2.16.0.0
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a - git: https://github.com/dhall-lang/dhall-haskell.git
commit: ffd1ba94ef39b875aba8adc1c498f28aa02e36e4
subdirs: [dhall]
- hashable-1.3.5.0
# #
# extra-deps: [] # extra-deps: []