diff --git a/dhall/Types.dhall b/dhall/Types.dhall index 1f11a95..0e93530 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -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 } diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 62bc536..ea4c25e 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -124,58 +124,65 @@ 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 + -- 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 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) - 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 + 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 os', Just ax') -> + (Just d', Just e', Just a', Just os') -> 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 + 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 + 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 + 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 ms rs = do diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index 42fea62..c69711b 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -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)