ENH finish make errors not suck

lib/Internal/Types.hs

@@ -540,8 +540,8 @@ data AllocationSuberr
 
 data InsertError
   = RegexError T.Text
-  | -- | YearError MatchYMD
+  | MatchValPrecisionError Natural Natural
-    ConversionError T.Text
+  | ConversionError T.Text
   | LookupError LookupSuberr T.Text
   | BalanceError BalanceType CurID [RawSplit]
   | AllocationError AllocationSuberr DatePat

lib/Internal/Utils.hs

@@ -107,8 +107,8 @@ resolveBounds (s, e) = do
 
 matches :: Match -> TxRecord -> EitherErrs (MatchRes RawTx)
 matches Match {..} r@TxRecord {..} = do
-  res <- concatEither2 other desc (&&)
+  res <- concatEither3 val other desc $ \x y z -> x && y && z
-  if date && val && res
+  if date && res
     then maybe (Right MatchSkip) (fmap MatchPass . convert) mTx
     else Right MatchFail
   where
@@ -138,11 +138,14 @@ toTx sc sa toSplits r@TxRecord {..} =
     acRes = concatEithers2 (resolveAcnt r sa) (resolveCurrency r sc) (,)
     ssRes = concatEithersL $ fmap (resolveSplit r) toSplits
 
-valMatches :: MatchVal -> Rational -> Bool
+valMatches :: MatchVal -> Rational -> EitherErr Bool
-valMatches MatchVal {..} x =
+valMatches MatchVal {..} x
-  checkMaybe (s ==) mvSign
+  | Just d_ <- mvDen, d_ >= p = Left $ MatchValPrecisionError d_ p
-    && checkMaybe (n ==) mvNum
+  | otherwise =
-    && checkMaybe ((d * p ==) . fromIntegral) mvDen
+      Right $
+        checkMaybe (s ==) mvSign
+          && checkMaybe (n ==) mvNum
+          && checkMaybe ((d * fromIntegral p ==) . fromIntegral) mvDen
   where
     (n, d) = properFraction $ abs x
     p = 10 ^ mvPrec
@@ -154,7 +157,7 @@ dateMatches md = (EQ ==) . compareDate md
 
 otherMatches :: M.Map T.Text T.Text -> MatchOther -> EitherErr Bool
 otherMatches dict m = case m of
-  Val (Field n mv) -> valMatches mv <$> (readRational =<< lookup_ MatchNumeric n)
+  Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
   Desc (Field n md) -> (`matchMaybe` md) =<< lookup_ MatchText n
   where
     lookup_ t n = lookupErr (MatchField t) n dict
@@ -277,7 +280,8 @@ showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
 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
-  -- TODO use the field indicator
+  (MatchValPrecisionError d p) ->
+    T.unwords ["Match denominator", showT d, "must be less than", showT p]
   (LookupError t f) ->
     T.unwords
       [ "Could not find field"
@@ -318,7 +322,7 @@ showError other = (: []) $ case other of
       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
+      splits = T.intercalate ", " $ fmap (singleQuote . showSplit) rss
 
 showTx :: TxRecord -> T.Text
 showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
@@ -345,7 +349,7 @@ showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriori
       ]
     others = case o of
       [] -> Nothing
-      xs -> Just $ T.concat $ showMatchOther <$> xs
+      xs -> Just $ singleQuote $ T.concat $ showMatchOther <$> xs
 
 -- | Convert match date to text
 -- Single date matches will just show the single date, and ranged matches will
@@ -381,28 +385,35 @@ showYMD_ md =
       YM_ y m -> [fromIntegral y, m]
       YMD_ y m d -> [fromIntegral y, m, d]
 
--- TODO there are errors that can be thrown here
 showMatchVal :: MatchVal -> Maybe T.Text
 showMatchVal MatchVal {mvSign = Nothing, mvNum = Nothing, mvDen = Nothing} = Nothing
-showMatchVal MatchVal {..} = Just $ T.concat [sign, num, ".", den]
+showMatchVal MatchVal {..} = Just $ singleQuote $ keyVals [(k, v) | (k, Just v) <- kvs]
   where
-    sign = case mvSign of
+    kvs =
-      Nothing -> "+/-"
+      [ ("sign", (\s -> if s then "+" else "-") <$> mvSign)
-      Just s -> if s then "+" else "-"
+      , ("numerator", showT <$> mvNum)
-    num = maybe "*" showT mvNum
+      , ("denominator", showT <$> mvDen)
-    den = maybe "*" (lpadT '0' (fromIntegral mvPrec) . showT) mvDen
+      , ("precision", Just $ showT mvPrec)
+      ]
 
 showMatchOther :: MatchOther -> T.Text
-showMatchOther = undefined
+showMatchOther (Desc (Field f re)) =
+  T.unwords ["desc field", singleQuote f, "with re", singleQuote re]
+showMatchOther (Val (Field f mv)) =
+  T.unwords
+    [ "val field"
+    , singleQuote f
+    , "with match value"
+    , singleQuote $ fromMaybe "*" $ showMatchVal mv
+    ]
 
 showSplit :: RawSplit -> T.Text
 showSplit Split {sAcnt = a, sValue = v, sComment = c} =
-  singleQuote $
+  keyVals
-    keyVals
+    [ ("account", a)
-      [ ("account", a)
+    , ("value", T.pack $ show ((fromRational <$> v) :: Maybe Float))
-      , ("value", T.pack $ show ((fromRational <$> v) :: Maybe Float))
+    , ("comment", doubleQuote c)
-      , ("comment", doubleQuote c)
+    ]
-      ]
 
 singleQuote :: T.Text -> T.Text
 singleQuote t = T.concat ["'", t, "'"]
@@ -427,10 +438,10 @@ concatEither2 a b fun = case (a, b) of
   (Right a_, Right b_) -> Right $ fun a_ b_
   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
 
--- concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
+concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
--- concatEither3 a b c fun = case (a, b, c) of
+concatEither3 a b c fun = case (a, b, c) of
---   (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
+  (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
---   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
+  _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
 
 concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
 concatEithers2 a b = merge . concatEither2 a b
@@ -485,8 +496,8 @@ uncurry3 f (a, b, c) = f a b c
 -- rpad :: a -> Int -> [a] -> [a]
 -- rpad c n s = s ++ replicate (n - length s) c
 
-lpadT :: Char -> Int -> T.Text -> T.Text
+-- lpadT :: Char -> Int -> T.Text -> T.Text
-lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
+-- lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
 
 matchMaybe :: RegexContext Regex query b => query -> T.Text -> EitherErr b
 matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re