diff --git a/app/Main.hs b/app/Main.hs
index f479df0..a0f39d7 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -103,7 +103,7 @@ sync =
 parse :: Options -> IO ()
 parse (Options c Reset) = do
   config <- readConfig c
-  migrate_ (sqlConfig config) nukeTables
+  runDB (sqlConfig config) nukeTables
 parse (Options c DumpAccounts) = runDumpAccounts c
 parse (Options c DumpAccountKeys) = runDumpAccountKeys c
 parse (Options c DumpCurrencies) = runDumpCurrencies c
@@ -155,19 +155,14 @@ runDumpAccountKeys c = do
     t3 (_, _, x) = x
     double x = (x, x)
 
-runSync :: MonadUnliftIO m => FilePath -> m ()
+runSync :: FilePath -> IO ()
 runSync c = do
   config <- readConfig c
-  handle err $ migrate_ (sqlConfig config) $ do
-    res <- getDBState config
-    case res of
-      Left es -> throwIO $ InsertException es
-      Right s -> do
-        let run = mapReaderT $ flip runReaderT (s $ takeDirectory c)
-        es1 <- concat <$> mapM (run . insertBudget) (budget config)
-        es2 <- run $ insertStatements config
-        let es = es1 ++ es2
-        unless (null es) $ throwIO $ InsertException es
+  handle err $ runDB (sqlConfig config) $ do
+    let bgtRes = liftIOExceptT $ mapErrors insertBudget $ budget config
+    let histRes = mapErrorsIO insertStatement $ statements config
+    s <- fmap (\f -> f $ takeDirectory c) $ liftIOExceptT $ getDBState config
+    flip runReaderT s $ combineErrorIO2 bgtRes histRes $ \_ _ -> ()
   where
     err (InsertException es) = do
       liftIO $ mapM_ TI.putStrLn $ concatMap showError es
diff --git a/budget.cabal b/budget.cabal
index 6c1cdb4..c3ae77e 100644
--- a/budget.cabal
+++ b/budget.cabal
@@ -89,6 +89,7 @@ library
     , mtl
     , optparse-applicative
     , persistent >=2.13.3.1
+    , persistent-mtl >=0.3.0.0
     , persistent-sqlite
     , recursion-schemes
     , regex-tdfa
@@ -158,6 +159,7 @@ executable pwncash
     , mtl
     , optparse-applicative
     , persistent >=2.13.3.1
+    , persistent-mtl >=0.3.0.0
     , persistent-sqlite
     , recursion-schemes
     , regex-tdfa
diff --git a/lib/Internal/Database/Ops.hs b/lib/Internal/Database/Ops.hs
index dda0baf..8a09223 100644
--- a/lib/Internal/Database/Ops.hs
+++ b/lib/Internal/Database/Ops.hs
@@ -1,5 +1,5 @@
 module Internal.Database.Ops
-  ( migrate_
+  ( runDB
   , nukeTables
   , updateHashes
   , getDBState
@@ -10,12 +10,15 @@ module Internal.Database.Ops
 where
 
 import Conduit
+import Control.Monad.Except
 import Control.Monad.Logger
 import Data.Hashable
-import Database.Esqueleto.Experimental
-import Database.Persist.Sql hiding (delete, (==.), (||.))
-import Database.Persist.Sqlite hiding (delete, (==.), (||.))
-import Database.Sqlite hiding (Config)
+import Database.Esqueleto.Experimental ((==.), (^.))
+import qualified Database.Esqueleto.Experimental as E
+import Database.Esqueleto.Internal.Internal (SqlSelect)
+import Database.Persist.Monad
+-- import Database.Persist.Sql hiding (delete, runMigration, (==.), (||.))
+import Database.Persist.Sqlite hiding (delete, deleteWhere, insert, insertKey, runMigration, (==.), (||.))
 import GHC.Err
 import Internal.Types
 import Internal.Utils
@@ -26,31 +29,27 @@ import qualified RIO.Map as M
 import qualified RIO.NonEmpty as N
 import qualified RIO.Text as T
 
-migrate_
+runDB
   :: MonadUnliftIO m
   => SqlConfig
-  -> SqlPersistT (ResourceT (NoLoggingT m)) ()
-  -> m ()
-migrate_ c more =
-  runNoLoggingT $
-    runResourceT $
-      withSqlConn
-        (openConnection c)
-        ( \backend ->
-            flip runSqlConn backend $ do
-              _ <- askLoggerIO
-              runMigration migrateAll
-              more
-        )
+  -> SqlQueryT (NoLoggingT m) a
+  -> m a
+runDB c more =
+  runNoLoggingT $ do
+    pool <- mkPool c
+    runSqlQueryT pool $ do
+      _ <- lift askLoggerIO
+      runMigration migrateAll
+      more
 
-openConnection :: MonadUnliftIO m => SqlConfig -> LogFunc -> m SqlBackend
-openConnection c logfn = case c of
-  Sqlite p -> liftIO $ do
-    conn <- open p
-    wrapConnection conn logfn
+mkPool :: (MonadLoggerIO m, MonadUnliftIO m) => SqlConfig -> m ConnectionPool
+mkPool c = case c of
+  Sqlite p -> createSqlitePool p 10
+  -- conn <- open p
+  -- wrapConnection conn logfn
   Postgres -> error "postgres not implemented"
 
-nukeTables :: MonadUnliftIO m => SqlPersistT m ()
+nukeTables :: MonadSqlQuery m => m ()
 nukeTables = do
   deleteWhere ([] :: [Filter CommitR])
   deleteWhere ([] :: [Filter CurrencyR])
@@ -118,54 +117,54 @@ setDiff as bs = (as \\ bs, bs \\ as)
 --       | f a b = Just bs
 --       | otherwise = inB a bs
 
-getDBHashes :: MonadUnliftIO m => SqlPersistT m [Int]
+getDBHashes :: MonadSqlQuery m => m [Int]
 getDBHashes = fmap (commitRHash . entityVal) <$> dumpTbl
 
-nukeDBHash :: MonadUnliftIO m => Int -> SqlPersistT m ()
-nukeDBHash h = delete $ do
-  c <- from table
-  where_ (c ^. CommitRHash ==. val h)
+nukeDBHash :: MonadSqlQuery m => Int -> m ()
+nukeDBHash h = deleteE $ do
+  c <- E.from E.table
+  E.where_ (c ^. CommitRHash ==. E.val h)
 
-nukeDBHashes :: MonadUnliftIO m => [Int] -> SqlPersistT m ()
+nukeDBHashes :: MonadSqlQuery m => [Int] -> m ()
 nukeDBHashes = mapM_ nukeDBHash
 
-getConfigHashes :: MonadUnliftIO m => Config -> SqlPersistT m ([Int], [Int])
+getConfigHashes :: MonadSqlQuery m => Config -> m ([Int], [Int])
 getConfigHashes c = do
   let ch = hashConfig c
   dh <- getDBHashes
   return $ setDiff dh ch
 
-updateHashes :: MonadUnliftIO m => Config -> SqlPersistT m [Int]
+updateHashes :: MonadSqlQuery m => Config -> m [Int]
 updateHashes c = do
   (del, new) <- getConfigHashes c
   nukeDBHashes del
   return new
 
-dumpTbl :: (PersistEntity r, MonadUnliftIO m) => SqlPersistT m [Entity r]
-dumpTbl = select $ from table
+dumpTbl :: (MonadSqlQuery m, PersistEntity r) => m [Entity r]
+dumpTbl = selectE $ E.from E.table
 
-deleteAccount :: MonadUnliftIO m => Entity AccountR -> SqlPersistT m ()
-deleteAccount e = delete $ do
-  c <- from $ table @AccountR
-  where_ (c ^. AccountRId ==. val k)
+deleteAccount :: MonadSqlQuery m => Entity AccountR -> m ()
+deleteAccount e = deleteE $ do
+  c <- E.from $ E.table @AccountR
+  E.where_ (c ^. AccountRId ==. E.val k)
   where
     k = entityKey e
 
-deleteCurrency :: MonadUnliftIO m => Entity CurrencyR -> SqlPersistT m ()
-deleteCurrency e = delete $ do
-  c <- from $ table @CurrencyR
-  where_ (c ^. CurrencyRId ==. val k)
+deleteCurrency :: MonadSqlQuery m => Entity CurrencyR -> m ()
+deleteCurrency e = deleteE $ do
+  c <- E.from $ E.table @CurrencyR
+  E.where_ (c ^. CurrencyRId ==. E.val k)
   where
     k = entityKey e
 
-deleteTag :: MonadUnliftIO m => Entity TagR -> SqlPersistT m ()
-deleteTag e = delete $ do
-  c <- from $ table @TagR
-  where_ (c ^. TagRId ==. val k)
+deleteTag :: MonadSqlQuery m => Entity TagR -> m ()
+deleteTag e = deleteE $ do
+  c <- E.from $ E.table @TagR
+  E.where_ (c ^. TagRId ==. E.val k)
   where
     k = entityKey e
 
-updateAccounts :: MonadUnliftIO m => AccountRoot -> SqlPersistT m AccountMap
+updateAccounts :: MonadSqlQuery m => AccountRoot -> m AccountMap
 updateAccounts ar = do
   let (acnts, paths, acntMap) = indexAcntRoot ar
   acnts' <- dumpTbl
@@ -179,15 +178,15 @@ updateAccounts ar = do
 
 -- TODO slip-n-slide code...
 insertFull
-  :: (MonadUnliftIO m, PersistStoreWrite b, PersistRecordBackend r b)
+  :: (PersistRecordBackend r SqlBackend, Typeable r, MonadSqlQuery m)
   => Entity r
-  -> ReaderT b m ()
+  -> m ()
 insertFull (Entity k v) = insertKey k v
 
-updateCurrencies :: MonadUnliftIO m => [Currency] -> SqlPersistT m CurrencyMap
+updateCurrencies :: MonadSqlQuery m => [Currency] -> m CurrencyMap
 updateCurrencies cs = do
   let curs = fmap currency2Record cs
-  curs' <- select $ from $ table @CurrencyR
+  curs' <- selectE $ E.from $ E.table @CurrencyR
   let (toIns, toDel) = setDiff curs curs'
   mapM_ deleteCurrency toDel
   mapM_ insertFull toIns
@@ -207,10 +206,10 @@ currencyMap =
           )
       )
 
