ADD sign column
This commit is contained in:
parent
09761dabdf
commit
69ff8e9481
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
|
@ -124,58 +124,65 @@ parseTxRecord
|
||||||
, toSkipBlankAmount
|
, toSkipBlankAmount
|
||||||
, toSkipBlankDescription
|
, toSkipBlankDescription
|
||||||
, toSkipBlankOther
|
, toSkipBlankOther
|
||||||
, toSkipMissingFields
|
|
||||||
}
|
}
|
||||||
r =
|
r =
|
||||||
do
|
do
|
||||||
-- TODO this is confusing as hell
|
-- Try and parse all fields; if a parse fails, either trip an error
|
||||||
--
|
|
||||||
-- 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
|
-- 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 <-
|
||||||
fmap M.fromList . sequence
|
fmap M.fromList . sequence
|
||||||
<$> mapM (\n -> fmap (n,) <$> getField n) toOther
|
<$> mapM (\n -> fmap (n,) <$> getField n) toOther
|
||||||
(af, ax) <- case toAmount of
|
a <- parseTxAmount
|
||||||
-- the amount column is extra confusing because it can either be one
|
case (d, e, a, os) of
|
||||||
-- or two columns, so keep track of this with a maybe
|
|
||||||
AmountSingle TxAmount1 {a1Column, a1Fmt} -> do
|
|
||||||
f <- getField a1Column
|
|
||||||
return (a1Fmt, Right <$> f)
|
|
||||||
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
|
-- If all lookups were successful, check that none of the fields are
|
||||||
-- blank, and if they are return nothing to skip this line
|
-- blank, and if they are return nothing to skip this line
|
||||||
(Just d', Just e', Just os', Just ax') ->
|
(Just d', Just e', Just a', Just os') ->
|
||||||
if (toSkipBlankDate && d' == "")
|
if (toSkipBlankDate && d' == "")
|
||||||
|| (toSkipBlankDescription && e' == "")
|
|| (toSkipBlankDescription && e' == "")
|
||||||
|| (toSkipBlankAmount && (ax' == Right "" || ax' == Left ("", "")))
|
|
||||||
|| elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther)
|
|| elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther)
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else -- if we are skipping nothing, proceed to parse the date and amount
|
else -- if we are skipping nothing, proceed to parse the date and amount
|
||||||
-- columns
|
-- columns
|
||||||
do
|
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'
|
d'' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d'
|
||||||
return $ Just $ TxRecord d'' a e' os' p
|
return $ Just $ TxRecord d'' a' e' os' p
|
||||||
-- if no lookups succeeded, return nothing to skip this line. Note that
|
-- 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
|
-- a parse fail will trigger a failure error further up, so that case
|
||||||
-- is already dealt with implicitly
|
-- is already dealt with implicitly
|
||||||
_ -> return Nothing
|
_ -> return Nothing
|
||||||
where
|
where
|
||||||
getField :: FromField a => T.Text -> Parser (Maybe a)
|
parseTxAmount = case toAmount of
|
||||||
getField f = case runParser $ r .: T.encodeUtf8 f of
|
-- The amount column is extra confusing because it can either be one
|
||||||
Left err -> if toSkipMissingFields then return Nothing else fail err
|
-- or two columns, so keep track of this with a maybe. Return Nothing
|
||||||
Right x -> return $ Just x
|
-- to indicate we want to skip the line
|
||||||
|
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
|
||||||
|
AmountDual TxAmount2 {a2Positive, a2Negative, a2Fmt} -> do
|
||||||
|
f1 <- getField a2Positive
|
||||||
|
f2 <- getField a2Negative
|
||||||
|
(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"
|
||||||
|
fmap ((sign *) . abs) <$> parseOrSkipDecimal 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 :: MonadFinance m => [StatementParserRe] -> [TxRecord] -> AppExceptT m [Tx ()]
|
||||||
matchRecords ms rs = do
|
matchRecords ms rs = do
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue