WIP make errors not suck

This commit is contained in:
Nathan Dwarshuis 2023-01-28 18:52:28 -05:00
parent 0faea1161c
commit b2e6047800
2 changed files with 59 additions and 20 deletions

View File

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

View File

@ -18,8 +18,8 @@ import Text.Regex.TDFA
-- gregorian -- gregorian
gregTup :: Gregorian -> EitherErr (Integer, Int, Int) gregTup :: Gregorian -> EitherErr (Integer, Int, Int)
gregTup Gregorian {..} gregTup g@Gregorian {..}
| gYear > 99 = Left $ YearError gYear | gYear > 99 = Left $ YearError $ YMD g
| otherwise = | otherwise =
return return
( fromIntegral gYear + 2000 ( fromIntegral gYear + 2000
@ -28,8 +28,8 @@ gregTup Gregorian {..}
) )
gregMTup :: GregorianM -> EitherErr (Integer, Int) gregMTup :: GregorianM -> EitherErr (Integer, Int)
gregMTup GregorianM {..} gregMTup g@GregorianM {..}
| gmYear > 99 = Left $ YearError gmYear | gmYear > 99 = Left $ YearError $ YM g
| otherwise = | otherwise =
return return
( fromIntegral gmYear + 2000 ( fromIntegral gmYear + 2000
@ -41,7 +41,7 @@ data MDY_ = Y_ Integer | YM_ Integer Int | YMD_ Integer Int Int
fromMatchYMD :: MatchYMD -> EitherErr MDY_ fromMatchYMD :: MatchYMD -> EitherErr MDY_
fromMatchYMD m = case m of fromMatchYMD m = case m of
Y y Y y
| y > 99 -> Left $ YearError y | y > 99 -> Left $ YearError $ Y y
| otherwise -> Right $ Y_ $ fromIntegral y + 2000 | otherwise -> Right $ Y_ $ fromIntegral y + 2000
YM g -> uncurry YM_ <$> gregMTup g YM g -> uncurry YM_ <$> gregMTup g
YMD g -> uncurry3 YMD_ <$> gregTup g YMD g -> uncurry3 YMD_ <$> gregTup g
@ -273,7 +273,8 @@ showError :: InsertError -> [T.Text]
showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms) showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
showError other = (: []) $ case other of showError other = (: []) $ case other of
-- TODO show whole date here since this is kinda useless -- 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 (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
-- TODO use the field indicator -- TODO use the field indicator
@ -346,24 +347,59 @@ showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriori
[] -> Nothing [] -> Nothing
xs -> Just $ T.concat $ showMatchOther <$> xs 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 :: MatchDate -> T.Text
showMatchDate md = case md of 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, ")"]
where
end = case start of
(Y y) -> Y $ y + n
(YM (GregorianM {..})) ->
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
}
-- | convert YMD match to text
-- this will not throw errors even if year is > 99
showMatchYMD :: MatchYMD -> T.Text
showMatchYMD md =
T.intercalate "-" $ L.take 3 (fmap showT digits ++ L.repeat "*")
where
digits = case md of
Y y -> [y] Y y -> [y]
YM (GregorianM {..}) -> [gmYear, gmMonth] YM (GregorianM {..}) -> [gmYear, gmMonth]
YMD (Gregorian {..}) -> [gYear, gMonth, gDay] 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 "*")
showMatchVal :: MatchVal -> Maybe T.Text 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 :: MatchOther -> T.Text
showMatchOther = undefined showMatchOther = undefined
@ -458,5 +494,8 @@ lpad c n s = replicate (n - length s) c ++ s
rpad :: a -> Int -> [a] -> [a] rpad :: a -> Int -> [a] -> [a]
rpad c n s = s ++ replicate (n - length s) c 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 :: RegexContext Regex query b => query -> T.Text -> EitherErr b
matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re