-updateTags :: MonadUnliftIO m => [Tag] -> SqlPersistT m TagMap
+updateTags :: MonadSqlQuery m => [Tag] -> m TagMap
 updateTags cs = do
   let tags = fmap toRecord cs
-  tags' <- select $ from $ table @TagR
+  tags' <- selectE $ E.from $ E.table @TagR
   let (toIns, toDel) = setDiff tags tags'
   mapM_ deleteTag toDel
   mapM_ insertFull toIns
@@ -324,9 +323,9 @@ indexAcntRoot r =
     (ars, aprs, ms) = L.unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
 
 getDBState
-  :: MonadUnliftIO m
+  :: (MonadInsertError m, MonadSqlQuery m)
   => Config
-  -> SqlPersistT m (EitherErrs (FilePath -> DBState))
+  -> m (FilePath -> DBState)
 getDBState c = do
   am <- updateAccounts $ accounts c
   cm <- updateCurrencies $ currencies c
@@ -334,7 +333,7 @@ getDBState c = do
   hs <- updateHashes c
   -- TODO not sure how I feel about this, probably will change this struct alot
   -- in the future so whatever...for now
-  return $ concatEither2 bi si $ \b s f ->
+  combineError bi si $ \b s f ->
     DBState
       { kmCurrency = cm
       , kmAccount = am
@@ -345,5 +344,11 @@ getDBState c = do
       , kmTag = ts
       }
   where
-    bi = resolveBounds $ budgetInterval $ global c
-    si = resolveBounds $ statementInterval $ global c
+    bi = liftExcept $ resolveBounds $ budgetInterval $ global c
+    si = liftExcept $ resolveBounds $ statementInterval $ global c
+
+deleteE :: (MonadSqlQuery m) => E.SqlQuery () -> m ()
+deleteE q = unsafeLiftSql "esqueleto-delete" (E.delete q)
+
+selectE :: (MonadSqlQuery m, SqlSelect a r) => E.SqlQuery a -> m [r]
+selectE q = unsafeLiftSql "esqueleto-select" (E.select q)
diff --git a/lib/Internal/Insert.hs b/lib/Internal/Insert.hs
index 5d7a866..443ac5e 100644
--- a/lib/Internal/Insert.hs
+++ b/lib/Internal/Insert.hs
@@ -1,14 +1,14 @@
 module Internal.Insert
-  ( insertStatements
+  ( insertStatement
   , insertBudget
   )
 where
 
+import Control.Monad.Except
 import Data.Hashable
-import Database.Persist.Class
-import Database.Persist.Sql hiding (Single, Statement)
+import Database.Persist.Monad
 import Internal.Statement
-import Internal.Types hiding (CurrencyM, sign)
+import Internal.Types
 import Internal.Utils
 import RIO hiding (to)
 import qualified RIO.List as L
@@ -20,9 +20,9 @@ import RIO.Time
 --------------------------------------------------------------------------------
 -- intervals
 
-expandDatePat :: Bounds -> DatePat -> EitherErrs [Day]
+expandDatePat :: Bounds -> DatePat -> InsertExcept [Day]
 expandDatePat b (Cron cp) = expandCronPat b cp
-expandDatePat i (Mod mp) = Right $ expandModPat mp i
+expandDatePat i (Mod mp) = return $ expandModPat mp i
 
 expandModPat :: ModPat -> Bounds -> [Day]
 expandModPat ModPat {mpStart = s, mpBy = b, mpUnit = u, mpRepeats = r} bs =
@@ -39,9 +39,9 @@ expandModPat ModPat {mpStart = s, mpBy = b, mpUnit = u, mpRepeats = r} bs =
       Month -> addGregorianMonthsClip
       Year -> addGregorianYearsClip
 
-expandCronPat :: Bounds -> CronPat -> EitherErrs [Day]
+expandCronPat :: Bounds -> CronPat -> InsertExcept [Day]
 expandCronPat b CronPat {cpYear, cpMonth, cpDay, cpWeekly} =
-  concatEither3 yRes mRes dRes $ \ys ms ds ->
+  combineError3 yRes mRes dRes $ \ys ms ds ->
     filter validWeekday $
       mapMaybe (uncurry3 toDay) $
         takeWhile (\((y, _), m, d) -> (y, m, d) <= (yb1, mb1, db1)) $
@@ -70,38 +70,37 @@ expandCronPat b CronPat {cpYear, cpMonth, cpDay, cpWeekly} =
       | m `elem` [4, 6, 9, 11] && d > 30 = Nothing
       | otherwise = Just $ fromGregorian y m d
 
-expandMDYPat :: Natural -> Natural -> MDYPat -> EitherErr [Natural]
-expandMDYPat lower upper (Single x) = Right [x | lower <= x && x <= upper]
-expandMDYPat lower upper (Multi xs) = Right $ dropWhile (<= lower) $ takeWhile (<= upper) xs
-expandMDYPat lower upper (After x) = Right [max lower x .. upper]
-expandMDYPat lower upper (Before x) = Right [lower .. min upper x]
-expandMDYPat lower upper (Between x y) = Right [max lower x .. min upper y]
+expandMDYPat :: Natural -> Natural -> MDYPat -> InsertExcept [Natural]
+expandMDYPat lower upper (Single x) = return [x | lower <= x && x <= upper]
+expandMDYPat lower upper (Multi xs) = return $ dropWhile (<= lower) $ takeWhile (<= upper) xs
+expandMDYPat lower upper (After x) = return [max lower x .. upper]
+expandMDYPat lower upper (Before x) = return [lower .. min upper x]
+expandMDYPat lower upper (Between x y) = return [max lower x .. min upper y]
 expandMDYPat lower upper (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r})
-  | b < 1 = Left $ PatternError s b r ZeroLength
+  | b < 1 = throwError $ InsertException [PatternError s b r ZeroLength]
   | otherwise = do
       k <- limit r
       return $ dropWhile (<= lower) $ takeWhile (<= k) [s + i * b | i <- [0 ..]]
   where
-    limit Nothing = Right upper
+    limit Nothing = return upper
     limit (Just n)
       -- this guard not only produces the error for the user but also protects
       -- from an underflow below it
-      | n < 1 = Left $ PatternError s b r ZeroRepeats
-      | otherwise = Right $ min (s + b * (n - 1)) upper
+      | n < 1 = throwError $ InsertException [PatternError s b r ZeroRepeats]
+      | otherwise = return $ min (s + b * (n - 1)) upper
 
 dayToWeekday :: Day -> Int
 dayToWeekday (ModifiedJulianDay d) = mod (fromIntegral d + 2) 7
 
 withDates
-  :: MonadFinance m
+  :: (MonadSqlQuery m, MonadFinance m, MonadInsertError m)
   => DatePat
-  -> (Day -> SqlPersistT m (EitherErrs a))
-  -> SqlPersistT m (EitherErrs [a])
+  -> (Day -> m a)
+  -> m [a]
 withDates dp f = do
-  bounds <- lift $ askDBState kmBudgetInterval
-  case expandDatePat bounds dp of
-    Left es -> return $ Left es
-    Right days -> concatEithersL <$> mapM f days
+  bounds <- askDBState kmBudgetInterval
+  days <- liftExcept $ expandDatePat bounds dp
+  combineErrors $ fmap f days
 
 --------------------------------------------------------------------------------
 -- budget
@@ -117,7 +116,7 @@ withDates dp f = do
 -- 4. assign shadow transactions (TODO)
 -- 5. insert all transactions
 
-insertBudget :: MonadFinance m => Budget -> SqlPersistT m [InsertError]
+insertBudget :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) => Budget -> m ()
 insertBudget
   b@Budget
     { bgtLabel
@@ -128,23 +127,21 @@ insertBudget
     , bgtTax
     , bgtPosttax
     } =
-    whenHash CTBudget b [] $ \key -> do
-      unlessLefts intAllos $ \intAllos_ -> do
-        res1 <- mapM (insertIncome key bgtLabel intAllos_) bgtIncomes
-        res2 <- expandTransfers key bgtLabel bgtTransfers
-        unlessLefts (concatEithers2 (concat <$> concatEithersL res1) res2 (++)) $
-          \txs -> do
-            m <- lift $ askDBState kmCurrency
-            unlessLefts (addShadowTransfers m bgtShadowTransfers txs) $ \shadow -> do
-              let bals = balanceTransfers $ txs ++ shadow
-              concat <$> mapM insertBudgetTx bals
+    whenHash CTBudget b () $ \key -> do
+      intAllos <- combineError3 pre_ tax_ post_ (,,)
+      let res1 = combineErrors $ fmap (insertIncome key bgtLabel intAllos) bgtIncomes
+      let res2 = expandTransfers key bgtLabel bgtTransfers
+      txs <- combineError (concat <$> res1) res2 (++)
+      m <- askDBState kmCurrency
+      shadow <- liftExcept $ addShadowTransfers m bgtShadowTransfers txs
+      let bals = balanceTransfers $ txs ++ shadow
+      _ <- combineErrors $ fmap insertBudgetTx bals
+      return ()
     where
-      intAllos =
-        let pre_ = sortAllos bgtPretax
-            tax_ = sortAllos bgtTax
-            post_ = sortAllos bgtPosttax
-         in concatEithers3 pre_ tax_ post_ (,,)
-      sortAllos = concatEithersL . fmap sortAllo
+      pre_ = sortAllos bgtPretax
+      tax_ = sortAllos bgtTax
+      post_ = sortAllos bgtPosttax
+      sortAllos = liftExcept . combineErrors . fmap sortAllo
 
 type BoundAllocation = Allocation (Day, Day)
 
@@ -155,9 +152,9 @@ type IntAllocations =
   )
 
 -- TODO this should actually error if there is no ultimate end date?
-sortAllo :: MultiAllocation v -> EitherErrs (BoundAllocation v)
+sortAllo :: MultiAllocation v -> InsertExcept (BoundAllocation v)
 sortAllo a@Allocation {alloAmts = as} = do
-  bs <- foldBounds (Right []) $ L.sortOn amtWhen as
+  bs <- foldBounds (return []) $ L.sortOn amtWhen as
   return $ a {alloAmts = reverse bs}
   where
     foldBounds acc [] = acc
@@ -166,17 +163,17 @@ sortAllo a@Allocation {alloAmts = as} = do
             [] -> resolveBounds $ amtWhen x
             (y : _) -> resolveBounds_ (intStart $ amtWhen y) $ amtWhen x
           concatRes bs acc' = x {amtWhen = expandBounds bs} : acc'
-       in foldBounds (concatEithers2 (plural res) acc concatRes) xs
+       in foldBounds (combineError res acc concatRes) xs
 
 -- TODO this is going to be O(n*m), which might be a problem?
 addShadowTransfers
   :: CurrencyMap
   -> [ShadowTransfer]
   -> [UnbalancedTransfer]
-  -> EitherErrs [UnbalancedTransfer]
+  -> InsertExcept [UnbalancedTransfer]
 addShadowTransfers cm ms txs =
   fmap catMaybes $
-    concatEithersL $
+    combineErrors $
       fmap (uncurry (fromShadow cm)) $
         [(t, m) | t <- txs, m <- ms]
 
@@ -184,7 +181,7 @@ fromShadow
   :: CurrencyMap
   -> UnbalancedTransfer
   -> ShadowTransfer
-  -> EitherErrs (Maybe UnbalancedTransfer)
+  -> InsertExcept (Maybe UnbalancedTransfer)
 fromShadow cm tx t@ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stType} = do
   res <- shadowMatches (stMatch t) tx
   v <- roundPrecisionCur (initialCurrency stCurrency) cm stRatio
@@ -204,7 +201,7 @@ fromShadow cm tx t@ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, st
             , cbtDesc = stDesc
             }
 
-shadowMatches :: TransferMatcher -> UnbalancedTransfer -> EitherErrs Bool
+shadowMatches :: TransferMatcher -> UnbalancedTransfer -> InsertExcept Bool
 shadowMatches TransferMatcher {tmFrom, tmTo, tmDate, tmVal} tx = do
   valRes <- valMatches tmVal $ cvValue $ cbtValue tx
   return $
@@ -265,28 +262,26 @@ type UnbalancedTransfer = FlatTransfer UnbalancedValue
 type BalancedTransfer = FlatTransfer Rational
 
 insertIncome
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
   => CommitRId
   -> T.Text
   -> IntAllocations
   -> Income
-  -> SqlPersistT m (EitherErrs [UnbalancedTransfer])
+  -> m [UnbalancedTransfer]
 insertIncome
   key
   name
   (intPre, intTax, intPost)
   Income {incWhen, incCurrency, incFrom, incPretax, incPosttax, incTaxes, incToBal, incGross} = do
     -- TODO check that the other accounts are not income somewhere here
-    fromRes <- lift $ checkAcntType IncomeT $ taAcnt incFrom
-    precRes <- lift $ lookupCurrencyPrec incCurrency
-    case concatEithers2 fromRes precRes (,) of
-      Left e -> return $ Left e
-      -- TODO this will scan the interval allocations fully each time
-      -- iteration which is a total waste, but the fix requires turning this
-      -- loop into a fold which I don't feel like doing now :(
-      Right (_, p) ->
-        let gross = roundPrecision p incGross
-         in fmap concat <$> withDates incWhen (return . allocate p gross)
+    _ <- checkAcntType IncomeT $ taAcnt incFrom
+    precision <- lookupCurrencyPrec incCurrency
+    -- TODO this will scan the interval allocations fully each time
+    -- iteration which is a total waste, but the fix requires turning this
+    -- loop into a fold which I don't feel like doing now :(
+    let gross = roundPrecision precision incGross
+    res <- withDates incWhen (allocate precision gross)
+    return $ concat res
     where
       meta = BudgetMeta key name
       flatPre = concatMap flattenAllo incPretax
@@ -317,8 +312,8 @@ insertIncome
                 , cbtDesc = "balance after deductions"
                 }
          in if balance < 0
-              then Left [IncomeError day name balance]
-              else Right $ bal : fmap (allo2Trans meta day incFrom) (pre ++ tax ++ post)
+              then throwError $ InsertException [IncomeError day name balance]
+              else return (bal : fmap (allo2Trans meta day incFrom) (pre ++ tax ++ post))
 
 allocatePre
   :: Natural
@@ -421,62 +416,55 @@ selectAllos day Allocation {alloAmts, alloCur, alloTo} =
         }
 
 expandTransfers
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
   => CommitRId
   -> T.Text
   -> [BudgetTransfer]
-  -> SqlPersistT m (EitherErrs [UnbalancedTransfer])
-expandTransfers key name ts = do
-  txs <- mapM (expandTransfer key name) ts
-  return $ L.sortOn cbtWhen . concat <$> concatEithersL txs
+  -> m [UnbalancedTransfer]
+expandTransfers key name ts =
+  fmap (L.sortOn cbtWhen . concat) $
+    combineErrors $
+      fmap (expandTransfer key name) ts
 
 initialCurrency :: BudgetCurrency -> CurID
 initialCurrency (NoX c) = c
 initialCurrency (X Exchange {xFromCur = c}) = c
 
 expandTransfer
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
   => CommitRId
   -> T.Text
   -> BudgetTransfer
-  -> SqlPersistT m (EitherErrs [UnbalancedTransfer])
+  -> m [UnbalancedTransfer]
 expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} = do
-  pRes <- lift $ lookupCurrencyPrec $ initialCurrency transCurrency
-  case pRes of
-    Left es -> return $ Left es
-    Right p ->
-      fmap (fmap concat . concatEithersL) $
-        forM transAmounts $
-          \Amount
-            { amtWhen = pat
-            , amtValue = BudgetTransferValue {btVal = v, btType = y}
-            , amtDesc = desc
-            } ->
-              do
-                withDates pat $ \day ->
-                  let meta =
-                        BudgetMeta
-                          { bmCommit = key
-                          , bmName = name
-                          }
-                      tx =
-                        FlatTransfer
-                          { cbtMeta = meta
-                          , cbtWhen = day
-                          , cbtCur = transCurrency
-                          , cbtFrom = transFrom
-                          , cbtTo = transTo
-                          , cbtValue = UnbalancedValue y $ roundPrecision p v
-                          , cbtDesc = desc
-                          }
-                   in return $ Right tx
+  precision <- lookupCurrencyPrec $ initialCurrency transCurrency
+  fmap concat $ combineErrors $ fmap (go precision) transAmounts
+  where
+    go
+      precision
+      Amount
+        { amtWhen = pat
+        , amtValue = BudgetTransferValue {btVal = v, btType = y}
+        , amtDesc = desc
+        } =
+        withDates pat $ \day -> do
+          let meta = BudgetMeta {bmCommit = key, bmName = name}
+          return
+            FlatTransfer
+              { cbtMeta = meta
+              , cbtWhen = day
+              , cbtCur = transCurrency
+              , cbtFrom = transFrom
+              , cbtTo = transTo
+              , cbtValue = UnbalancedValue y $ roundPrecision precision v
+              , cbtDesc = desc
+              }
 
-insertBudgetTx :: MonadFinance m => BalancedTransfer -> SqlPersistT m [InsertError]
+insertBudgetTx :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) => BalancedTransfer -> m ()
 insertBudgetTx FlatTransfer {cbtFrom, cbtTo, cbtMeta, cbtCur, cbtValue, cbtDesc, cbtWhen} = do
-  res <- lift $ splitPair cbtFrom cbtTo cbtCur cbtValue
-  unlessLefts_ res $ \((sFrom, sTo), exchange) -> do
-    insertPair sFrom sTo
-    forM_ exchange $ uncurry insertPair
+  ((sFrom, sTo), exchange) <- splitPair cbtFrom cbtTo cbtCur cbtValue
+  insertPair sFrom sTo
+  forM_ exchange $ uncurry insertPair
   where
     insertPair from to = do
       k <- insert $ TransactionR (bmCommit cbtMeta) cbtWhen cbtDesc
@@ -489,24 +477,24 @@ insertBudgetTx FlatTransfer {cbtFrom, cbtTo, cbtMeta, cbtCur, cbtValue, cbtDesc,
 type SplitPair = (KeySplit, KeySplit)
 
 splitPair
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadFinance m)
   => TaggedAcnt
   -> TaggedAcnt
   -> BudgetCurrency
   -> Rational
