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

View File

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

View File

@ -27,8 +27,10 @@ module Internal.Utils
, showT
, lookupErr
, gregorians
-- , uncurry3
, uncurry3
, fstOf3
, sndOf3
, thdOf3
, xGregToDay
, plural
, compileMatch
@ -318,23 +320,24 @@ acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
-- error display
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) ->
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
showGreg (Just g) = showGregorian_ g
showGreg Nothing = "Inf"
(AccountError a ts) ->
T.unwords
[ T.unwords
[ "account type of key"
, singleQuote a
, "is not one of:"
, ts_
]
]
where
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
pat =
keyVals $
@ -348,14 +351,14 @@ showError other = (: []) $ case other of
msg = case p of
ZeroLength -> "Zero repeat length"
ZeroRepeats -> "Zero repeats"
(RegexError re) -> T.append "could not make regex from pattern: " re
(ConversionError x) -> T.append "Could not convert to rational number: " x
(InsertIOError msg) -> T.append "IO Error: " msg
(ParseError msg) -> T.append "Parse Error: " msg
(RegexError re) -> [T.append "could not make regex from pattern: " re]
(ConversionError x) -> [T.append "Could not convert to rational number: " x]
(InsertIOError msg) -> [T.append "IO Error: " msg]
(ParseError msg) -> [T.append "Parse Error: " msg]
(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) ->
T.unwords ["Could not find field", f, "when resolving", what]
[T.unwords ["Could not find field", f, "when resolving", what]]
where
what = case t of
SplitIDField st -> T.unwords ["split", idName st, "ID"]
@ -369,15 +372,16 @@ showError other = (: []) $ case other of
matchName MatchNumeric = "numeric"
matchName MatchText = "text"
(IncomeError dp) ->
T.append "Income allocations exceed total: datepattern=" $ showT dp
[T.append "Income allocations exceed total: datepattern=" $ showT dp]
(BalanceError t cur rss) ->
T.unwords
[ T.unwords
[ msg
, "for currency"
, singleQuote cur
, "and for splits"
, splits
]
]
where
msg = case t of
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 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 c n s = replicate (n - length s) c ++ s

View File

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

View File

@ -20,7 +20,7 @@
# this resolver has persistent < version 2.13.3.4 which introduced a nasty
# name shadow bug
resolver: lts-20.9
resolver: lts-18.28
# User packages to be built.
# Various formats can be used as shown in the example below.
@ -39,10 +39,13 @@ resolver: lts-20.9
#
extra-deps:
# 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
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - template-haskell-2.16.0.0
- git: https://github.com/dhall-lang/dhall-haskell.git
commit: ffd1ba94ef39b875aba8adc1c498f28aa02e36e4
subdirs: [dhall]
- hashable-1.3.5.0
#
# extra-deps: []