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 >
let TxSign = { tsColumn : Text, tsPositive : Text }
let TxAmount1_ =
\(re : Type) ->
{ a1Column : Text
@ -287,11 +289,22 @@ let TxAmount1_ =
sign, numerator, and denominator of the amount.
-}
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 =
{ Type = TxAmount1_ Text
, default = { a1Column = "Amount", a1Fmt = "([-+])?([0-9\\.]+)" }
, default =
{ a1Column = "Amount"
, a1Fmt = "([-+])?([0-9\\.]+)"
, a1Sign = None TxSign
}
}
let TxAmount2_ =
@ -1243,5 +1256,6 @@ in { CurID
, TxAmount2_
, TxAmount1
, TxAmount2
, TxSign
, BudgetTransfer
}

View File

@ -124,58 +124,67 @@ parseTxRecord
, toSkipBlankAmount
, toSkipBlankDescription
, toSkipBlankOther
, toSkipMissingFields
}
r =
do
-- TODO this is confusing as hell
--
-- 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
-- Parse date, desc, and other fields first. If these are blank and we
-- allow them to be blank, then skip the line.
d <- getField toDate
e <- getField toDesc
os <-
fmap M.fromList . sequence
<$> mapM (\n -> fmap (n,) <$> getField n) toOther
(af, ax) <- 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
AmountSingle TxAmount1 {a1Column, a1Fmt} -> do
f <- getField a1Column
return (a1Fmt, Right <$> f)
os <- M.fromList <$> mapM (\n -> (n,) <$> getField n) toOther
let skipLine =
(toSkipBlankDate && d == "")
|| (toSkipBlankDescription && e == "")
|| elem "" (mapMaybe (`M.lookup` os) toSkipBlankOther)
if skipLine
then return Nothing
else do
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
f1 <- getField a2Positive
f2 <- getField a2Negative
return $ (a2Fmt,) $ case (f1, f2) of
(Just a, Just b) -> Just $ Left (a, b)
_ -> Nothing
case (d, e, os, ax) of
-- If all lookups were successful, check that none of the fields are
-- blank, and if they are return nothing to skip this line
(Just d', Just e', Just os', Just ax') ->
if (toSkipBlankDate && d' == "")
|| (toSkipBlankDescription && e' == "")
|| (toSkipBlankAmount && (ax' == Right "" || ax' == Left ("", "")))
|| elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther)
then return Nothing
else -- if we are skipping nothing, proceed to parse the date and amount
-- columns
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
(sign, v) <- case (f1, f2) of
("", "") -> fail "Positive and Negative fields undefined"
(v, "") -> return (1, v)
("", v) -> return (-1, v)
(_, _) -> fail "Positive and Negative fields defined"
Just . (sign *) . abs <$> parseDecimal False a2Fmt v
parseOrSkipDecimal wantSign fmt s = do
case (s, toSkipBlankAmount) of
("", True) -> return Nothing
(s', _) -> Just <$> parseDecimal wantSign fmt s'
getField :: FromField a => T.Text -> Parser a
getField f = r .: T.encodeUtf8 f
matchRecords :: MonadFinance m => [StatementParserRe] -> [TxRecord] -> AppExceptT m [Tx ()]
matchRecords ms rs = do
@ -547,7 +556,7 @@ parseDecimal wantSign (pat, re) s = case (wantSign, matchGroupsMaybe s re) of
x <- readNum num
return $ k * x
(False, [num]) -> readNum num
_ -> msg "malformed decimal"
_ -> msg $ T.append "malformed decimal: " s
where
msg :: MonadFail m => T.Text -> m a
msg m =

View File

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