-  -> m (EitherErrs (SplitPair, Maybe SplitPair))
+  -> m (SplitPair, Maybe SplitPair)
 splitPair from to cur val = case cur of
-  NoX curid -> fmap (,Nothing) <$> pair curid from to val
+  NoX curid -> (,Nothing) <$> pair curid from to val
   X Exchange {xFromCur, xToCur, xAcnt, xRate} -> do
     let middle = TaggedAcnt xAcnt []
-    res1 <- pair xFromCur from middle val
-    res2 <- pair xToCur middle to (val * roundPrecision 3 xRate)
-    return $ concatEithers2 res1 res2 $ \a b -> (a, Just b)
+    let res1 = pair xFromCur from middle val
+    let res2 = pair xToCur middle to (val * roundPrecision 3 xRate)
+    combineError res1 res2 $ \a b -> (a, Just b)
   where
     pair curid from_ to_ v = do
-      s1 <- split curid from_ (-v)
-      s2 <- split curid to_ v
-      return $ concatEithers2 s1 s2 (,)
+      let s1 = split curid from_ (-v)
+      let s2 = split curid to_ v
+      combineError s1 s2 (,)
     split c TaggedAcnt {taAcnt, taTags} v =
       resolveSplit $
         Entry
@@ -518,34 +506,37 @@ splitPair from to cur val = case cur of
           }
 
 checkAcntType
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadFinance m)
   => AcntType
   -> AcntID
-  -> m (EitherErrs AcntID)
+  -> m AcntID
 checkAcntType t = checkAcntTypes (t :| [])
 
 checkAcntTypes
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadFinance m)
   => NE.NonEmpty AcntType
   -> AcntID
-  -> m (EitherErrs AcntID)
-checkAcntTypes ts i = (go =<<) <$> lookupAccountType i
+  -> m AcntID
+checkAcntTypes ts i = go =<< lookupAccountType i
   where
     go t
-      | t `L.elem` ts = Right i
-      | otherwise = Left [AccountError i ts]
+      | t `L.elem` ts = return i
+      | otherwise = throwError $ InsertException [AccountError i ts]
 
 --------------------------------------------------------------------------------
 -- statements
 
-insertStatements :: MonadFinance m => Config -> SqlPersistT m [InsertError]
-insertStatements conf = concat <$> mapM insertStatement (statements conf)
-
-insertStatement :: MonadFinance m => History -> SqlPersistT m [InsertError]
-insertStatement (HistTransfer m) = insertManual m
+insertStatement
+  :: (MonadUnliftIO m, MonadSqlQuery m, MonadFinance m)
+  => History
+  -> m ()
+insertStatement (HistTransfer m) = liftIOExceptT $ insertManual m
 insertStatement (HistStatement i) = insertImport i
 
-insertManual :: MonadFinance m => HistTransfer -> SqlPersistT m [InsertError]
+insertManual
+  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
+  => HistTransfer
+  -> m ()
 insertManual
   m@Transfer
     { transFrom = from
@@ -553,48 +544,42 @@ insertManual
     , transCurrency = u
     , transAmounts = amts
     } = do
-    whenHash CTManual m [] $ \c -> do
-      bounds <- lift $ askDBState kmStatementInterval
-      precRes <- lift $ lookupCurrencyPrec u
-      es <- forM amts $ \Amount {amtWhen, amtValue, amtDesc} -> do
-        let dayRes = expandDatePat bounds amtWhen
-        -- TODO rounding too often
-        unlessLefts (concatEithers2 dayRes precRes (,)) $ \(days, p) -> do
-          let tx day = txPair day from to u (roundPrecision p amtValue) amtDesc
-          txRes <- mapM (lift . tx) days
-          unlessLefts_ (concatEithersL txRes) $ mapM_ (insertTx c)
-      return $ concat es
+    whenHash CTManual m () $ \c -> do
+      bounds <- askDBState kmStatementInterval
+      let precRes = lookupCurrencyPrec u
+      let go Amount {amtWhen, amtValue, amtDesc} = do
+            let dayRes = liftExcept $ expandDatePat bounds amtWhen
+            (days, precision) <- combineError dayRes precRes (,)
+            let tx day = txPair day from to u (roundPrecision precision amtValue) amtDesc
+            keys <- combineErrors $ fmap tx days
+            mapM_ (insertTx c) keys
+      void $ combineErrors $ fmap go amts
 
-insertImport :: MonadFinance m => Statement -> SqlPersistT m [InsertError]
-insertImport i = whenHash CTImport i [] $ \c -> do
+insertImport
+  :: (MonadUnliftIO m, MonadSqlQuery m, MonadFinance m)
+  => Statement
+  -> m ()
+insertImport i = whenHash CTImport i () $ \c -> do
   -- TODO this isn't efficient, the whole file will be read and maybe no
   -- transactions will be desired
-  recoverIO (lift $ readImport i) $ \r -> unlessLefts r $ \bs -> do
-    bounds <- expandBounds <$> lift (askDBState kmStatementInterval)
-    res <- mapM (lift . resolveTx) $ filter (inBounds bounds . txDate) bs
-    unlessLefts_ (concatEithersL res) $ mapM_ (insertTx c)
-  where
-    recoverIO x rest = do
-      res <- tryIO x
-      case res of
-        Right r -> rest r
-        -- If file is not found (or something else happens) then collect the
-        -- error try the remaining imports
-        Left e -> return [InsertIOError $ showT e]
+  bs <- readImport i
+  bounds <- expandBounds <$> askDBState kmStatementInterval
+  keys <- liftIOExceptT $ mapErrors resolveTx $ filter (inBounds bounds . txDate) bs
+  mapM_ (insertTx c) keys
 
 --------------------------------------------------------------------------------
 -- low-level transaction stuff
 
 -- TODO tags here?
 txPair
-  :: MonadFinance m
+  :: (MonadInsertError m, MonadFinance m)
   => Day
   -> AcntID
   -> AcntID
   -> CurID
   -> Rational
   -> T.Text
-  -> m (EitherErrs KeyTx)
+  -> m KeyTx
 txPair day from to cur val desc = resolveTx tx
   where
     split a v =
@@ -612,73 +597,83 @@ txPair day from to cur val desc = resolveTx tx
         , txSplits = [split from (-val), split to val]
         }
 
-resolveTx :: MonadFinance m => BalTx -> m (EitherErrs KeyTx)
-resolveTx t@Tx {txSplits = ss} = do
-  res <- concatEithersL <$> mapM resolveSplit ss
-  return $ fmap (\kss -> t {txSplits = kss}) res
+resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
+resolveTx t@Tx {txSplits = ss} =
+  fmap (\kss -> t {txSplits = kss}) $
+    combineErrors $
+      fmap resolveSplit ss
 
-resolveSplit :: MonadFinance m => BalSplit -> m (EitherErrs KeySplit)
+resolveSplit :: (MonadInsertError m, MonadFinance m) => BalSplit -> m KeySplit
 resolveSplit s@Entry {eAcnt, eCurrency, eValue, eTags} = do
-  aid <- lookupAccountKey eAcnt
-  cid <- lookupCurrencyKey eCurrency
-  sign <- lookupAccountSign eAcnt
-  tags <- mapM lookupTag eTags
+  let aRes = lookupAccountKey eAcnt
+  let cRes = lookupCurrencyKey eCurrency
+  let sRes = lookupAccountSign eAcnt
+  let tagRes = combineErrors $ fmap lookupTag eTags
   -- TODO correct sign here?
   -- TODO lenses would be nice here
-  return $
-    concatEithers2 (concatEithers3 aid cid sign (,,)) (concatEithersL tags) $
-      \(aid_, cid_, sign_) tags_ ->
-        s
-          { eAcnt = aid_
-          , eCurrency = cid_
-          , eValue = eValue * fromIntegral (sign2Int sign_)
-          , eTags = tags_
-          }
+  combineError (combineError3 aRes cRes sRes (,,)) tagRes $
+    \(aid, cid, sign) tags ->
+      s
+        { eAcnt = aid
+        , eCurrency = cid
+        , eValue = eValue * fromIntegral (sign2Int sign)
+        , eTags = tags
+        }
 
-insertTx :: MonadUnliftIO m => Key CommitR -> KeyTx -> SqlPersistT m ()
+insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
 insertTx c Tx {txDate = d, txDescr = e, txSplits = ss} = do
   k <- insert $ TransactionR c d e
   mapM_ (insertSplit k) ss
 
-insertSplit :: MonadUnliftIO m => Key TransactionR -> KeySplit -> SqlPersistT m (Key SplitR)
+insertSplit :: MonadSqlQuery m => TransactionRId -> KeySplit -> m SplitRId
 insertSplit t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do
   k <- insert $ SplitR t eCurrency eAcnt eComment eValue
   mapM_ (insert_ . TagRelationR k) eTags
   return k
 
-lookupAccount :: MonadFinance m => AcntID -> m (EitherErrs (Key AccountR, AcntSign, AcntType))
-lookupAccount p = lookupErr (DBKey AcntField) p <$> askDBState kmAccount
+lookupAccount :: (MonadInsertError m, MonadFinance m) => AcntID -> m (AccountRId, AcntSign, AcntType)
+lookupAccount = lookupFinance AcntField kmAccount
 
-lookupAccountKey :: MonadFinance m => AcntID -> m (EitherErrs (Key AccountR))
-lookupAccountKey = fmap (fmap fstOf3) . lookupAccount
+lookupAccountKey :: (MonadInsertError m, MonadFinance m) => AcntID -> m AccountRId
+lookupAccountKey = fmap fstOf3 . lookupAccount
 
