FIX bugs
This commit is contained in:
parent
69ff8e9481
commit
dbc5e8a5f2
|
@ -127,36 +127,31 @@ parseTxRecord
|
|||
}
|
||||
r =
|
||||
do
|
||||
-- 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
|
||||
a <- parseTxAmount
|
||||
case (d, e, a, os) 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 a', Just os') ->
|
||||
if (toSkipBlankDate && d' == "")
|
||||
|| (toSkipBlankDescription && e' == "")
|
||||
|| elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther)
|
||||
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 -- if we are skipping nothing, proceed to parse the date and amount
|
||||
-- columns
|
||||
do
|
||||
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
|
||||
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
|
||||
-- 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
|
||||
|
@ -166,6 +161,13 @@ parseTxRecord
|
|||
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
|
||||
|
@ -174,7 +176,7 @@ parseTxRecord
|
|||
(v, "") -> return (1, v)
|
||||
("", v) -> return (-1, v)
|
||||
(_, _) -> fail "Positive and Negative fields defined"
|
||||
fmap ((sign *) . abs) <$> parseOrSkipDecimal False a2Fmt v
|
||||
Just . (sign *) . abs <$> parseDecimal False a2Fmt v
|
||||
|
||||
parseOrSkipDecimal wantSign fmt s = do
|
||||
case (s, toSkipBlankAmount) of
|
||||
|
@ -554,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 =
|
||||
|
|
Loading…
Reference in New Issue