WIP make errors not suck

lib/Internal/Types.hs

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

lib/Internal/Utils.hs

@@ -18,8 +18,8 @@ import Text.Regex.TDFA
 -- gregorian
 
 gregTup :: Gregorian -> EitherErr (Integer, Int, Int)
-gregTup Gregorian {..}
+gregTup g@Gregorian {..}
-  | gYear > 99 = Left $ YearError gYear
+  | gYear > 99 = Left $ YearError $ YMD g
   | otherwise =
       return
         ( fromIntegral gYear + 2000
@@ -28,8 +28,8 @@ gregTup Gregorian {..}
         )
 
 gregMTup :: GregorianM -> EitherErr (Integer, Int)
-gregMTup GregorianM {..}
+gregMTup g@GregorianM {..}
-  | gmYear > 99 = Left $ YearError gmYear
+  | gmYear > 99 = Left $ YearError $ YM g
   | otherwise =
       return
         ( fromIntegral gmYear + 2000
@@ -41,7 +41,7 @@ data MDY_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
 fromMatchYMD :: MatchYMD -> EitherErr MDY_
 fromMatchYMD m = case m of
   Y y
-    | y > 99 -> Left $ YearError y
+    | y > 99 -> Left $ YearError $ Y y
     | otherwise -> Right $ Y_ $ fromIntegral y + 2000
   YM g -> uncurry YM_ <$> gregMTup g
   YMD g -> uncurry3 YMD_ <$> gregTup g
@@ -273,7 +273,8 @@ showError :: InsertError -> [T.Text]
 showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
 showError other = (: []) $ case other of
   -- TODO show whole date here since this is kinda useless
-  (YearError y) -> T.append "Year must be two digits: " $ showT y
+  (YearError d) ->
+    T.append "Year must be two digits in " $ singleQuote $ showMatchYMD d
   (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
@@ -346,24 +347,59 @@ showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriori
       [] -> Nothing
       xs -> Just $ T.concat $ showMatchOther <$> xs
 
+-- | Convert match date to text
+-- This will not throw errors even if year is > 99. Single date matches will
+-- just show the single date, and ranged matches will show an interval like
+-- [YY-MM-DD, YY-MM-DD)
 showMatchDate :: MatchDate -> T.Text
 showMatchDate md = case md of
-  (On x) ->
+  (On x) -> showMatchYMD x
-    let ys = case x of
+  (In start n) -> T.concat ["[", showMatchYMD start, " ", showMatchYMD end, ")"]
-          Y y -> [y]
+    where
-          YM (GregorianM {..}) -> [gmYear, gmMonth]
+      end = case start of
-          YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
+        (Y y) -> Y $ y + n
-     in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
+        (YM (GregorianM {..})) ->
-  (In _ _) -> undefined
+          let (y, m) = divMod (gmMonth + n - 1) 12
+           in YM $
+                GregorianM
+                  { gmYear = gmYear + y
+                  , gmMonth = gmMonth + m + 1
+                  }
+        (YMD (Gregorian {..})) ->
+          let (y, m, d) =
+                toGregorian $
+                  addDays (fromIntegral n) $
+                    fromGregorian
+                      (fromIntegral gYear)
+                      (fromIntegral gMonth)
+                      (fromIntegral gDay)
+           in YMD $
+                Gregorian
+                  { gYear = fromIntegral y
+                  , gMonth = fromIntegral m
+                  , gDay = fromIntegral d
+                  }
 
--- let ys = case x of
+-- | convert YMD match to text
---       Y y -> [y]
+-- this will not throw errors even if year is > 99
---       YM (GregorianM {..}) -> [gmYear, gmMonth]
+showMatchYMD :: MatchYMD -> T.Text
---       YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
+showMatchYMD md =
---  in T.intercalate "-" $ L.take 3 (fmap showT ys ++ L.repeat "*")
+  T.intercalate "-" $ L.take 3 (fmap showT digits ++ L.repeat "*")
+  where
+    digits = case md of
+      Y y -> [y]
+      YM (GregorianM {..}) -> [gmYear, gmMonth]
+      YMD (Gregorian {..}) -> [gYear, gMonth, gDay]
 
 showMatchVal :: MatchVal -> Maybe T.Text
-showMatchVal = undefined
+showMatchVal MatchVal {mvSign = Nothing, mvNum = Nothing, mvDen = Nothing} = Nothing
+showMatchVal MatchVal {..} = Just $ T.concat [sign, num, ".", den]
+  where
+    sign = case mvSign of
+      Nothing -> "+/-"
+      Just s -> if s then "+" else "-"
+    num = maybe "*" showT mvNum
+    den = maybe "*" (lpadT '0' (fromIntegral mvPrec) . showT) mvDen
 
 showMatchOther :: MatchOther -> T.Text
 showMatchOther = undefined
@@ -458,5 +494,8 @@ lpad c n s = replicate (n - length s) c ++ s
 rpad :: a -> Int -> [a] -> [a]
 rpad c n s = s ++ replicate (n - length s) c
 
+lpadT :: Char -> Int -> T.Text -> T.Text
+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