From 6b36213a824ae67ab3591ff206db794dfeeef20a Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Fri, 6 Jan 2023 23:10:44 -0500
Subject: [PATCH] ENH use sane error messages when regexps fail

---
 lib/Internal/Statement.hs | 137 +++++++------
 lib/Internal/Types.hs     | 419 ++++++++++++++++++++------------------
 lib/Internal/Utils.hs     |  44 ++--
 3 files changed, 323 insertions(+), 277 deletions(-)

diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs
index 4b690bf..a63a15b 100644
--- a/lib/Internal/Statement.hs
+++ b/lib/Internal/Statement.hs
@@ -24,19 +24,17 @@ import qualified RIO.Vector as V
 -- TODO this probably won't scale well (pipes?)
 
 readImport :: MonadUnliftIO m => Import -> MappingT m [BalTx]
-readImport
-  Import
-    { impPaths = ps
-    , impMatches = ms
-    , impTxOpts = ns
-    , impDelim = d
-    , impSkipLines = n
-    } = do
-    rs <- L.sort . concat <$> mapM (readImport_ n d ns) ps
-    let (ts, es, notfound) = matchRecords ms rs
-    liftIO $ mapM_ putStrLn $ reverse es
-    liftIO $ mapM_ print notfound
-    return ts
+readImport Import {..} = do
+  rs <- L.sort . concat <$> mapM (readImport_ impSkipLines impDelim impTxOpts) impPaths
+  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
@@ -69,19 +67,19 @@ parseTxRecord TxOpts {..} r = do
       d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
       return $ Just $ TxRecord d' a e os
 
-matchRecords :: [Match] -> [TxRecord] -> ([BalTx], [String], [Match])
-matchRecords ms rs =
-  ( catMaybes ts
-  , T.unpack <$> (es ++ bu)
-  , -- TODO record number of times each match hits for debugging
-    notfound
-  )
-  where
-    (matched, unmatched, notfound) = matchAll (matchPriorities ms) rs
-    (es, ts) =
-      partitionEithers $
-        fmap Just . balanceTx <$> catMaybes matched
-    bu = fmap (\x -> T.pack $ "unmatched: " ++ show x) unmatched
+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 =
@@ -129,24 +127,28 @@ zipperSlice f x = go
       EQ -> goEq $ Unzipped bs (a : cs) as
       LT -> z
 
-zipperMatch :: Unzipped Match -> TxRecord -> (Zipped Match, Maybe (Maybe RawTx))
+zipperMatch :: Unzipped Match -> TxRecord -> PureErr (Zipped Match, MatchRes RawTx)
 zipperMatch (Unzipped bs cs as) x = go [] cs
   where
-    go _ [] = (Zipped bs $ cs ++ as, Nothing)
-    go prev (m : ms) = case matches m x of
-      Nothing -> go (m : prev) ms
-      res@(Just _) ->
-        let ps = reverse prev
-            ms' = maybe ms (: ms) (matchDec m)
-         in (Zipped bs $ ps ++ ms' ++ as, res)
+    go _ [] = Right (Zipped bs $ cs ++ as, MatchFail)
+    go prev (m : ms) = do
+      res <- matches m x
+      case res of
+        MatchFail -> go (m : prev) ms
+        skipOrPass ->
+          let ps = reverse prev
+              ms' = maybe ms (: ms) (matchDec m)
+           in Right (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
 
-zipperMatch' :: Zipped Match -> TxRecord -> (Zipped Match, Maybe (Maybe RawTx))
+zipperMatch' :: Zipped Match -> TxRecord -> PureErr (Zipped Match, MatchRes RawTx)
 zipperMatch' z x = go z
   where
-    go (Zipped bs (a : as)) = case matches a x of
-      Nothing -> go (Zipped (a : bs) as)
-      res -> (Zipped (maybe bs (: bs) $ matchDec a) as, res)
-    go z' = (z', Nothing)
+    go (Zipped bs (a : as)) = do
+      res <- matches a x
+      case res of
+        MatchFail -> go (Zipped (a : bs) as)
+        skipOrPass -> Right (Zipped (maybe bs (: bs) $ matchDec a) as, skipOrPass)
+    go z' = Right (z', MatchFail)
 
 matchDec :: Match -> Maybe Match
 matchDec m@Match {mTimes = t} =
