Compare commits

..

2 Commits

Author SHA1 Message Date
Nathan Dwarshuis dbc5e8a5f2 FIX bugs 2024-05-05 18:51:30 -04:00
Nathan Dwarshuis 69ff8e9481 ADD sign column 2024-05-05 17:34:48 -04:00
3 changed files with 73 additions and 46 deletions

View File

@ -278,6 +278,8 @@ let DatePat =
-} -}
< Cron : CronPat.Type | Mod : ModPat.Type > < Cron : CronPat.Type | Mod : ModPat.Type >
let TxSign = { tsColumn : Text, tsPositive : Text }
let TxAmount1_ = let TxAmount1_ =
\(re : Type) -> \(re : Type) ->
{ a1Column : Text { a1Column : Text
@ -287,11 +289,22 @@ let TxAmount1_ =
sign, numerator, and denominator of the amount. sign, numerator, and denominator of the amount.
-} -}
re re
, a1Sign :
{-
If given, this column will be used for the sign of the amount field.
Use for cases where the sign field does not have (+/-). If the
amount is signed, this column's value will take precedence.
-}
Optional TxSign
} }
let TxAmount1 = let TxAmount1 =
{ Type = TxAmount1_ Text { Type = TxAmount1_ Text
, default = { a1Column = "Amount", a1Fmt = "([-+])?([0-9\\.]+)" } , default =
{ a1Column = "Amount"
, a1Fmt = "([-+])?([0-9\\.]+)"
, a1Sign = None TxSign
}
} }
let TxAmount2_ = let TxAmount2_ =
@ -1243,5 +1256,6 @@ in { CurID
, TxAmount2_ , TxAmount2_
, TxAmount1 , TxAmount1
, TxAmount2 , TxAmount2
, TxSign
, BudgetTransfer , BudgetTransfer
} }

View File

