app/Main.hs

@@ -161,5 +161,4 @@ runSync c = do
     flip runReaderT (s $ takeDirectory c) $ do
       insertBudget $ budget config
       insertStatements config
-
--- showBalances
+    showBalances

lib/Internal/Statement.hs

@@ -23,12 +23,18 @@ import qualified RIO.Vector as V
 
 -- TODO this probably won't scale well (pipes?)
 
-readImport :: MonadUnliftIO m => Import -> MappingT m StatementRes
+readImport :: MonadUnliftIO m => Import -> MappingT m [BalTx]
 readImport Import {..} = do
   rs <- L.sort . concat <$> mapM (readImport_ impSkipLines impDelim impTxOpts) impPaths
-  -- TODO show more useful information here (eg which file emitted this
-  -- error and possibly where)
-  return $ matchRecords impMatches rs
+  case matchRecords impMatches rs of
+    Right (ts, es, notfound) -> do
+      liftIO $ mapM_ putStrLn $ reverse es
+      liftIO $ mapM_ print notfound
+      return ts
+    Left e -> do
+      liftIO $ print e
+      -- TODO make sure that a blank list results in a cache reset in the db
+      return []
 
 readImport_
   :: MonadUnliftIO m
@@ -61,15 +67,19 @@ parseTxRecord TxOpts {..} r = do
       d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
       return $ Just $ TxRecord d' a e os
 
-matchRecords :: [Match] -> [TxRecord] -> StatementRes
-matchRecords ms rs = case matchAll (matchPriorities ms) rs of
-  Left e -> StatementFail $ StatementErrors [] [] [e]
-  Right (matched, unmatched, notfound) ->
-    -- TODO record number of times each match hits for debugging
-    let (errors, matched_) = partitionEithers $ balanceTx <$> matched
-     in case (matched_, unmatched, notfound, errors) of
-          (xs, [], [], []) -> StatementPass xs
-          (_, us, ns, es) -> StatementFail $ StatementErrors us ns es
+matchRecords :: [Match] -> [TxRecord] -> PureErr ([BalTx], [String], [Match])
+matchRecords ms rs = do
+  (matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
+  let (es, ts) =
+        partitionEithers $
+          fmap Just . balanceTx <$> catMaybes matched
+  let bu = fmap (\x -> T.pack $ "unmatched: " ++ show x) unmatched
+  return
+    ( catMaybes ts
+    , T.unpack <$> (es ++ bu)
+    , -- TODO record number of times each match hits for debugging
+      notfound
+    )
 
 matchPriorities :: [Match] -> [MatchGroup]
 matchPriorities =
@@ -146,7 +156,7 @@ matchDec m@Match {mTimes = t} =
   where
     t' = fmap pred t
 
-matchAll :: [MatchGroup] -> [TxRecord] -> PureErr ([RawTx], [TxRecord], [Match])
+matchAll :: [MatchGroup] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchAll = go ([], [])
   where
     go (matched, unused) gs rs = case (gs, rs) of
@@ -156,21 +166,16 @@ matchAll = go ([], [])
         (ts, unmatched, us) <- matchGroup g rs
         go (ts ++ matched, us ++ unused) gs' unmatched
 
-matchGroup :: MatchGroup -> [TxRecord] -> PureErr ([RawTx], [TxRecord], [Match])
+matchGroup :: MatchGroup -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do
   (md, rest, ud) <- matchDates ds rs
   (mn, unmatched, un) <- matchNonDates ns rest
   return (md ++ mn, unmatched, filter ((/= Nothing) . mTimes) $ ud ++ un)
 
-matchDates :: [Match] -> [TxRecord] -> PureErr ([RawTx], [TxRecord], [Match])
+matchDates :: [Match] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchDates ms = go ([], [], initZipper ms)
   where
-    go (matched, unmatched, z) [] =
-      Right
-        ( catMaybes matched
-        , reverse unmatched
-        , recoverZipper z
-        )
+    go (matched, unmatched, z) [] = Right (matched, reverse unmatched, recoverZipper z)
     go (matched, unmatched, z) (r : rs) = case zipperSlice findDate r z of
       Left zipped -> go (matched, r : unmatched, zipped) rs
       Right unzipped -> do
@@ -182,15 +187,10 @@ matchDates ms = go ([], [], initZipper ms)
         go (m, u, z') rs
     findDate m r = maybe EQ (`compareDate` trDate r) $ mDate m
 
-matchNonDates :: [Match] -> [TxRecord] -> PureErr ([RawTx], [TxRecord], [Match])
+matchNonDates :: [Match] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchNonDates ms = go ([], [], initZipper ms)
   where
-    go (matched, unmatched, z) [] =
-      Right
-        ( catMaybes matched
-        , reverse unmatched
-        , recoverZipper z
-        )
+    go (matched, unmatched, z) [] = Right (matched, reverse unmatched, recoverZipper z)
     go (matched, unmatched, z) (r : rs) = do
       (z', res) <- zipperMatch' z r
       let (m, u) = case res of
@@ -199,12 +199,12 @@ matchNonDates ms = go ([], [], initZipper ms)
             MatchFail -> (matched, r : unmatched)
        in go (m, u, resetZipper z') rs
 
-balanceTx :: RawTx -> PureErr BalTx
+balanceTx :: RawTx -> Either T.Text BalTx
 balanceTx t@Tx {txSplits = ss} = do
   bs <- balanceSplits ss
   return $ t {txSplits = bs}
 
-balanceSplits :: [RawSplit] -> PureErr [BalSplit]
+balanceSplits :: [RawSplit] -> Either T.Text [BalSplit]
 balanceSplits ss =
   fmap concat
     <$> mapM (uncurry bal)

lib/Internal/Types.hs

@@ -506,16 +506,3 @@ type BalTx = Tx BalSplit
 type PureErr a = Either T.Text a
 
 data MatchRes a = MatchPass a | MatchFail | MatchSkip
-
-data InsertException = MatchException | RegexException deriving (Show)
-
--- TODO retain file information here for clearer printing purposes
-data StatementErrors = StatementErrors
-  { seUnmatched :: [TxRecord]
-  , seNotFound :: [Match]
-  , seErrors :: [T.Text]
-  }
-
-data StatementRes = StatementPass [BalTx] | StatementFail StatementErrors
-
-instance Exception InsertException