WIP make errors not suck
This commit is contained in:
parent
0faea1161c
commit
b2e6047800
|
@ -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]
|
||||||
|
|
|
@ -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, ")"]
|
||||||
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 :: 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
|
||||||
|
|
Loading…
Reference in New Issue