From 0d0c961f1a4b2550474083af6819712e7cfdc907 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Wed, 25 Jan 2023 20:52:27 -0500
Subject: [PATCH] WIP make errors better

---
 lib/Internal/Statement.hs |  4 +-
 lib/Internal/Types.hs     |  2 +-
 lib/Internal/Utils.hs     | 94 ++++++++++++++++++++++++++++++++++++---
 3 files changed, 92 insertions(+), 8 deletions(-)

diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs
index ac2fa05..ae6362b 100644
--- a/lib/Internal/Statement.hs
+++ b/lib/Internal/Statement.hs
@@ -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 (: []))
diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs
index dede2c8..9b9dc0d 100644
--- a/lib/Internal/Types.hs
+++ b/lib/Internal/Types.hs
@@ -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)
 
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index 5fc5fd7..44a1e98 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -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)