FIX bugs

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
     }

lib/Internal/History.hs

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

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)