Compare commits

..

No commits in common. "add_tx_amount_sign_column" and "master" have entirely different histories.

3 changed files with 46 additions and 73 deletions

View File

@ -278,8 +278,6 @@ 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
@ -289,22 +287,11 @@ 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 = , default = { a1Column = "Amount", a1Fmt = "([-+])?([0-9\\.]+)" }
{ a1Column = "Amount"
, a1Fmt = "([-+])?([0-9\\.]+)"
, a1Sign = None TxSign
}
} }
let TxAmount2_ = let TxAmount2_ =
@ -1256,6 +1243,5 @@ in { CurID
, TxAmount2_ , TxAmount2_
, TxAmount1 , TxAmount1
, TxAmount2 , TxAmount2
, TxSign
, BudgetTransfer , BudgetTransfer
} }

View File

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

View File

@ -49,7 +49,6 @@ 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
@ -108,7 +107,6 @@ deriveProduct
, "Period" , "Period"
, "PeriodType" , "PeriodType"
, "HourlyPeriod" , "HourlyPeriod"
, "TxSign"
] ]
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -486,8 +484,6 @@ 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)