@@ -154,46 +156,47 @@ matchDec m@Match {mTimes = t} =
   where
     t' = fmap pred t
 
-matchAll :: [MatchGroup] -> [TxRecord] -> ([Maybe RawTx], [TxRecord], [Match])
+matchAll :: [MatchGroup] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchAll = go ([], [])
   where
     go (matched, unused) gs rs = case (gs, rs) of
-      (_, []) -> (matched, [], unused)
-      ([], _) -> (matched, rs, unused)
-      (g : gs', _) ->
-        let (ts, unmatched, us) = matchGroup g rs
-         in go (ts ++ matched, us ++ unused) gs' unmatched
+      (_, []) -> return (matched, [], unused)
+      ([], _) -> return (matched, rs, unused)
+      (g : gs', _) -> do
+        (ts, unmatched, us) <- matchGroup g rs
+        go (ts ++ matched, us ++ unused) gs' unmatched
 
-matchGroup :: MatchGroup -> [TxRecord] -> ([Maybe RawTx], [TxRecord], [Match])
-matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs =
-  (md ++ mn, unmatched, filter ((/= Nothing) . mTimes) $ ud ++ un)
-  where
-    (md, rest, ud) = matchDates ds rs
-    (mn, unmatched, un) = matchNonDates ns rest
+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] -> ([Maybe RawTx], [TxRecord], [Match])
+matchDates :: [Match] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchDates ms = go ([], [], initZipper ms)
   where
-    go (matched, unmatched, z) [] = (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 res -> go (matched, r : unmatched, res) rs
-      Right res ->
-        let (z', p) = zipperMatch res r
-            (m, u) = case p of
-              Just p' -> (p' : matched, unmatched)
-              Nothing -> (matched, r : unmatched)
-         in go (m, u, z') rs
+      Left zipped -> go (matched, r : unmatched, zipped) rs
+      Right unzipped -> do
+        (z', res) <- zipperMatch unzipped r
+        let (m, u) = case res of
+              MatchPass p -> (Just p : matched, unmatched)
+              MatchSkip -> (Nothing : matched, unmatched)
+              MatchFail -> (matched, r : unmatched)
+        go (m, u, z') rs
     findDate m r = maybe EQ (`compareDate` trDate r) $ mDate m
 
-matchNonDates :: [Match] -> [TxRecord] -> ([Maybe RawTx], [TxRecord], [Match])
+matchNonDates :: [Match] -> [TxRecord] -> PureErr ([Maybe RawTx], [TxRecord], [Match])
 matchNonDates ms = go ([], [], initZipper ms)
   where
-    go (matched, unmatched, z) [] = (matched, reverse unmatched, recoverZipper z)
-    go (matched, unmatched, z) (r : rs) =
-      let (z', res) = zipperMatch' z r
-          (m, u) = case res of
-            Just x -> (x : matched, unmatched)
-            Nothing -> (matched, r : unmatched)
+    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
+            MatchPass p -> (Just p : matched, unmatched)
+            MatchSkip -> (Nothing : matched, unmatched)
+            MatchFail -> (matched, r : unmatched)
        in go (m, u, resetZipper z') rs
 
 balanceTx :: RawTx -> Either T.Text BalTx
diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs
index fbadc7e..885d861 100644
--- a/lib/Internal/Types.hs
+++ b/lib/Internal/Types.hs
@@ -31,52 +31,53 @@ import RIO.Time
 -------------------------------------------------------------------------------
 
 makeHaskellTypesWith
-    (defaultGenerateOptions{generateToDhallInstance = False})
-    [ MultipleConstructors "SqlConfig" "(./dhall/Types.dhall).SqlConfig"
-    , MultipleConstructors "TimeUnit" "(./dhall/Types.dhall).TimeUnit"
-    , MultipleConstructors "Weekday" "(./dhall/Types.dhall).Weekday"
-    , MultipleConstructors "WeekdayPat" "(./dhall/Types.dhall).WeekdayPat"
-    , MultipleConstructors "MDYPat" "(./dhall/Types.dhall).MDYPat"
-    , MultipleConstructors "DatePat" "(./dhall/Types.dhall).DatePat"
-    , MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
-    , MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
-    , MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
-    , MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
-    , SingleConstructor "Currency" "Currency" "(./dhall/Types.dhall).Currency"
-    , SingleConstructor "Gregorian" "Gregorian" "(./dhall/Types.dhall).Gregorian"
-    , SingleConstructor "GregorianM" "GregorianM" "(./dhall/Types.dhall).GregorianM"
-    , SingleConstructor "Interval" "Interval" "(./dhall/Types.dhall).Interval"
-    , SingleConstructor "Global" "Global" "(./dhall/Types.dhall).Global"
-    , SingleConstructor "RepeatPat" "RepeatPat" "(./dhall/Types.dhall).RepeatPat"
-    , SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type"
-    , SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type"
-    , SingleConstructor "Decimal" "D" "(./dhall/Types.dhall).Decimal"
-    , SingleConstructor "TxOpts" "TxOpts" "(./dhall/Types.dhall).TxOpts.Type"
-    , SingleConstructor "MatchVal" "MatchVal" "(./dhall/Types.dhall).MatchVal.Type"
-    , SingleConstructor "Manual" "Manual" "(./dhall/Types.dhall).Manual"
-    , SingleConstructor "Tax" "Tax" "(./dhall/Types.dhall).Tax"
-    ]
+  (defaultGenerateOptions {generateToDhallInstance = False})
+  [ MultipleConstructors "SqlConfig" "(./dhall/Types.dhall).SqlConfig"
+  , MultipleConstructors "TimeUnit" "(./dhall/Types.dhall).TimeUnit"
+  , MultipleConstructors "Weekday" "(./dhall/Types.dhall).Weekday"
+  , MultipleConstructors "WeekdayPat" "(./dhall/Types.dhall).WeekdayPat"
+  , MultipleConstructors "MDYPat" "(./dhall/Types.dhall).MDYPat"
+  , MultipleConstructors "DatePat" "(./dhall/Types.dhall).DatePat"
+  , MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
+  , MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
+  , MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
+  , MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
+  , SingleConstructor "Currency" "Currency" "(./dhall/Types.dhall).Currency"
+  , SingleConstructor "Gregorian" "Gregorian" "(./dhall/Types.dhall).Gregorian"
+  , SingleConstructor "GregorianM" "GregorianM" "(./dhall/Types.dhall).GregorianM"
+  , SingleConstructor "Interval" "Interval" "(./dhall/Types.dhall).Interval"
+  , SingleConstructor "Global" "Global" "(./dhall/Types.dhall).Global"
+  , SingleConstructor "RepeatPat" "RepeatPat" "(./dhall/Types.dhall).RepeatPat"
+  , SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type"
+  , SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type"
+  , SingleConstructor "Decimal" "D" "(./dhall/Types.dhall).Decimal"
+  , SingleConstructor "TxOpts" "TxOpts" "(./dhall/Types.dhall).TxOpts.Type"
+  , SingleConstructor "MatchVal" "MatchVal" "(./dhall/Types.dhall).MatchVal.Type"
+  , SingleConstructor "Manual" "Manual" "(./dhall/Types.dhall).Manual"
+  , SingleConstructor "Tax" "Tax" "(./dhall/Types.dhall).Tax"
+  ]
 
 -------------------------------------------------------------------------------
 -- account tree
 
 data AccountTree
-    = Placeholder T.Text T.Text [AccountTree]
-    | Account T.Text T.Text
+  = Placeholder T.Text T.Text [AccountTree]
+  | Account T.Text T.Text
 
 TH.makeBaseFunctor ''AccountTree
 
 deriving instance Generic (AccountTreeF a)
+
 deriving instance FromDhall a => FromDhall (AccountTreeF a)
 
 data AccountRoot_ a = AccountRoot_
-    { arAssets :: ![a]
-    , arEquity :: ![a]
-    , arExpenses :: ![a]
-    , arIncome :: ![a]
-    , arLiabilities :: ![a]
-    }
-    deriving (Generic)
+  { arAssets :: ![a]
+  , arEquity :: ![a]
+  , arExpenses :: ![a]
+  , arIncome :: ![a]
+  , arLiabilities :: ![a]
+  }
+  deriving (Generic)
 
 type AccountRootF = AccountRoot_ (Fix AccountTreeF)
 
@@ -90,6 +91,7 @@ type AccountRoot = AccountRoot_ AccountTree
 deriving instance Eq Currency
 
 deriving instance Lift Currency
+
 deriving instance Hashable Currency
 
 type CurID = T.Text
@@ -99,30 +101,30 @@ type CurID = T.Text
 -------------------------------------------------------------------------------
 
 data Config_ a = Config_
-    { global :: !Global
-    , budget :: !Budget
-    , currencies :: ![Currency]
-    , statements :: ![Statement]
-    , accounts :: !a
-    , sqlConfig :: !SqlConfig
-    }
-    deriving (Generic)
+  { global :: !Global
+  , budget :: !Budget
+  , currencies :: ![Currency]
+  , statements :: ![Statement]
+  , accounts :: !a
+  , sqlConfig :: !SqlConfig
+  }
+  deriving (Generic)
 
 type ConfigF = Config_ AccountRootF
 
 type Config = Config_ AccountRoot
 
 unfix :: ConfigF -> Config
-unfix c@Config_{accounts = a} = c{accounts = a'}
+unfix c@Config_ {accounts = a} = c {accounts = a'}
   where
     a' =
-        AccountRoot_
-            { arAssets = unfixTree arAssets
-            , arEquity = unfixTree arEquity
-            , arExpenses = unfixTree arExpenses
-            , arIncome = unfixTree arIncome
-            , arLiabilities = unfixTree arLiabilities
-            }
+      AccountRoot_
+        { arAssets = unfixTree arAssets
+        , arEquity = unfixTree arEquity
+        , arExpenses = unfixTree arExpenses
+        , arIncome = unfixTree arIncome
+        , arLiabilities = unfixTree arLiabilities
+        }
     unfixTree f = foldFix embed <$> f a
 
 instance FromDhall a => FromDhall (Config_ a)
@@ -140,233 +142,258 @@ deriving instance Eq TimeUnit
 deriving instance Hashable TimeUnit
 
 deriving instance Eq Weekday
+
 deriving instance Hashable Weekday
 
 deriving instance Eq WeekdayPat
+
 deriving instance Hashable WeekdayPat
 
 deriving instance Show RepeatPat
+
 deriving instance Eq RepeatPat
+
 deriving instance Hashable RepeatPat
 
 deriving instance Show MDYPat
+
 deriving instance Eq MDYPat
+
 deriving instance Hashable MDYPat
 
 deriving instance Eq Gregorian
+
 deriving instance Show Gregorian
+
 deriving instance Hashable Gregorian
 
 deriving instance Eq GregorianM
+
 deriving instance Show GregorianM
+
 deriving instance Hashable GregorianM
 
 -- Dhall.TH rearranges my fields :(
 instance Ord Gregorian where
-    compare
-        Gregorian{gYear = y, gMonth = m, gDay = d}
-        Gregorian{gYear = y', gMonth = m', gDay = d'} =
-            compare y y'
-                <> compare m m'
-                <> compare d d'
+  compare
+    Gregorian {gYear = y, gMonth = m, gDay = d}
+    Gregorian {gYear = y', gMonth = m', gDay = d'} =
+      compare y y'
+        <> compare m m'
+        <> compare d d'
 
 instance Ord GregorianM where
-    compare
-        GregorianM{gmYear = y, gmMonth = m}
-        GregorianM{gmYear = y', gmMonth = m'} = compare y y' <> compare m m'
+  compare
+    GregorianM {gmYear = y, gmMonth = m}
+    GregorianM {gmYear = y', gmMonth = m'} = compare y y' <> compare m m'
 
 deriving instance Eq ModPat
+
 deriving instance Hashable ModPat
 
 deriving instance Eq CronPat
+
 deriving instance Hashable CronPat
 
 deriving instance Eq DatePat
+
 deriving instance Hashable DatePat
 
 --------------------------------------------------------------------------------
 -- Budget (projecting into the future)
 
 data Income = Income
-    { incGross :: !Decimal
-    , incCurrency :: !CurID
-    , incWhen :: !DatePat
-    , incAccount :: !AcntID
-    , incPretax :: ![Allocation Decimal]
-    , incTaxes :: ![Tax]
-    , incPosttax :: ![Allocation (Maybe Decimal)]
-    }
-    deriving (Eq, Hashable, Generic, FromDhall)
+  { incGross :: !Decimal
+  , incCurrency :: !CurID
+  , incWhen :: !DatePat
+  , incAccount :: !AcntID
+  , incPretax :: ![Allocation Decimal]
+  , incTaxes :: ![Tax]
+  , incPosttax :: ![Allocation (Maybe Decimal)]
+  }
+  deriving (Eq, Hashable, Generic, FromDhall)
 
 data Budget = Budget
-    { income :: ![Income]
-    , expenses :: ![Expense]
-    }
-    deriving (Generic, FromDhall)
+  { income :: ![Income]
+  , expenses :: ![Expense]
+  }
+  deriving (Generic, FromDhall)
 
 deriving instance Eq Tax
+
 deriving instance Hashable Tax
 
 data Amount v = Amount
-    { amtValue :: !v
-    , amtDesc :: !T.Text
-    }
-    deriving (Functor, Foldable, Traversable, Eq, Hashable, Generic, FromDhall)
+  { amtValue :: !v
+  , amtDesc :: !T.Text
+  }
+  deriving (Functor, Foldable, Traversable, Eq, Hashable, Generic, FromDhall)
 
 data Allocation v = Allocation
-    { alloPath :: !AcntID
-    , alloBucket :: !Bucket
-    , alloAmts :: ![Amount v]
-    , alloCurrency :: !CurID
-    }
-    deriving (Eq, Hashable, Generic, FromDhall)
+  { alloPath :: !AcntID
+  , alloBucket :: !Bucket
+  , alloAmts :: ![Amount v]
+  , alloCurrency :: !CurID
+  }
+  deriving (Eq, Hashable, Generic, FromDhall)
 
 deriving instance Eq Bucket
+
 deriving instance Hashable Bucket
+
 deriving instance Show Bucket
 
 data TimeAmount = TimeAmount
-    { taWhen :: !DatePat
-    , taAmt :: Amount Decimal
-    }
-    deriving (Eq, Hashable, Generic, FromDhall)
+  { taWhen :: !DatePat
+  , taAmt :: Amount Decimal
+  }
+  deriving (Eq, Hashable, Generic, FromDhall)
 
 data Expense = Expense
-    { expFrom :: !AcntID
-    , expTo :: !AcntID
-    , expBucket :: !Bucket
-    , expAmounts :: ![TimeAmount]
-    , expCurrency :: !CurID
-    }
-    deriving (Eq, Hashable, Generic, FromDhall)
+  { expFrom :: !AcntID
+  , expTo :: !AcntID
+  , expBucket :: !Bucket
+  , expAmounts :: ![TimeAmount]
+  , expCurrency :: !CurID
+  }
+  deriving (Eq, Hashable, Generic, FromDhall)
 
 --------------------------------------------------------------------------------
 -- Statements (data from the past)
 
 data Statement
-    = StmtManual Manual
-    | StmtImport Import
-    deriving (Generic, FromDhall)
+  = StmtManual Manual
+  | StmtImport Import
+  deriving (Generic, FromDhall)
 
 deriving instance Hashable Manual
 
 data Split a v c = Split
-    { sAcnt :: !a
-    , sValue :: !v
-    , sCurrency :: !c
-    , sComment :: !T.Text
-    }
-    deriving (Eq, Generic, Hashable, Show, FromDhall)
+  { sAcnt :: !a
+  , sValue :: !v
+  , sCurrency :: !c
+  , sComment :: !T.Text
+  }
+  deriving (Eq, Generic, Hashable, Show, FromDhall)
 
 type ExpSplit = Split SplitAcnt (Maybe SplitNum) SplitCur
 
 data Tx s = Tx
-    { txDescr :: !T.Text
-    , txDate :: !Day
-    , txTags :: ![T.Text]
-    , txSplits :: ![s]
-    }
-    deriving (Generic)
+  { txDescr :: !T.Text
+  , txDate :: !Day
+  , txTags :: ![T.Text]
+  , txSplits :: ![s]
+  }
+  deriving (Generic)
 
 type ExpTx = Tx ExpSplit
 
 instance FromDhall ExpTx
 
 data Import = Import
-    { impPaths :: ![FilePath]
-    , impMatches :: ![Match]
-    , impDelim :: !Word
-    , impTxOpts :: !TxOpts
-    , impSkipLines :: !Natural
-    }
-    deriving (Hashable, Generic, FromDhall)
+  { impPaths :: ![FilePath]
+  , impMatches :: ![Match]
+  , impDelim :: !Word
+  , impTxOpts :: !TxOpts
+  , impSkipLines :: !Natural
+  }
+  deriving (Hashable, Generic, FromDhall)
 
 deriving instance Eq MatchVal
+
 deriving instance Hashable MatchVal
+
 deriving instance Show MatchVal
 
 deriving instance Eq MatchYMD
+
 deriving instance Hashable MatchYMD
+
 deriving instance Show MatchYMD
 
 deriving instance Eq MatchDate
+
 deriving instance Hashable MatchDate
+
 deriving instance Show MatchDate
 
 -- TODO this just looks silly...but not sure how to simplify it
 instance Ord MatchYMD where
-    compare (Y y) (Y y') = compare y y'
-    compare (YM g) (YM g') = compare g g'
-    compare (YMD g) (YMD g') = compare g g'
-    compare (Y y) (YM g) = compare y (gmYear g) <> LT
-    compare (Y y) (YMD g) = compare y (gYear g) <> LT
-    compare (YM g) (Y y') = compare (gmYear g) y' <> GT
-    compare (YMD g) (Y y') = compare (gYear g) y' <> GT
-    compare (YM g) (YMD g') = compare g (gregM g') <> LT
-    compare (YMD g) (YM g') = compare (gregM g) g' <> GT
+  compare (Y y) (Y y') = compare y y'
+  compare (YM g) (YM g') = compare g g'
+  compare (YMD g) (YMD g') = compare g g'
+  compare (Y y) (YM g) = compare y (gmYear g) <> LT
+  compare (Y y) (YMD g) = compare y (gYear g) <> LT
+  compare (YM g) (Y y') = compare (gmYear g) y' <> GT
+  compare (YMD g) (Y y') = compare (gYear g) y' <> GT
+  compare (YM g) (YMD g') = compare g (gregM g') <> LT
+  compare (YMD g) (YM g') = compare (gregM g) g' <> GT
 
 gregM :: Gregorian -> GregorianM
-gregM Gregorian{gYear = y, gMonth = m} =
-    GregorianM{gmYear = y, gmMonth = m}
+gregM Gregorian {gYear = y, gMonth = m} =
+  GregorianM {gmYear = y, gmMonth = m}
 
 instance Ord MatchDate where
-    compare (On d) (On d') = compare d d'
-    compare (In d r) (In d' r') = compare d d' <> compare r r'
-    compare (On d) (In d' _) = compare d d' <> LT
-    compare (In d _) (On d') = compare d d' <> GT
+  compare (On d) (On d') = compare d d'
+  compare (In d r) (In d' r') = compare d d' <> compare r r'
+  compare (On d) (In d' _) = compare d d' <> LT
+  compare (In d _) (On d') = compare d d' <> GT
 
 deriving instance Eq SplitNum
+
 deriving instance Hashable SplitNum
+
 deriving instance Show SplitNum
 
-{- | the value of a field in split (text version)
- can either be a raw (constant) value, a lookup from the record, or a map
- between the lookup and some other value
--}
+-- | the value of a field in split (text version)
+-- can either be a raw (constant) value, a lookup from the record, or a map
+-- between the lookup and some other value
 data SplitText t
-    = ConstT !t
-    | LookupT !T.Text
-    | MapT (FieldMap T.Text t)
-    | Map2T (FieldMap (T.Text, T.Text) t)
-    deriving (Eq, Generic, Hashable, Show, FromDhall)
+  = ConstT !t
+  | LookupT !T.Text
+  | MapT (FieldMap T.Text t)
+  | Map2T (FieldMap (T.Text, T.Text) t)
+  deriving (Eq, Generic, Hashable, Show, FromDhall)
 
 type SplitCur = SplitText CurID
 
 type SplitAcnt = SplitText AcntID
 
 data Field k v = Field
-    { fKey :: !k
-    , fVal :: !v
-    }
-    deriving (Show, Eq, Hashable, Generic, FromDhall)
+  { fKey :: !k
+  , fVal :: !v
+  }
+  deriving (Show, Eq, Hashable, Generic, FromDhall)
 
 type FieldMap k v = Field k (M.Map k v)
 
 data MatchOther
-    = Desc (Field T.Text T.Text)
-    | Val (Field T.Text MatchVal)
-    deriving (Show, Eq, Hashable, Generic, FromDhall)
+  = Desc (Field T.Text T.Text)
+  | Val (Field T.Text MatchVal)
+  deriving (Show, Eq, Hashable, Generic, FromDhall)
 
 data ToTx = ToTx
-    { ttCurrency :: !SplitCur
-    , ttPath :: !SplitAcnt
-    , ttSplit :: ![ExpSplit]
-    }
-    deriving (Eq, Generic, Hashable, Show, FromDhall)
+  { ttCurrency :: !SplitCur
+  , ttPath :: !SplitAcnt
+  , ttSplit :: ![ExpSplit]
+  }
+  deriving (Eq, Generic, Hashable, Show, FromDhall)
 
 data Match = Match
-    { mDate :: Maybe MatchDate
-    , mVal :: MatchVal
-    , mDesc :: Maybe Text
-    , mOther :: ![MatchOther]
-    , mTx :: Maybe ToTx
-    , mTimes :: Maybe Natural
-    , mPriority :: !Integer
-    }
-    deriving (Eq, Generic, Hashable, Show, FromDhall)
+  { mDate :: Maybe MatchDate
+  , mVal :: MatchVal
+  , mDesc :: Maybe Text
+  , mOther :: ![MatchOther]
+  , mTx :: Maybe ToTx
+  , mTimes :: Maybe Natural
+  , mPriority :: !Integer
+  }
+  deriving (Eq, Generic, Hashable, Show, FromDhall)
 
 deriving instance Eq TxOpts
+
 deriving instance Hashable TxOpts
+
 deriving instance Show TxOpts
 
 --------------------------------------------------------------------------------
@@ -375,42 +402,43 @@ deriving instance Show TxOpts
 deriving instance Eq Decimal
 
 deriving instance Hashable Decimal
+
 deriving instance Show Decimal
 
 --------------------------------------------------------------------------------
 -- database cache types
 
 data ConfigHashes = ConfigHashes
-    { chIncome :: ![Int]
-    , chExpense :: ![Int]
-    , chManual :: ![Int]
-    , chImport :: ![Int]
-    }
+  { chIncome :: ![Int]
+  , chExpense :: ![Int]
+  , chManual :: ![Int]
+  , chImport :: ![Int]
+  }
 
 data ConfigType = CTIncome | CTExpense | CTManual | CTImport
-    deriving (Eq, Show, Read, Enum)
+  deriving (Eq, Show, Read, Enum)
 
 instance PersistFieldSql ConfigType where
-    sqlType _ = SqlString
+  sqlType _ = SqlString
 
 instance PersistField ConfigType where
-    toPersistValue = PersistText . T.pack . show
+  toPersistValue = PersistText . T.pack . show
 
-    -- TODO these error messages *might* be good enough?
-    fromPersistValue (PersistText v) =
-        maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
-    fromPersistValue _ = Left "wrong type"
+  -- TODO these error messages *might* be good enough?
+  fromPersistValue (PersistText v) =
+    maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
+  fromPersistValue _ = Left "wrong type"
 
 -------------------------------------------------------------------------------
 -- misc
 
 data AcntType
-    = AssetT
-    | EquityT
-    | ExpenseT
-    | IncomeT
-    | LiabilityT
-    deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
+  = AssetT
+  | EquityT
+  | ExpenseT
+  | IncomeT
+  | LiabilityT
+  deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
 
 atName :: AcntType -> T.Text
 atName AssetT = "asset"
@@ -420,33 +448,33 @@ atName IncomeT = "income"
 atName LiabilityT = "liability"
 
 data AcntPath = AcntPath
-    { apType :: !AcntType
-    , apChildren :: ![T.Text]
-    }
-    deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
+  { apType :: !AcntType
+  , apChildren :: ![T.Text]
+  }
+  deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
 
 data TxRecord = TxRecord
-    { trDate :: !Day
-    , trAmount :: !Rational
-    , trDesc :: !T.Text
-    , trOther :: M.Map T.Text T.Text
-    }
-    deriving (Show, Eq, Ord)
+  { trDate :: !Day
+  , trAmount :: !Rational
+  , trDesc :: !T.Text
+  , trOther :: M.Map T.Text T.Text
+  }
+  deriving (Show, Eq, Ord)
 
 type Bounds = (Day, Day)
 
 type MaybeBounds = (Maybe Day, Maybe Day)
 
 data Keyed a = Keyed
-    { kKey :: !Int64
-    , kVal :: !a
-    }
-    deriving (Eq, Show, Functor)
+  { kKey :: !Int64
+  , kVal :: !a
+  }
+  deriving (Eq, Show, Functor)
 
 data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
 
 data AcntSign = Credit | Debit
-    deriving (Show)
+  deriving (Show)
 
 sign2Int :: AcntSign -> Int
 sign2Int Debit = 1
@@ -472,4 +500,9 @@ type RawSplit = Split AcntID (Maybe Rational) CurID
 type BalSplit = Split AcntID Rational CurID
 
 type RawTx = Tx RawSplit
+
 type BalTx = Tx BalSplit
+
+type PureErr a = Either T.Text a
+
+data MatchRes a = MatchPass a | MatchFail | MatchSkip
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index 395ebf7..edd920c 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -116,27 +116,32 @@ lookupErr what k m = case M.lookup k m of
   Just x -> x
   _ -> errorT $ T.concat [what, " does not exist: ", T.pack $ show k]
 
-matches :: Match -> TxRecord -> Maybe (Maybe RawTx)
-matches Match {..} r@TxRecord {..}
-  | allPass = Just $ fmap eval mTx
-  | otherwise = Nothing
+matches :: Match -> TxRecord -> PureErr (MatchRes RawTx)
+matches Match {..} r@TxRecord {..} = do
+  let date = checkMaybe (`dateMatches` trDate) mDate
+  let val = valMatches mVal trAmount
+  other <- foldM (\a o -> (a &&) <$> fieldMatches trOther o) True mOther
+  desc <- maybe (return True) (matchMaybe trDesc) mDesc
+  return $
+    if date && val && desc && other
+      then maybe MatchSkip (MatchPass . eval) mTx
+      else MatchFail
   where
-    allPass =
-      checkMaybe (`dateMatches` trDate) mDate
-        && valMatches mVal trAmount
-        && checkMaybe (=~ trDesc) mDesc
-        && all (fieldMatches trOther) mOther
     eval (ToTx cur a ss) = toTx cur a ss r
 
--- TODO these error messages are useless
-fieldMatches :: M.Map T.Text T.Text -> MatchOther -> Bool
+matchMaybe :: RegexContext Regex query b => query -> T.Text -> PureErr b
+matchMaybe q re = first (const msg) $ pureTry $ q =~ re
+  where
+    msg = T.concat ["Could not make regexp from pattern: '", re, "'"]
+
+fieldMatches :: M.Map T.Text T.Text -> MatchOther -> PureErr Bool
 fieldMatches dict m = case m of
-  Val (Field n mv) -> case readRational =<< M.lookup n dict of
-    (Just v) -> valMatches mv v
-    _ -> error "you dummy"
-  Desc (Field n md) -> case M.lookup n dict of
-    (Just d) -> d =~ md
-    _ -> error "you dummy"
+  Val (Field n mv) -> valMatches mv <$> (readRationalMsg =<< lookup_ n)
+  Desc (Field n md) -> (`matchMaybe` md) =<< lookup_ n
+  where
+    lookup_ n = case M.lookup n dict of
+      Just r -> Right r
+      Nothing -> Left $ T.append "Could not find field: " n
 
 checkMaybe :: (a -> Bool) -> Maybe a -> Bool
 checkMaybe = maybe True
@@ -191,6 +196,11 @@ parseRational pat s = case ms of
       k <- readSign sign
       return (k, w)
 
+readRationalMsg :: T.Text -> PureErr Rational
+readRationalMsg t = maybe (Left msg) Right $ readRational t
+  where
+    msg = T.append "Could not convert to rational number: " t
+
 -- TODO don't use a partial function
 readRational :: MonadFail m => T.Text -> m Rational
 readRational s = case TP.splitOn "." s of