WIP make errors better
This commit is contained in:
parent
b94fd4b667
commit
0d0c961f1a
|
@ -211,11 +211,11 @@ balanceSplits ss =
|
||||||
hasValue s@(Split {sValue = Just v}) = Right s {sValue = v}
|
hasValue s@(Split {sValue = Just v}) = Right s {sValue = v}
|
||||||
hasValue s = Left s
|
hasValue s = Left s
|
||||||
bal cur rss
|
bal cur rss
|
||||||
| length rss < 2 = Left $ BalanceError TooFewSplits cur
|
| length rss < 2 = Left $ BalanceError TooFewSplits cur rss
|
||||||
| otherwise = case partitionEithers $ fmap hasValue rss of
|
| otherwise = case partitionEithers $ fmap hasValue rss of
|
||||||
([noVal], val) -> Right $ noVal {sValue = foldr (\s x -> x - sValue s) 0 val} : val
|
([noVal], val) -> Right $ noVal {sValue = foldr (\s x -> x - sValue s) 0 val} : val
|
||||||
([], val) -> Right val
|
([], val) -> Right val
|
||||||
_ -> Left $ BalanceError NotOneBlank cur
|
_ -> Left $ BalanceError NotOneBlank cur rss
|
||||||
|
|
||||||
groupByKey :: Ord k => [(k, v)] -> [(k, [v])]
|
groupByKey :: Ord k => [(k, v)] -> [(k, [v])]
|
||||||
groupByKey = M.toList . M.fromListWith (++) . fmap (second (: []))
|
groupByKey = M.toList . M.fromListWith (++) . fmap (second (: []))
|
||||||
|
|
|
@ -512,7 +512,7 @@ data InsertError
|
||||||
= RegexError T.Text
|
= RegexError T.Text
|
||||||
| ConversionError T.Text
|
| ConversionError T.Text
|
||||||
| LookupError T.Text
|
| LookupError T.Text
|
||||||
| BalanceError BalanceType CurID
|
| BalanceError BalanceType CurID [RawSplit]
|
||||||
| StatementError [TxRecord] [Match]
|
| StatementError [TxRecord] [Match]
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
|
|
@ -4,9 +4,11 @@
|
||||||
|
|
||||||
module Internal.Utils where
|
module Internal.Utils where
|
||||||
|
|
||||||
|
import Data.Time.Format.ISO8601
|
||||||
import GHC.Real
|
import GHC.Real
|
||||||
import Internal.Types
|
import Internal.Types
|
||||||
import RIO
|
import RIO
|
||||||
|
import qualified RIO.List as L
|
||||||
import qualified RIO.Map as M
|
import qualified RIO.Map as M
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
import qualified RIO.Text.Partial as TP
|
import qualified RIO.Text.Partial as TP
|
||||||
|
@ -17,6 +19,7 @@ import Text.Regex.TDFA
|
||||||
thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
|
thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
|
||||||
thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
|
thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
|
||||||
|
|
||||||
|
-- TODO get rid of these errors
|
||||||
gregTup :: Gregorian -> (Integer, Int, Int)
|
gregTup :: Gregorian -> (Integer, Int, Int)
|
||||||
gregTup g@Gregorian {..}
|
gregTup g@Gregorian {..}
|
||||||
| gYear > 99 = error $ show g ++ ": year must only be two digits"
|
| gYear > 99 = error $ show g ++ ": year must only be two digits"
|
||||||
|
@ -278,13 +281,94 @@ acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
|
||||||
|
|
||||||
showError :: InsertError -> [T.Text]
|
showError :: InsertError -> [T.Text]
|
||||||
showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
|
showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
|
||||||
where
|
|
||||||
showTx = undefined
|
|
||||||
showMatch = undefined
|
|
||||||
showError other = (: []) $ case other of
|
showError other = (: []) $ case other of
|
||||||
(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
|
||||||
(LookupError f) -> T.append "Could not find field: " f
|
(LookupError f) -> T.append "Could not find field: " f
|
||||||
-- TODO these balance errors are useless, need more info on the tx being balanced
|
-- TODO these balance errors are useless, need more info on the tx being balanced
|
||||||
(BalanceError TooFewSplits cur) -> T.append "Need at least two splits to balance: " cur
|
(BalanceError t cur rss) ->
|
||||||
(BalanceError NotOneBlank cur) -> T.append "Exactly one split must be blank: " cur
|
T.concat
|
||||||
|
[ msg
|
||||||
|
, " for currency "
|
||||||
|
, singleQuote cur
|
||||||
|
, " and for splits "
|
||||||
|
, splits
|
||||||
|
]
|
||||||
|
where
|
||||||
|
msg = case t of
|
||||||
|
TooFewSplits -> "Need at least two splits to balance"
|
||||||
|
NotOneBlank -> "Exactly one split must be blank"
|
||||||
|
splits = T.intercalate ", " $ fmap showSplit rss
|
||||||
|
|
||||||
|
showTx :: TxRecord -> T.Text
|
||||||
|
showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
|
||||||
|
T.append "Unmatched transaction: " $
|
||||||
|
keyVals
|
||||||
|
[ ("path", T.pack f)
|
||||||
|
, ("date", T.pack $ iso8601Show d)
|
||||||
|
, ("value", showT (fromRational v :: Float))
|
||||||
|
, ("description", doubleQuote e)
|
||||||
|
]
|
||||||
|
|
||||||
|
showMatch :: Match -> T.Text
|
||||||
|
showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriority = p} =
|
||||||
|
T.append "Unused match: " $ keyVals [(x, y) | (x, Just y) <- kvs]
|
||||||
|
where
|
||||||
|
kvs =
|
||||||
|
[ ("date", showMatchDate <$> d)
|
||||||
|
, ("val", showMatchVal v)
|
||||||
|
, ("desc", e)
|
||||||
|
, ("other", others)
|
||||||
|
, -- TODO it might be best to always show this
|
||||||
|
("counter", showT <$> n)
|
||||||
|
, ("priority", Just $ showT p)
|
||||||
|
]
|
||||||
|
others = case o of
|
||||||
|
[] -> Nothing
|
||||||
|
xs -> Just $ T.concat $ showMatchOther <$> xs
|
||||||
|
|
||||||
|
showMatchDate :: MatchDate -> T.Text
|
||||||
|
showMatchDate md = case md of
|
||||||
|
(On x) ->
|
||||||
|
let ys = case x of
|
||||||
|
Y y -> [y]
|
||||||
|
YM (GregorianM {..}) -> [gmYear, gmMonth]
|
||||||
|
YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
|
||||||
|
in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
|
||||||
|
(In _ _) -> undefined
|
||||||
|
|
||||||
|
-- let ys = case x of
|
||||||
|
-- Y y -> [y]
|
||||||
|
-- YM (GregorianM {..}) -> [gmYear, gmMonth]
|
||||||
|
-- YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
|
||||||
|
-- in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
|
||||||
|
|
||||||
|
showT :: Show a => a -> T.Text
|
||||||
|
showT = T.pack . show
|
||||||
|
|
||||||
|
showMatchVal :: MatchVal -> Maybe T.Text
|
||||||
|
showMatchVal = undefined
|
||||||
|
|
||||||
|
showMatchOther :: MatchOther -> T.Text
|
||||||
|
showMatchOther = undefined
|
||||||
|
|
||||||
|
showSplit :: RawSplit -> T.Text
|
||||||
|
showSplit Split {sAcnt = a, sValue = v, sComment = c} =
|
||||||
|
singleQuote $
|
||||||
|
keyVals
|
||||||
|
[ ("account", a)
|
||||||
|
, ("value", T.pack $ show ((fromRational <$> v) :: Maybe Float))
|
||||||
|
, ("comment", doubleQuote c)
|
||||||
|
]
|
||||||
|
|
||||||
|
singleQuote :: T.Text -> T.Text
|
||||||
|
singleQuote t = T.concat ["'", t, "'"]
|
||||||
|
|
||||||
|
doubleQuote :: T.Text -> T.Text
|
||||||
|
doubleQuote t = T.concat ["'", t, "'"]
|
||||||
|
|
||||||
|
keyVal :: T.Text -> T.Text -> T.Text
|
||||||
|
keyVal a b = T.concat [a, "=", b]
|
||||||
|
|
||||||
|
keyVals :: [(T.Text, T.Text)] -> T.Text
|
||||||
|
keyVals = T.intercalate "; " . fmap (uncurry keyVal)
|
||||||
|
|
Loading…
Reference in New Issue