-lookupAccountSign :: MonadFinance m => AcntID -> m (EitherErrs AcntSign)
-lookupAccountSign = fmap (fmap sndOf3) . lookupAccount
+lookupAccountSign :: (MonadInsertError m, MonadFinance m) => AcntID -> m AcntSign
+lookupAccountSign = fmap sndOf3 . lookupAccount
 
-lookupAccountType :: MonadFinance m => AcntID -> m (EitherErrs AcntType)
-lookupAccountType = fmap (fmap thdOf3) . lookupAccount
+lookupAccountType :: (MonadInsertError m, MonadFinance m) => AcntID -> m AcntType
+lookupAccountType = fmap thdOf3 . lookupAccount
 
-lookupCurrency :: MonadFinance m => T.Text -> m (EitherErrs (Key CurrencyR, Natural))
-lookupCurrency c = lookupErr (DBKey CurField) c <$> askDBState kmCurrency
+lookupCurrency :: (MonadInsertError m, MonadFinance m) => T.Text -> m (CurrencyRId, Natural)
+lookupCurrency = lookupFinance CurField kmCurrency
 
-lookupCurrencyKey :: MonadFinance m => AcntID -> m (EitherErrs (Key CurrencyR))
-lookupCurrencyKey = fmap (fmap fst) . lookupCurrency
+lookupCurrencyKey :: (MonadInsertError m, MonadFinance m) => AcntID -> m CurrencyRId
+lookupCurrencyKey = fmap fst . lookupCurrency
 
-lookupCurrencyPrec :: MonadFinance m => AcntID -> m (EitherErrs Natural)
-lookupCurrencyPrec = fmap (fmap snd) . lookupCurrency
+lookupCurrencyPrec :: (MonadInsertError m, MonadFinance m) => AcntID -> m Natural
+lookupCurrencyPrec = fmap snd . lookupCurrency
 
-lookupTag :: MonadFinance m => TagID -> m (EitherErrs (Key TagR))
-lookupTag c = lookupErr (DBKey TagField) c <$> askDBState kmTag
+lookupTag :: (MonadInsertError m, MonadFinance m) => TagID -> m TagRId
+lookupTag = lookupFinance TagField kmTag
+
+lookupFinance
+  :: (MonadInsertError m, MonadFinance m)
+  => SplitIDType
+  -> (DBState -> M.Map T.Text a)
+  -> T.Text
+  -> m a
+lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< askDBState f
 
 -- TODO this hashes twice (not that it really matters)
+-- TODO generalize this (persistent mtl)
+
 whenHash
-  :: (Hashable a, MonadFinance m)
+  :: (Hashable a, MonadFinance m, MonadSqlQuery m)
   => ConfigType
   -> a
   -> b
-  -> (Key CommitR -> SqlPersistT m b)
-  -> SqlPersistT m b
+  -> (CommitRId -> m b)
+  -> m b
 whenHash t o def f = do
   let h = hash o
-  hs <- lift $ askDBState kmNewCommits
+  hs <- askDBState kmNewCommits
   if h `elem` hs then f =<< insert (CommitR h t) else return def
diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs
index c6496bb..e7a325e 100644
--- a/lib/Internal/Statement.hs
+++ b/lib/Internal/Statement.hs
@@ -5,6 +5,8 @@ module Internal.Statement
   )
 where
 
+import Control.Monad.Error.Class
+import Control.Monad.Except
 import Data.Csv
 import Internal.Types
 import Internal.Utils
@@ -18,33 +20,33 @@ import RIO.Time
 import qualified RIO.Vector as V
 
 -- TODO this probably won't scale well (pipes?)
-
-readImport :: MonadFinance m => Statement -> m (EitherErrs [BalTx])
+readImport :: (MonadUnliftIO m, MonadFinance m) => Statement -> m [BalTx]
 readImport Statement {..} = do
-  let ores = plural $ compileOptions stmtTxOpts
-  let cres = concatEithersL $ compileMatch <$> stmtParsers
+  let ores = compileOptions stmtTxOpts
+  let cres = combineErrors $ compileMatch <$> stmtParsers
+  (compiledOptions, compiledMatches) <- liftIOExcept $ combineError ores cres (,)
+  let readStmt = readImport_ stmtSkipLines stmtDelim compiledOptions
+  records <- L.sort . concat <$> mapErrorsIO readStmt stmtPaths
   m <- askDBState kmCurrency
-  case concatEithers2 ores cres (,) of
-    Right (compiledOptions, compiledMatches) -> do
-      ires <- mapM (readImport_ stmtSkipLines stmtDelim compiledOptions) stmtPaths
-      case concatEitherL ires of
-        Right records -> return $ runReader (matchRecords compiledMatches $ L.sort $ concat records) m
-        Left es -> return $ Left es
-    Left es -> return $ Left es
+  fromEither $
+    flip runReader m $
+      runExceptT $
+        matchRecords compiledMatches records
 
 readImport_
-  :: MonadFinance m
+  :: (MonadUnliftIO m, MonadFinance m)
   => Natural
   -> Word
   -> TxOptsRe
   -> FilePath
-  -> m (EitherErr [TxRecord])
+  -> m [TxRecord]
 readImport_ n delim tns p = do
   dir <- askDBState kmConfigDir
-  bs <- liftIO $ BL.readFile $ dir </> p
+  res <- tryIO $ BL.readFile $ dir </> p
+  bs <- fromEither $ first (InsertException . (: []) . InsertIOError . showT) res
   case decodeByNameWithP (parseTxRecord p tns) opts $ skip bs of
-    Left m -> return $ Left $ ParseError $ T.pack m
-    Right (_, v) -> return $ Right $ catMaybes $ V.toList v
+    Left m -> throwIO $ InsertException [ParseError $ T.pack m]
+    Right (_, v) -> return $ catMaybes $ V.toList v
   where
     opts = defaultDecodeOptions {decDelimiter = fromIntegral delim}
     skip = BL.intercalate "\n" . L.drop (fromIntegral n) . BL.split 10
@@ -63,17 +65,13 @@ parseTxRecord p TxOpts {..} r = do
       d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
       return $ Just $ TxRecord d' a e os p
 
-matchRecords :: [MatchRe] -> [TxRecord] -> CurrencyM (EitherErrs [BalTx])
+matchRecords :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM [BalTx]
 matchRecords ms rs = do
-  res <- matchAll (matchPriorities ms) rs
-  case res of
-    Left es -> return $ Left es
-    Right (matched, unmatched, notfound) -> do
-      case (matched, unmatched, notfound) of
-        (ms_, [], []) -> do
-          -- TODO record number of times each match hits for debugging
-          return $ first (: []) $ mapM balanceTx ms_
-        (_, us, ns) -> return $ Left [StatementError us ns]
+  (matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
+  case (matched, unmatched, notfound) of
+    -- TODO record number of times each match hits for debugging
+    (ms_, [], []) -> liftInner $ combineErrors $ fmap balanceTx ms_
+    (_, us, ns) -> throwError $ InsertException [StatementError us ns]
 
 matchPriorities :: [MatchRe] -> [MatchGroup]
 matchPriorities =
@@ -130,35 +128,33 @@ zipperSlice f x = go
 zipperMatch
   :: Unzipped MatchRe
   -> TxRecord
-  -> CurrencyM (EitherErrs (Zipped MatchRe, MatchRes RawTx))
+  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes RawTx)
 zipperMatch (Unzipped bs cs as) x = go [] cs
   where
-    go _ [] = return $ Right (Zipped bs $ cs ++ as, MatchFail)
+    go _ [] = return (Zipped bs $ cs ++ as, MatchFail)
     go prev (m : ms) = do
       res <- matches m x
       case res of
-        Right MatchFail -> go (m : prev) ms
-        Right skipOrPass ->
+        MatchFail -> go (m : prev) ms
+        skipOrPass ->
           let ps = reverse prev
               ms' = maybe ms (: ms) (matchDec m)
-           in return $ Right (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
-        Left es -> return $ Left es
+           in return (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
 
 -- TODO all this unpacking left/error crap is annoying
 zipperMatch'
   :: Zipped MatchRe
   -> TxRecord
-  -> CurrencyM (EitherErrs (Zipped MatchRe, MatchRes RawTx))
+  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes RawTx)
 zipperMatch' z x = go z
   where
     go (Zipped bs (a : as)) = do
       res <- matches a x
       case res of
-        Right MatchFail -> go (Zipped (a : bs) as)
-        Right skipOrPass ->
-          return $ Right (Zipped (maybe bs (: bs) $ matchDec a) as, skipOrPass)
-        Left es -> return $ Left es
-    go z' = return $ Right (z', MatchFail)
+        MatchFail -> go (Zipped (a : bs) as)
+        skipOrPass ->
+          return (Zipped (maybe bs (: bs) $ matchDec a) as, skipOrPass)
+    go z' = return (z', MatchFail)
 
 matchDec :: MatchRe -> Maybe MatchRe
 matchDec m = case spTimes m of
@@ -166,83 +162,66 @@ matchDec m = case spTimes m of
   Just n -> Just $ m {spTimes = Just $ n - 1}
   Nothing -> Just m
 
-matchAll :: [MatchGroup] -> [TxRecord] -> CurrencyM (EitherErrs ([RawTx], [TxRecord], [MatchRe]))
+matchAll :: [MatchGroup] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
 matchAll = go ([], [])
   where
     go (matched, unused) gs rs = case (gs, rs) of