@ -124,58 +124,67 @@ parseTxRecord
, toSkipBlankAmount , toSkipBlankAmount
, toSkipBlankDescription , toSkipBlankDescription
, toSkipBlankOther , toSkipBlankOther
, toSkipMissingFields
} }
r = r =
do do
-- TODO this is confusing as hell -- Parse date, desc, and other fields first. If these are blank and we
-- -- allow them to be blank, then skip the line.
-- try and parse all fields; if a parse fails, either trip an error
-- or return a Nothing if we want to deliberately skip missing fields
d <- getField toDate d <- getField toDate
e <- getField toDesc e <- getField toDesc
os <- os <- M.fromList <$> mapM (\n -> (n,) <$> getField n) toOther
fmap M.fromList . sequence let skipLine =
<$> mapM (\n -> fmap (n,) <$> getField n) toOther (toSkipBlankDate && d == "")
(af, ax) <- case toAmount of || (toSkipBlankDescription && e == "")
-- the amount column is extra confusing because it can either be one || elem "" (mapMaybe (`M.lookup` os) toSkipBlankOther)
-- or two columns, so keep track of this with a maybe if skipLine
AmountSingle TxAmount1 {a1Column, a1Fmt} -> do then return Nothing
f <- getField a1Column else do
return (a1Fmt, Right <$> f) d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
-- Next try to parse the amount field, which can also trigger a line
-- skip (or cause a parse fail)
((\a -> TxRecord d' a e os p) <$>) <$> parseTxAmount
where
parseTxAmount = case toAmount of
-- The amount column is extra confusing because it can either be one
-- or two columns, so keep track of this with a maybe. Return Nothing
-- to indicate we want to skip the line.
--
-- In the case of one column, parse the amount with the indicated regex,
-- and force the sign if we are given a column that specifies the sign.
-- If the amount is blank, skip the line if we allow blanks.
AmountSingle TxAmount1 {a1Column, a1Fmt, a1Sign} -> do
v <- getField a1Column
signf <- case a1Sign of
Nothing -> return id
Just (TxSign signCol positive) -> do
s <- getField signCol
let k = if s == positive then 1 else -1
return ((* k) . abs)
fmap signf <$> parseOrSkipDecimal True a1Fmt v
-- In the case of dual columns, each column represents either debit or
-- credit. Only one is expected to be populated at once, so throw parse
-- error if both or neither are blank. In the case where only one is
-- present, parse the value and force the sign depending on which column
-- it was. Note that in this case, we can't skip the line if the amount
-- is blank, because by extension this implies that both columns are
-- blank which we don't allow.
AmountDual TxAmount2 {a2Positive, a2Negative, a2Fmt} -> do AmountDual TxAmount2 {a2Positive, a2Negative, a2Fmt} -> do
f1 <- getField a2Positive f1 <- getField a2Positive
f2 <- getField a2Negative f2 <- getField a2Negative
return $ (a2Fmt,) $ case (f1, f2) of (sign, v) <- case (f1, f2) of
(Just a, Just b) -> Just $ Left (a, b) ("", "") -> fail "Positive and Negative fields undefined"
_ -> Nothing (v, "") -> return (1, v)
case (d, e, os, ax) of ("", v) -> return (-1, v)
-- If all lookups were successful, check that none of the fields are (_, _) -> fail "Positive and Negative fields defined"
-- blank, and if they are return nothing to skip this line Just . (sign *) . abs <$> parseDecimal False a2Fmt v
(Just d', Just e', Just os', Just ax') ->
if (toSkipBlankDate && d' == "") parseOrSkipDecimal wantSign fmt s = do
|| (toSkipBlankDescription && e' == "") case (s, toSkipBlankAmount) of
|| (toSkipBlankAmount && (ax' == Right "" || ax' == Left ("", ""))) ("", True) -> return Nothing
|| elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther) (s', _) -> Just <$> parseDecimal wantSign fmt s'
then return Nothing
else -- if we are skipping nothing, proceed to parse the date and amount getField :: FromField a => T.Text -> Parser a
-- columns getField f = r .: T.encodeUtf8 f
do
a <- case ax' of
Right a -> parseDecimal True af a
Left ("", a) -> ((-1) *) <$> parseDecimal False af a
Left (a, _) -> parseDecimal False af a
d'' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d'
return $ Just $ TxRecord d'' a e' os' p
-- if no lookups succeeded, return nothing to skip this line. Note that
-- a parse fail will trigger a failure error further up, so that case
-- is already dealt with implicitly
_ -> return Nothing
where
getField :: FromField a => T.Text -> Parser (Maybe a)
getField f = case runParser $ r .: T.encodeUtf8 f of
Left err -> if toSkipMissingFields then return Nothing else fail err
Right x -> return $ Just x
matchRecords :: MonadFinance m => [StatementParserRe] -> [TxRecord] -> AppExceptT m [Tx ()] matchRecords :: MonadFinance m => [StatementParserRe] -> [TxRecord] -> AppExceptT m [Tx ()]
matchRecords ms rs = do matchRecords ms rs = do
@ -547,7 +556,7 @@ parseDecimal wantSign (pat, re) s = case (wantSign, matchGroupsMaybe s re) of
x <- readNum num x <- readNum num
return $ k * x return $ k * x
(False, [num]) -> readNum num (False, [num]) -> readNum num
_ -> msg "malformed decimal" _ -> msg $ T.append "malformed decimal: " s
where where
msg :: MonadFail m => T.Text -> m a msg :: MonadFail m => T.Text -> m a
msg m = msg m =

View File

@ -49,6 +49,7 @@ makeHaskellTypesWith
, SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type" , SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type"
, SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type" , SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type"
, SingleConstructor "ValMatcher" "ValMatcher" "(./dhall/Types.dhall).ValMatcher.Type" , SingleConstructor "ValMatcher" "ValMatcher" "(./dhall/Types.dhall).ValMatcher.Type"
, SingleConstructor "TxSign" "TxSign" "(./dhall/Types.dhall).TxSign"
, SingleConstructor "TxAmount1" "TxAmount1" "(./dhall/Types.dhall).TxAmount1_" , SingleConstructor "TxAmount1" "TxAmount1" "(./dhall/Types.dhall).TxAmount1_"
, SingleConstructor "TxAmount2" "TxAmount2" "(./dhall/Types.dhall).TxAmount2_" , SingleConstructor "TxAmount2" "TxAmount2" "(./dhall/Types.dhall).TxAmount2_"
, SingleConstructor , SingleConstructor
@ -107,6 +108,7 @@ deriveProduct
, "Period" , "Period"
, "PeriodType" , "PeriodType"
, "HourlyPeriod" , "HourlyPeriod"
, "TxSign"
] ]
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -484,6 +486,8 @@ deriving instance Generic (TxAmount1 T.Text)
deriving instance Generic (TxAmount2 T.Text) deriving instance Generic (TxAmount2 T.Text)
deriving instance Hashable TxSign
deriving instance Hashable (TxAmount1 T.Text) deriving instance Hashable (TxAmount1 T.Text)
deriving instance Hashable (TxAmount2 T.Text) deriving instance Hashable (TxAmount2 T.Text)