diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs index aba4028..ed4ba2c 100644 --- a/lib/Internal/Types.hs +++ b/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] diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index 95dd349..55ca005 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -18,8 +18,8 @@ import Text.Regex.TDFA -- gregorian gregTup :: Gregorian -> EitherErr (Integer, Int, Int) -gregTup Gregorian {..} - | gYear > 99 = Left $ YearError gYear +gregTup g@Gregorian {..} + | gYear > 99 = Left $ YearError $ YMD g | otherwise = return ( fromIntegral gYear + 2000 @@ -28,8 +28,8 @@ gregTup Gregorian {..} ) gregMTup :: GregorianM -> EitherErr (Integer, Int) -gregMTup GregorianM {..} - | gmYear > 99 = Left $ YearError gmYear +gregMTup g@GregorianM {..} + | 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) -> - 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 + (On x) -> showMatchYMD x + (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 + } --- 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 "*") +-- | 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] + 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