-      (_, []) -> return $ Right (matched, [], unused)
-      ([], _) -> return $ Right (matched, rs, unused)
+      (_, []) -> return (matched, [], unused)
+      ([], _) -> return (matched, rs, unused)
       (g : gs', _) -> do
-        res <- matchGroup g rs
-        case res of
-          Right (ts, unmatched, us) ->
-            go (ts ++ matched, us ++ unused) gs' unmatched
-          Left es -> return $ Left es
+        (ts, unmatched, us) <- matchGroup g rs
+        go (ts ++ matched, us ++ unused) gs' unmatched
 
-matchGroup :: MatchGroup -> [TxRecord] -> CurrencyM (EitherErrs ([RawTx], [TxRecord], [MatchRe]))
+matchGroup :: MatchGroup -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
 matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do
-  res <- matchDates ds rs
-  case res of
-    Left es -> return $ Left es
-    Right (md, rest, ud) -> do
-      res' <- matchNonDates ns rest
-      case res' of
-        Right (mn, unmatched, un) -> do
-          return $ Right $ (md ++ mn, unmatched, filter ((/= Nothing) . spTimes) $ ud ++ un)
-        Left es -> return $ Left es
+  (md, rest, ud) <- matchDates ds rs
+  (mn, unmatched, un) <- matchNonDates ns rest
+  return (md ++ mn, unmatched, filter ((/= Nothing) . spTimes) $ ud ++ un)
 
-matchDates :: [MatchRe] -> [TxRecord] -> CurrencyM (EitherErrs ([RawTx], [TxRecord], [MatchRe]))
+matchDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
 matchDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
-      return $
-        Right
-          ( catMaybes matched
-          , reverse unmatched
-          , recoverZipper z
-          )
+      return
+        ( catMaybes 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
-          res <- zipperMatch unzipped r
-          case res of
-            Right (z', res') -> do
-              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
-            Left es -> return $ Left es
+          (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) $ spDate m
 
-matchNonDates :: [MatchRe] -> [TxRecord] -> CurrencyM (EitherErrs ([RawTx], [TxRecord], [MatchRe]))
+matchNonDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
 matchNonDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
-      return $
-        Right
-          ( catMaybes matched
-          , reverse unmatched
-          , recoverZipper z
-          )
+      return
+        ( catMaybes matched
+        , reverse unmatched
+        , recoverZipper z
+        )
     go (matched, unmatched, z) (r : rs) = do
-      res <- zipperMatch' z r
-      case res of
-        Left es -> return $ Left es
-        Right (z', res') -> do
-          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
+      (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 -> EitherErr BalTx
+balanceTx :: RawTx -> InsertExcept BalTx
 balanceTx t@Tx {txSplits = ss} = do
   bs <- balanceSplits ss
   return $ t {txSplits = bs}
 
-balanceSplits :: [RawSplit] -> EitherErr [BalSplit]
+balanceSplits :: [RawSplit] -> InsertExcept [BalSplit]
 balanceSplits ss =
   fmap concat
     <$> mapM (uncurry bal)
@@ -252,11 +231,11 @@ balanceSplits ss =
     haeValue s@Entry {eValue = Just v} = Right s {eValue = v}
     haeValue s = Left s
     bal cur rss
-      | length rss < 2 = Left $ BalanceError TooFewSplits cur rss
+      | length rss < 2 = throwError $ InsertException [BalanceError TooFewSplits cur rss]
       | otherwise = case partitionEithers $ fmap haeValue rss of
-          ([noVal], val) -> Right $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val
-          ([], val) -> Right val
-          _ -> Left $ BalanceError NotOneBlank cur rss
+          ([noVal], val) -> return $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val
+          ([], val) -> return val
+          _ -> throwError $ InsertException [BalanceError NotOneBlank cur rss]
 
 groupByKey :: Ord k => [(k, v)] -> [(k, [v])]
 groupByKey = M.toList . M.fromListWith (++) . fmap (second (: []))
diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs
index d8f05c1..d42dac9 100644
--- a/lib/Internal/Types.hs
+++ b/lib/Internal/Types.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Internal.Types where
 
--- import Control.Monad.Except
+import Control.Monad.Except
 import Data.Fix (Fix (..), foldFix)
 import Data.Functor.Foldable (embed)
 import qualified Data.Functor.Foldable.TH as TH
@@ -601,8 +602,6 @@ data DBState = DBState
 
 type CurrencyM = Reader CurrencyMap
 
-type MappingT m = ReaderT DBState (SqlPersistT m)
-
 type KeySplit = Entry AccountRId Rational CurrencyRId TagRId
 
 type KeyTx = Tx KeySplit
@@ -611,13 +610,12 @@ type TreeR = Tree ([T.Text], AccountRId)
 
 type Balances = M.Map AccountRId Rational
 
-type BalanceM m = ReaderT (MVar Balances) m
+type BalanceM = ReaderT (MVar Balances)
 
-class MonadUnliftIO m => MonadFinance m where
-  askDBState :: (DBState -> a) -> m a
+type MonadFinance = MonadReader DBState
 
-instance MonadUnliftIO m => MonadFinance (ReaderT DBState m) where
-  askDBState = asks
+askDBState :: MonadFinance m => (DBState -> a) -> m a
+askDBState = asks
 
 class MonadUnliftIO m => MonadBalance m where
   askBalances :: m (MVar Balances)
@@ -746,17 +744,16 @@ data InsertError
   | StatementError ![TxRecord] ![MatchRe]
   deriving (Show)
 
-newtype InsertException = InsertException [InsertError] deriving (Show)
+newtype InsertException = InsertException [InsertError]
+  deriving (Show, Semigroup) via [InsertError]
 
 instance Exception InsertException
 
-type EitherErr = Either InsertError
+type MonadInsertError = MonadError InsertException
 
-type EitherErrs = Either [InsertError]
+type InsertExceptT = ExceptT InsertException
 
--- type InsertExceptT m = ExceptT [InsertError] m
-
--- type InsertExcept = InsertExceptT Identity
+type InsertExcept = InsertExceptT Identity
 
 data XGregorian = XGregorian
   { xgYear :: !Int
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index 9f25089..f1dee17 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -7,15 +7,33 @@ module Internal.Utils
   , fromGregorian'
   , resolveBounds
   , resolveBounds_
-  , leftToMaybe
-  , concatEithers2
-  , concatEithers3
-  , concatEither3
-  , concatEither2
-  , concatEitherL
-  , concatEithersL
-  , concatEither2M
-  , concatEithers2M
+  , liftInner
+  , liftExceptT
+  , liftExcept
+  , liftIOExcept
+  , liftIOExceptT
+  , combineError
+  , combineError_
+  , combineError3
+  , combineErrors
+  , mapErrors
+  , combineErrorM
+  , combineErrorM3
+  , combineErrorIO2
+  , combineErrorIO3
+  , combineErrorIOM2
+  , combineErrorIOM3
+  , collectErrorsIO
+  , mapErrorsIO
+  -- , leftToMaybe
+  -- , concatEithers2
+  -- , concatEithers3
+  -- , concatEither3
+  -- , concatEither2
+  -- , concatEitherL
+  -- , concatEithersL
+  -- , concatEither2M
+  -- , concatEithers2M
   , parseRational
   , showError
   , unlessLeft_
@@ -31,7 +49,7 @@ module Internal.Utils
   , sndOf3
   , thdOf3
   , xGregToDay
-  , plural
+  -- , plural
   , compileMatch
   , compileOptions
   , dateMatches
@@ -41,6 +59,8 @@ module Internal.Utils
   )
 where
 
+import Control.Monad.Error.Class
+import Control.Monad.Except
 import Control.Monad.Reader
 import Data.Time.Format.ISO8601
 import GHC.Real
@@ -134,17 +154,17 @@ fromGregorian' = uncurry3 fromGregorian . gregTup
 inBounds :: (Day, Day) -> Day -> Bool
 inBounds (d0, d1) x = d0 <= x && x < d1
 
-resolveBounds :: Interval -> EitherErr Bounds
+resolveBounds :: Interval -> InsertExcept Bounds
 resolveBounds i@Interval {intStart = s} =
   resolveBounds_ (s {gYear = gYear s + 50}) i
 
-resolveBounds_ :: Gregorian -> Interval -> EitherErr Bounds
+resolveBounds_ :: Gregorian -> Interval -> InsertExcept Bounds
 resolveBounds_ def Interval {intStart = s, intEnd = e} =
   case fromGregorian' <$> e of
-    Nothing -> Right $ toBounds $ fromGregorian' def
+    Nothing -> return $ toBounds $ fromGregorian' def
     Just e_
-      | s_ < e_ -> Right $ toBounds e_
-      | otherwise -> Left $ BoundsError s e
+      | s_ < e_ -> return $ toBounds e_
+      | otherwise -> throwError $ InsertException [BoundsError s e]
   where
     s_ = fromGregorian' s
     toBounds end = (s_, fromIntegral $ diffDays end s_ - 1)
@@ -155,30 +175,26 @@ expandBounds (d, n) = (d, addDays (fromIntegral n + 1) d)
 --------------------------------------------------------------------------------
 -- matching
 
-matches :: MatchRe -> TxRecord -> CurrencyM (EitherErrs (MatchRes RawTx))
+matches :: MatchRe -> TxRecord -> InsertExceptT CurrencyM (MatchRes RawTx)
 matches
   StatementParser {spTx, spOther, spVal, spDate, spDesc}
   r@TxRecord {trDate, trAmount, trDesc, trOther} = do
-    let res = concatEithers3 val other desc $ \x y z -> x && y && z && date
-    case res of
-      Right test
-        | test -> maybe (return $ Right MatchSkip) convert spTx
-        | otherwise -> return $ Right MatchFail
-      Left es -> return $ Left es
+    res <- liftInner $
+      combineError3 val other desc $
+        \x y z -> x && y && z && date
+    if res
+      then maybe (return MatchSkip) convert spTx
+      else return MatchFail
     where
       val = valMatches spVal trAmount
       date = maybe True (`dateMatches` trDate) spDate
       other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
       desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
-      convert (TxGetter cur a ss) = do
-        res <- toTx cur a ss r
-        return $ fmap MatchPass res
+      convert (TxGetter cur a ss) = MatchPass <$> toTx cur a ss r
 
-toTx :: SplitCur -> SplitAcnt -> [EntryGetter] -> TxRecord -> CurrencyM (EitherErrs RawTx)
+toTx :: SplitCur -> SplitAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx
 toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do
-  m <- ask
-  let ssRes = concatEithersL $ fmap (resolveEntry m r) toSplits
-  return $ concatEithers2 acRes ssRes $ \(a, c) ss ->
+  combineError3 acntRes curRes ssRes $ \a c ss ->
     let fromSplit =
           Entry
             { eAcnt = a
@@ -193,13 +209,15 @@ toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do
           , txSplits = fromSplit : ss
           }
   where
-    acRes = concatEithers2 (resolveAcnt r sa) (resolveCurrency r sc) (,)
+    acntRes = liftInner $ resolveAcnt r sa
+    curRes = liftInner $ resolveCurrency r sc
+    ssRes = combineErrors $ fmap (resolveEntry r) toSplits
 
-valMatches :: ValMatcher -> Rational -> EitherErrs Bool
+valMatches :: ValMatcher -> Rational -> InsertExcept Bool
 valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
-  | Just d_ <- vmDen, d_ >= p = Left [MatchValPrecisionError d_ p]
+  | Just d_ <- vmDen, d_ >= p = throwError $ InsertException [MatchValPrecisionError d_ p]
   | otherwise =
-      Right $
+      return $
         checkMaybe (s ==) vmSign
           && checkMaybe (n ==) vmNum
           && checkMaybe ((d * fromIntegral p ==) . fromIntegral) vmDen
@@ -212,58 +230,138 @@ valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
 dateMatches :: DateMatcher -> Day -> Bool
 dateMatches md = (EQ ==) . compareDate md
 
-otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> EitherErrs Bool
+otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> InsertExcept Bool
 otherMatches dict m = case m of
   Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
   Desc (Field n (_, md)) -> (`matchMaybe` md) =<< lookup_ MatchText n
   where
     lookup_ t n = lookupErr (MatchField t) n dict
 
-resolveEntry :: CurrencyMap -> TxRecord -> EntryGetter -> EitherErrs RawSplit
-resolveEntry m r s@Entry {eAcnt, eValue, eCurrency} = do
-  (a, c, v) <- concatEithers2 acRes valRes $ \(a, c) v -> (a, c, v)
-  v' <- mapM (roundPrecisionCur c m) v
-  return $
-    s
-      { eAcnt = a
-      , eValue = v'
-      , eCurrency = c
-      }
+resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawSplit
+resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do
+  m <- ask
+  liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
+    v' <- mapM (roundPrecisionCur c m) v
+    return $ s {eAcnt = a, eValue = v', eCurrency = c}
   where
-    acRes = concatEithers2 (resolveAcnt r eAcnt) (resolveCurrency r eCurrency) (,)
+    acntRes = resolveAcnt r eAcnt
+    curRes = resolveCurrency r eCurrency
     valRes = mapM (resolveValue r) eValue
 
-resolveValue :: TxRecord -> EntryNumGetter -> EitherErrs Double
+liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a
+liftInner = mapExceptT (return . runIdentity)
+
+liftExceptT :: MonadError e m => ExceptT e m a -> m a
+liftExceptT x = runExceptT x >>= either throwError return
+
+liftExcept :: MonadError e m => Except e a -> m a
+liftExcept = either throwError return . runExcept
+
+-- tryError :: MonadError e m => m a -> m (Either e a)
+-- tryError action = (Right <$> action) `catchError` (pure . Left)
+
+liftIOExceptT :: MonadIO m => InsertExceptT m a -> m a
+liftIOExceptT = fromEither <=< runExceptT
+
+liftIOExcept :: MonadIO m => InsertExcept a -> m a
+liftIOExcept = fromEither . runExcept
+
+combineError :: MonadError InsertException m => m a -> m b -> (a -> b -> c) -> m c
+combineError a b f = combineErrorM a b (\x y -> pure $ f x y)
+
+combineError_ :: MonadError InsertException m => m a -> m b -> m ()
+combineError_ a b = do
+  _ <- catchError a $ \e ->
+    throwError =<< catchError (e <$ b) (return . (e <>))
+  _ <- b
+  return ()
+
+combineErrorM :: MonadError InsertException m => m a -> m b -> (a -> b -> m c) -> m c
+combineErrorM a b f = do
+  a' <- catchError a $ \e ->
+    throwError =<< catchError (e <$ b) (return . (e <>))
+  f a' =<< b
+
+combineError3 :: MonadError InsertException m => m a -> m b -> m c -> (a -> b -> c -> d) -> m d
+combineError3 a b c f =
+  combineError (combineError a b (,)) c $ \(x, y) z -> f x y z
+
+combineErrorM3 :: MonadError InsertException m => m a -> m b -> m c -> (a -> b -> c -> m d) -> m d
+combineErrorM3 a b c f = do
+  combineErrorM (combineErrorM a b (curry return)) c $ \(x, y) z -> f x y z
+
+combineErrors :: MonadError InsertException m => [m a] -> m [a]
+combineErrors = mapErrors id
+
+mapErrors :: MonadError InsertException m => (a -> m b) -> [a] -> m [b]
+mapErrors f xs = do
+  ys <- mapM (go . f) xs
+  case partitionEithers ys of
+    ([], zs) -> return zs
+    (e : es, _) -> throwError $ foldr (<>) e es
+  where
+    go x = catchError (Right <$> x) (pure . Left)
+
+combineErrorIO2 :: MonadUnliftIO m => m a -> m b -> (a -> b -> c) -> m c
+combineErrorIO2 a b f = combineErrorIOM2 a b (\x y -> pure $ f x y)
+
+combineErrorIO3 :: MonadUnliftIO m => m a -> m b -> m c -> (a -> b -> c -> d) -> m d
+combineErrorIO3 a b c f = combineErrorIOM3 a b c (\x y z -> pure $ f x y z)
+
+combineErrorIOM2 :: MonadUnliftIO m => m a -> m b -> (a -> b -> m c) -> m c
+combineErrorIOM2 a b f = do
+  a' <- catch a $ \(InsertException es) ->
+    (throwIO . InsertException)
+      =<< catch (es <$ b) (\(InsertException es') -> return (es' ++ es))
+  f a' =<< b
+
+combineErrorIOM3 :: MonadUnliftIO m => m a -> m b -> m c -> (a -> b -> c -> m d) -> m d
+combineErrorIOM3 a b c f =
+  combineErrorIOM2 (combineErrorIOM2 a b (curry return)) c $ \(x, y) z -> f x y z
+
+mapErrorsIO :: MonadUnliftIO m => (a -> m b) -> [a] -> m [b]
+mapErrorsIO f xs = do
+  ys <- mapM (go . f) xs
+  case partitionEithers ys of
+    ([], zs) -> return zs
+    (es, _) -> throwIO $ InsertException $ concat es
+  where
+    go x = catch (Right <$> x) $ \(InsertException es) -> pure $ Left es
+
+collectErrorsIO :: MonadUnliftIO m => [m a] -> m [a]
+collectErrorsIO = mapErrorsIO id
+
+resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept Double
 resolveValue r s = case s of
   (LookupN t) -> readDouble =<< lookupErr SplitValField t (trOther r)
-  (ConstN c) -> Right c
+  (ConstN c) -> return c
   -- TODO don't coerce to rational in trAmount
-  AmountN -> Right $ fromRational $ trAmount r
+  AmountN -> return $ fromRational $ trAmount r
 
-resolveAcnt :: TxRecord -> SplitAcnt -> EitherErrs T.Text
+resolveAcnt :: TxRecord -> SplitAcnt -> InsertExcept T.Text
 resolveAcnt = resolveSplitField AcntField
 
-resolveCurrency :: TxRecord -> SplitCur -> EitherErrs T.Text
+resolveCurrency :: TxRecord -> SplitCur -> InsertExcept T.Text
 resolveCurrency = resolveSplitField CurField
 
-resolveSplitField :: SplitIDType -> TxRecord -> SplitAcnt -> EitherErrs T.Text
+resolveSplitField :: SplitIDType -> TxRecord -> SplitAcnt -> InsertExcept T.Text
 resolveSplitField t TxRecord {trOther = o} s = case s of
-  ConstT p -> Right p
+  ConstT p -> return p
   LookupT f -> lookup_ f o
   MapT (Field f m) -> do
     k <- lookup_ f o
     lookup_ k m
   Map2T (Field (f1, f2) m) -> do
-    (k1, k2) <- concatEithers2 (lookup_ f1 o) (lookup_ f2 o) (,)
+    (k1, k2) <- combineError (lookup_ f1 o) (lookup_ f2 o) (,)
     lookup_ (k1, k2) m
   where
-    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> EitherErrs v
+    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v
     lookup_ = lookupErr (SplitIDField t)
 
-lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> EitherErrs v
+lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> InsertExcept v
 lookupErr what k m = case M.lookup k m of
-  Just x -> Right x
-  _ -> Left [LookupError what $ showT k]
+  Just x -> return x
+  _ -> throwError $ InsertException [LookupError what $ showT k]
 
 parseRational :: MonadFail m => (T.Text, Regex) -> T.Text -> m Rational
 parseRational (pat, re) s = case matchGroupsMaybe s re of
@@ -292,12 +390,12 @@ parseRational (pat, re) s = case matchGroupsMaybe s re of
       k <- readSign sign
       return (k, w)
 
-readDouble :: T.Text -> EitherErrs Double
+readDouble :: T.Text -> InsertExcept Double
 readDouble s = case readMaybe $ T.unpack s of
-  Just x -> Right x
-  Nothing -> Left [ConversionError s]
+  Just x -> return x
+  Nothing -> throwError $ InsertException [ConversionError s]
 
-readRational :: T.Text -> EitherErrs Rational
+readRational :: T.Text -> InsertExcept Rational
 readRational s = case T.split (== '.') s of
   [x] -> maybe err (return . fromInteger) $ readT x
   [x, y] -> case (readT x, readT y) of
@@ -309,7 +407,7 @@ readRational s = case T.split (== '.') s of
   _ -> err
   where
     readT = readMaybe . T.unpack
-    err = Left [ConversionError s]
+    err = throwError $ InsertException [ConversionError s]
 
 -- TODO smells like a lens
 -- mapTxSplits :: (a -> b) -> Tx a -> Tx b
@@ -331,17 +429,11 @@ roundPrecision n = (% p) . round . (* fromIntegral p) . toRational
   where
     p = 10 ^ n
 
-roundPrecisionCur :: CurID -> CurrencyMap -> Double -> EitherErrs Rational
+roundPrecisionCur :: CurID -> CurrencyMap -> Double -> InsertExcept Rational
 roundPrecisionCur c m x =
   case M.lookup c m of
-    Just (_, n) -> Right $ roundPrecision n x
-    Nothing -> Left undefined
-
--- dec2Rat :: Decimal -> Rational
--- dec2Rat D {sign, whole, decimal, precision} =
---   k * (fromIntegral whole + (fromIntegral decimal % (10 ^ precision)))
---   where
---     k = if sign then 1 else -1
+    Just (_, n) -> return $ roundPrecision n x
+    Nothing -> throwError $ InsertException [undefined]
 
 acntPath2Text :: AcntPath -> T.Text
 acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
@@ -538,51 +630,51 @@ showT = T.pack . show
 --------------------------------------------------------------------------------
 -- pure error processing
 
-concatEither2 :: Either x a -> Either x b -> (a -> b -> c) -> Either [x] c
-concatEither2 a b fun = case (a, b) of
-  (Right a_, Right b_) -> Right $ fun a_ b_
-  _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
+-- concatEither2 :: Either x a -> Either x b -> (a -> b -> c) -> Either [x] c
+-- concatEither2 a b fun = case (a, b) of
+--   (Right a_, Right b_) -> Right $ fun a_ b_
+--   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
 
-concatEither2M :: Monad m => Either x a -> Either x b -> (a -> b -> m c) -> m (Either [x] c)
-concatEither2M a b fun = case (a, b) of
-  (Right a_, Right b_) -> Right <$> fun a_ b_
-  _ -> return $ Left $ catMaybes [leftToMaybe a, leftToMaybe b]
+-- concatEither2M :: Monad m => Either x a -> Either x b -> (a -> b -> m c) -> m (Either [x] c)
+-- concatEither2M a b fun = case (a, b) of
+--   (Right a_, Right b_) -> Right <$> fun a_ b_
+--   _ -> return $ Left $ catMaybes [leftToMaybe a, leftToMaybe b]
 
-concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
-concatEither3 a b c fun = case (a, b, c) of
-  (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
-  _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
+-- concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
+-- concatEither3 a b c fun = case (a, b, c) of
+--   (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
+--   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
 
-concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
-concatEithers2 a b = merge . concatEither2 a b
+-- concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
+-- concatEithers2 a b = merge . concatEither2 a b
 
-concatEithers2M
-  :: Monad m
-  => Either [x] a
-  -> Either [x] b
-  -> (a -> b -> m c)
-  -> m (Either [x] c)
-concatEithers2M a b = fmap merge . concatEither2M a b
+-- concatEithers2M
+--   :: Monad m
+--   => Either [x] a
+--   -> Either [x] b
+--   -> (a -> b -> m c)
+--   -> m (Either [x] c)
+-- concatEithers2M a b = fmap merge . concatEither2M a b
 
-concatEithers3
-  :: Either [x] a
-  -> Either [x] b
-  -> Either [x] c
-  -> (a -> b -> c -> d)
-  -> Either [x] d
-concatEithers3 a b c = merge . concatEither3 a b c
+-- concatEithers3
+--   :: Either [x] a
+--   -> Either [x] b
+--   -> Either [x] c
+--   -> (a -> b -> c -> d)
+--   -> Either [x] d
+-- concatEithers3 a b c = merge . concatEither3 a b c
 
-concatEitherL :: [Either x a] -> Either [x] [a]
-concatEitherL as = case partitionEithers as of
-  ([], bs) -> Right bs
-  (es, _) -> Left es
+-- concatEitherL :: [Either x a] -> Either [x] [a]
+-- concatEitherL as = case partitionEithers as of
+--   ([], bs) -> Right bs
+--   (es, _) -> Left es
 
-concatEithersL :: [Either [x] a] -> Either [x] [a]
-concatEithersL = merge . concatEitherL
+-- concatEithersL :: [Either [x] a] -> Either [x] [a]
+-- concatEithersL = merge . concatEitherL
 
-leftToMaybe :: Either a b -> Maybe a
-leftToMaybe (Left a) = Just a
-leftToMaybe _ = Nothing
+-- leftToMaybe :: Either a b -> Maybe a
+-- leftToMaybe (Left a) = Just a
+-- leftToMaybe _ = Nothing
 
 unlessLeft :: (Monad m, MonadPlus n) => Either a b -> (b -> m (n a)) -> m (n a)
 unlessLeft (Left es) _ = return (return es)
@@ -598,11 +690,11 @@ unlessLeft_ e f = unlessLeft e (\x -> void (f x) >> return mzero)
 unlessLefts_ :: (Monad m, MonadPlus n) => Either (n a) b -> (b -> m ()) -> m (n a)
 unlessLefts_ e f = unlessLefts e (\x -> void (f x) >> return mzero)
 
-plural :: Either a b -> Either [a] b
-plural = first (: [])
+-- plural :: Either a b -> Either [a] b
+-- plural = first (: [])
 
-merge :: Either [[a]] b -> Either [a] b
-merge = first concat
+-- merge :: Either [[a]] b -> Either [a] b
+-- merge = first concat
 
 --------------------------------------------------------------------------------
 -- random functions
@@ -646,23 +738,23 @@ thdOf3 (_, _, c) = c
 --     -- these options barely do anything in terms of performance
 --     compres = compile (blankCompOpt {newSyntax = True}) (blankExecOpt {captureGroups = False}) pat
 
-compileOptions :: TxOpts T.Text -> EitherErr TxOptsRe
+compileOptions :: TxOpts T.Text -> InsertExcept TxOptsRe
 compileOptions o@TxOpts {toAmountFmt = pat} = do
   re <- compileRegex True pat
   return $ o {toAmountFmt = re}
 
-compileMatch :: StatementParser T.Text -> EitherErrs MatchRe
+compileMatch :: StatementParser T.Text -> InsertExcept MatchRe
 compileMatch m@StatementParser {spDesc, spOther} = do
-  let dres = plural $ mapM go spDesc
-  let ores = concatEitherL $ fmap (mapM go) spOther
-  concatEithers2 dres ores $ \d_ os_ -> m {spDesc = d_, spOther = os_}
+  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
   where
     go = compileRegex False
+    dres = mapM go spDesc
+    ores = combineErrors $ fmap (mapM go) spOther
 
-compileRegex :: Bool -> T.Text -> EitherErr (Text, Regex)
+compileRegex :: Bool -> T.Text -> InsertExcept (Text, Regex)
 compileRegex groups pat = case res of
-  Right re -> Right (pat, re)
-  Left _ -> Left $ RegexError pat
+  Right re -> return (pat, re)
+  Left _ -> throwError $ InsertException [RegexError pat]
   where
     res =
       compile
@@ -670,10 +762,10 @@ compileRegex groups pat = case res of
         (blankExecOpt {captureGroups = groups})
         pat
 
-matchMaybe :: T.Text -> Regex -> EitherErrs Bool
+matchMaybe :: T.Text -> Regex -> InsertExcept Bool
 matchMaybe q re = case execute re q of
-  Right res -> Right $ isJust res
-  Left _ -> Left [RegexError "this should not happen"]
+  Right res -> return $ isJust res
+  Left _ -> throwError $ InsertException [RegexError "this should not happen"]
 
 matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
 matchGroupsMaybe q re = case regexec re q of
diff --git a/package.yaml b/package.yaml
index 5c09970..93b2fc3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -86,6 +86,7 @@ dependencies:
 - data-fix
 - filepath
 - mtl
+- persistent-mtl >= 0.3.0.0
 
 library:
   source-dirs: lib/
diff --git a/stack.yaml b/stack.yaml
index 120e4e4..9ed44a6 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -46,6 +46,7 @@ extra-deps:
   commit: ffd1ba94ef39b875aba8adc1c498f28aa02e36e4
   subdirs: [dhall]
 - hashable-1.3.5.0
+- persistent-mtl-0.3.0.0
 #
 # extra-deps: []