WIP make errors better

This commit is contained in:
Nathan Dwarshuis 2023-01-25 20:52:27 -05:00
parent b94fd4b667
commit 0d0c961f1a
3 changed files with 92 additions and 8 deletions

View File

@ -211,11 +211,11 @@ balanceSplits ss =
hasValue s@(Split {sValue = Just v}) = Right s {sValue = v}
hasValue s = Left s
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
([noVal], val) -> Right $ noVal {sValue = foldr (\s x -> x - sValue s) 0 val} : val
([], val) -> Right val
_ -> Left $ BalanceError NotOneBlank cur
_ -> Left $ BalanceError NotOneBlank cur rss
groupByKey :: Ord k => [(k, v)] -> [(k, [v])]
groupByKey = M.toList . M.fromListWith (++) . fmap (second (: []))

View File

@ -512,7 +512,7 @@ data InsertError
= RegexError T.Text
| ConversionError T.Text
| LookupError T.Text
| BalanceError BalanceType CurID
| BalanceError BalanceType CurID [RawSplit]
| StatementError [TxRecord] [Match]
deriving (Show)

View File

@ -4,9 +4,11 @@
module Internal.Utils where
import Data.Time.Format.ISO8601
import GHC.Real
import Internal.Types
import RIO
import qualified RIO.List as L
import qualified RIO.Map as M
import qualified RIO.Text as T
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 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
-- TODO get rid of these errors
gregTup :: Gregorian -> (Integer, Int, Int)
gregTup g@Gregorian {..}
| 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 (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
where
showTx = undefined
showMatch = undefined
showError other = (: []) $ case other of
(RegexError re) -> T.append "could not make regex from pattern: " re
(ConversionError x) -> T.append "Could not convert to rational number: " x
(LookupError f) -> T.append "Could not find field: " f
-- 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 NotOneBlank cur) -> T.append "Exactly one split must be blank: " cur
(BalanceError t cur rss) ->
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)