9 changed files with 519 additions and 906 deletions
--- a/app/Main.hs
+++ b/app/Main.hs
@ -4,13 +4,18 @@ module Main (main) where

 import Control.Concurrent
 import Control.Monad.Except
+import Control.Monad.IO.Rerunnable
 import Control.Monad.Logger
+import Control.Monad.Reader
 import Data.Bitraversable
 -- import Data.Hashable
 import qualified Data.Text.IO as TI
 import qualified Database.Esqueleto.Experimental as E
+import Database.Persist.Monad
 import qualified Dhall hiding (double, record)
+import Internal.Budget
 import Internal.Database
+import Internal.History
 import Internal.Types.Main
 import Internal.Utils
 import Options.Applicative
@ -67,7 +72,7 @@ options =
    <|> getConf dumpCurrencies
    <|> getConf dumpAccounts
    <|> getConf dumpAccountKeys
-    <|> getConf sync_
+    <|> getConf sync
  where
    getConf m = Options <$> configFile <*> m

@ -108,8 +113,8 @@ dumpAccountKeys =
        <> help "Dump all account keys/aliases"
    )

-sync_ :: Parser Mode
-sync_ =
+sync :: Parser Mode
+sync =
  flag'
    Sync
    ( long "sync"
@ -204,14 +209,50 @@ runDumpAccountKeys c = do
 runSync :: Int -> FilePath -> [FilePath] -> [FilePath] -> IO ()
 runSync threads c bs hs = do
  setNumCapabilities threads
+  -- putStrLn "reading config"
  config <- readConfig c
+  -- putStrLn "reading statements"
  (bs', hs') <-
    fmap (bimap concat concat . partitionEithers) $
      pooledMapConcurrentlyN threads (bimapM readDhall readDhall) $
        (Left <$> bs) ++ (Right <$> hs)
  pool <- runNoLoggingT $ mkPool $ sqlConfig config
+  putStrLn "doing other stuff"
  setNumCapabilities 1
-  handle err $ sync pool root config bs' hs'
+  handle err $ do
+    -- _ <- askLoggerIO
+
+    -- Get the current DB state.
+    state <- runSqlQueryT pool $ do
+      runMigration migrateAll
+      liftIOExceptT $ readConfigState config bs' hs'
+
+    -- Read raw transactions according to state. If a transaction is already in
+    -- the database, don't read it but record the commit so we can update it.
+    toIns <-
+      flip runReaderT state $ do
+        (CRUDOps hSs _ _ _) <- asks csHistStmts
+        hSs' <- mapErrorsIO (readHistStmt root) hSs
+        (CRUDOps hTs _ _ _) <- asks csHistTrans
+        hTs' <- liftIOExceptT $ mapErrors readHistTransfer hTs
+        (CRUDOps bTs _ _ _) <- asks csBudgets
+        bTs' <- liftIOExceptT $ mapErrors readBudget bTs
+        return $ concat $ hSs' ++ hTs' ++ bTs'
+
+    -- Update the DB.
+    runSqlQueryT pool $ withTransaction $ flip runReaderT state $ do
+      -- NOTE this must come first (unless we defer foreign keys)
+      updateDBState
+      res <- runExceptT $ do
+        (CRUDOps _ bRs bUs _) <- asks csBudgets
+        (CRUDOps _ tRs tUs _) <- asks csHistTrans
+        (CRUDOps _ sRs sUs _) <- asks csHistStmts
+        let ebs = fmap ToUpdate (bUs ++ tUs ++ sUs) ++ fmap ToRead (bRs ++ tRs ++ sRs) ++ fmap ToInsert toIns
+        insertAll ebs
+      -- NOTE this rerunnable thing is a bit misleading; fromEither will throw
+      -- whatever error is encountered above in an IO context, but the first
+      -- thrown error should be caught despite possibly needing to be rerun
+      rerunnableIO $ fromEither res
  where
    root = takeDirectory c
    err (AppException es) = do
--- a/dhall/Types.dhall
+++ b/dhall/Types.dhall
@ -278,52 +278,10 @@ let DatePat =
    -}
      < Cron : CronPat.Type | Mod : ModPat.Type >

-let TxAmount1_ =
-      \(re : Type) ->
-        { a1Column : Text
-        , a1Fmt :
-            {-
-            Format of the amount field. Must include three fields for the
-            sign, numerator, and denominator of the amount.
-            -}
-            re
-        }
-
-let TxAmount1 =
-      { Type = TxAmount1_ Text
-      , default = { a1Column = "Amount", a1Fmt = "([-+])?([0-9\\.]+)" }
-      }
-
-let TxAmount2_ =
-      \(re : Type) ->
-        { a2Positive : Text
-        , a2Negative : Text
-        , a2Fmt :
-            {-
-            Format of the amount field. Must include two fields for the
-            numerator and denominator of the amount.
-            -}
-            re
-        }
-
-let TxAmount2 =
-      { Type = TxAmount2_ Text
-      , default =
-        { a2Positive = "Deposit"
-        , a2Negative = "Withdraw"
-        , a2Fmt = "([0-9\\.]+)"
-        }
-      }
-
-let TxAmountSpec_ =
-      \(re : Type) ->
-        < AmountSingle : TxAmount1_ re | AmountDual : TxAmount2_ re >
-
 let TxOpts_ =
-    {-
-    Additional metadata to use when parsing a statement
-    -}
+    {- Additional metadata to use when parsing a statement -}
      \(re : Type) ->
+        { Type =
            { toDate :
                {-
                Column title for date
@ -333,7 +291,7 @@ let TxOpts_ =
                {-
                Column title for amount
                -}
-            TxAmountSpec_ re
+                Text
            , toDesc :
                {-
                Column title for description
@ -351,54 +309,24 @@ let TxOpts_ =
                Data.Time.Format.formattime Haskell function.
                -}
                Text
-        , toSkipBlankDate :
-            {-
-            Skip line if date field is a blank
+            , toAmountFmt :
+                {- Format of the amount field. Must include three fields for the
+                sign, numerator, and denominator of the amount.
                -}
-            Bool
-        , toSkipBlankAmount :
-            {-
-            Skip line if amount field(s) is(are) a blank
-            -}
-            Bool
-        , toSkipBlankDescription :
-            {-
-            Skip line if description field is a blank
-            -}
-            Bool
-        , toSkipBlankOther :
-            {-
-            Skip line if any arbitrary fields are blank (these fields must also
-            be listed in 'toOther' to be considered)
-            -}
-            List Text
-        , toSkipMissingFields :
-            {-
-            Skip line if any fields are missing (this is different from blank;
-            'missing' means there is no field with name 'X', 'blank' means that
-            there is a field 'X' and its value is an empty string)
-            -}
-            Bool
+                re
            }
-
-let TxAmountSpec = TxAmountSpec_ Text
-
-let TxOpts =
-      { Type = TxOpts_ Text
        , default =
          { toDate = "Date"
-        , toAmount = TxAmountSpec.AmountSingle TxAmount1::{=}
+          , toAmount = "Amount"
          , toDesc = "Description"
          , toOther = [] : List Text
          , toDateFmt = "%0m/%0d/%Y"
-        , toSkipBlankDate = False
-        , toSkipBlankAmount = False
-        , toSkipBlankDescription = False
-        , toSkipBlankOther = [] : List Text
-        , toSkipMissingFields = False
+          , toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
          }
        }

+let TxOpts = TxOpts_ Text
+
 let Field =
    {-
    General key-value type
@ -1056,23 +984,40 @@ let Income =
        }
      }

-let AcntMatcher_ =
+let AcntSet =
    {-
-    Regex pattern by which matching account ids will be identified
+    A list of account IDs represented as a set.
    -}
-      \(re : Type) ->
-        { Type = { amPat : re, amInvert : Bool }, default.amInvert = False }
+      { Type =
+          { asList : List AcntID
+          , asInclude :
+              {-
+              If true, tests for account membership in this set will return
+              true if the account is in the set. Invert this behavior otherwise.
+              -}
+              Bool
+          }
+      , default = { asList = [] : List AcntID, asInclude = False }
+      }

-let AcntMatcher = AcntMatcher_ Text
-
-let TransferMatcher_ =
+let TransferMatcher =
    {-
    Means to match a transfer (which will be used to "clone" it in some
    fashion)
    -}
-      \(re : Type) ->
-        { tmFrom : Optional (AcntMatcher_ re).Type
-        , tmTo : Optional (AcntMatcher_ re).Type
+      { Type =
+          { tmFrom :
+              {-
+              List of accounts (which may be empty) to match with the
+              starting account in a transfer.
+              -}
+              AcntSet.Type
+          , tmTo :
+              {-
+              List of accounts (which may be empty) to match with the
+              ending account in a transfer.
+              -}
+              AcntSet.Type
          , tmDate :
              {-
              If given, means to match the date of a transfer.
@ -1084,12 +1029,9 @@ let TransferMatcher_ =
              -}
              ValMatcher.Type
          }
-
-let TransferMatcher =
-      { Type = TransferMatcher_ Text
      , default =
-        { tmFrom = None AcntMatcher.Type
-        , tmTo = None AcntMatcher.Type
+        { tmFrom = AcntSet.default
+        , tmTo = AcntSet.default
        , tmDate = None DateMatcher
        , tmVal = ValMatcher.default
        }
@ -1127,6 +1069,7 @@ let ShadowTransfer =
          specified in other fields of this type.
          -}
          TransferMatcher.Type
+      , stType : TransferType
      , stRatio :
          {-
          Fixed multipler to translate value of matched transfer to this one.
@ -1206,9 +1149,9 @@ in  { CurID
    , Budget
    , Allocation
    , Amount
-    , TransferMatcher_
    , TransferMatcher
    , ShadowTransfer
+    , AcntSet
    , TaggedAcnt
    , AccountTree
    , Account
@ -1235,13 +1178,4 @@ in  { CurID
    , TransferAmount
    , MultiAlloAmount
    , SingleAlloAmount
-    , AcntMatcher_
-    , AcntMatcher
-    , TxAmountSpec
-    , TxAmountSpec_
-    , TxAmount1_
-    , TxAmount2_
-    , TxAmount1
-    , TxAmount2
-    , BudgetTransfer
    }
--- a/lib/Internal/Budget.hs
+++ b/lib/Internal/Budget.hs
@ -1,4 +1,4 @@
-module Internal.Budget (readBudgetCRUD) where
+module Internal.Budget (readBudget) where

 import Control.Monad.Except
 import Data.Decimal hiding (allocate)
@ -13,12 +13,7 @@ import qualified RIO.NonEmpty as NE
 import qualified RIO.Text as T
 import RIO.Time

-readBudgetCRUD :: (MonadAppError m, MonadFinance m) => PreBudgetCRUD -> m FinalBudgetCRUD
-readBudgetCRUD o@CRUDOps {coCreate} = do
-  bs <- mapM readBudget coCreate
-  return $ o {coCreate = bs}
-
-readBudget :: (MonadAppError m, MonadFinance m) => Budget -> m (BudgetName, [Tx CommitR])
+readBudget :: (MonadAppError m, MonadFinance m) => Budget -> m [Tx CommitR]
 readBudget
  b@Budget
    { bgtLabel
@ -32,14 +27,15 @@ readBudget
    } =
    do
      spanRes <- getSpan
-      (bgtLabel,) <$> case spanRes of
+      case spanRes of
        Nothing -> return []
        Just budgetSpan -> do
          (intAllos, _) <- combineError intAlloRes acntRes (,)
-          let res1 = mapErrors (readIncome c intAllos budgetSpan) bgtIncomes
-          let res2 = expandTransfers c budgetSpan bgtTransfers
-          combineErrorM (concat <$> res1) res2 $ \is ts ->
-            addShadowTransfers bgtShadowTransfers (is ++ ts)
+          let res1 = mapErrors (readIncome c bgtLabel intAllos budgetSpan) bgtIncomes
+          let res2 = expandTransfers c bgtLabel budgetSpan bgtTransfers
+          txs <- combineError (concat <$> res1) res2 (++)
+          shadow <- addShadowTransfers bgtShadowTransfers txs
+          return $ txs ++ shadow
    where
      c = CommitR (CommitHash $ hash b) CTBudget
      acntRes = mapErrors isNotIncomeAcnt alloAcnts
@ -53,7 +49,7 @@ readBudget
          ++ (alloAcnt <$> bgtTax)
          ++ (alloAcnt <$> bgtPosttax)
      getSpan = do
-        globalSpan <- asks (unBSpan . tsBudgetScope)
+        globalSpan <- asks (unBSpan . csBudgetScope)
        case bgtInterval of
          Nothing -> return $ Just globalSpan
          Just bi -> do
@ -82,12 +78,14 @@ sortAllo a@Allocation {alloAmts = as} = do
 readIncome
  :: (MonadAppError m, MonadFinance m)
  => CommitR
+  -> BudgetName
  -> IntAllocations
  -> DaySpan
  -> Income
  -> m [Tx CommitR]
 readIncome
  key
+  name
  (intPre, intTax, intPost)
  ds
  Income
@ -145,16 +143,20 @@ readIncome
        let allos = allo2Trans <$> (pre ++ tax ++ post)
        let primary =
              EntrySet
-                { esTotalValue = -gross
+                { esTotalValue = gross
                , esCurrency = cpID cp
                , esFrom = HalfEntrySet {hesPrimary = src, hesOther = []}
                , esTo = HalfEntrySet {hesPrimary = dest, hesOther = allos}
                }
        return $
          Tx
-            { txMeta = TxMeta day incPriority (TxDesc "") key
+            { txCommit = key
+            , txDate = day
            , txPrimary = Left primary
            , txOther = []
+            , txDescr = TxDesc ""
+            , txBudget = name
+            , txPriority = incPriority
            }

 periodScaler
@ -345,32 +347,24 @@ fromShadow
  -> ShadowTransfer
  -> m (Maybe ShadowEntrySet)
 fromShadow tx ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stMatch} =
-  combineErrorM curRes mRes $ \cur compiled -> do
-    res <- liftExcept $ shadowMatches compiled tx
+  combineErrorM curRes shaRes $ \cur sha -> do
    let es = entryPair stFrom stTo cur stDesc stRatio ()
-    return $ if not res then Nothing else Just es
+    return $ if not sha then Nothing else Just es
  where
-    curRes = lookupCurrencyKey stCurrency
-    mRes = liftExcept $ compileMatch stMatch
+    curRes = lookupCurrencyKey (CurID stCurrency)
+    shaRes = liftExcept $ shadowMatches stMatch tx

-shadowMatches :: TransferMatcherRe -> Tx CommitR -> AppExcept Bool
-shadowMatches
-  TransferMatcher_ {tmFrom, tmTo, tmDate, tmVal}
-  Tx {txPrimary, txMeta = TxMeta {txmDate}} =
-    do
-      -- ASSUME these will never fail and thus I don't need to worry about
-      -- stacking the errors
-      fromRes <- acntMatches fa tmFrom
-      toRes <- acntMatches ta tmTo
+shadowMatches :: TransferMatcher -> Tx CommitR -> AppExcept Bool
+shadowMatches TransferMatcher {tmFrom, tmTo, tmDate, tmVal} Tx {txPrimary, txDate} = do
  -- NOTE this will only match against the primary entry set since those
  -- are what are guaranteed to exist from a transfer
  valRes <- case txPrimary of
    Left es -> valMatches tmVal $ toRational $ esTotalValue es
    Right _ -> return True
  return $
-        fromRes
-          && toRes
-          && maybe True (`dateMatches` txmDate) tmDate
+    memberMaybe fa tmFrom
+      && memberMaybe ta tmTo
+      && maybe True (`dateMatches` txDate) tmDate
      && valRes
  where
    fa = either getAcntFrom getAcntFrom txPrimary
@ -378,22 +372,8 @@ shadowMatches
    getAcntFrom = getAcnt esFrom
    getAcntTo = getAcnt esTo
    getAcnt f = eAcnt . hesPrimary . f
-      acntMatches (AcntID a) = maybe (return True) (match' a)
-      match' a AcntMatcher_ {amPat, amInvert} =
-        (if amInvert then not else id) <$> matchMaybe a amPat
-
-compileMatch :: TransferMatcher_ T.Text -> AppExcept TransferMatcherRe
-compileMatch m@TransferMatcher_ {tmTo, tmFrom} =
-  combineError tres fres $ \t f -> m {tmTo = t, tmFrom = f}
-  where
-    go a@AcntMatcher_ {amPat} = do
-      (_, p) <- compileRegex False amPat
-      return $ a {amPat = p}
-    tres = mapM go tmTo
-    fres = mapM go tmFrom
-
-- memberMaybe x AcntSet {asList, asInclude} =
--   (if asInclude then id else not) $ x `elem` (AcntID <$> asList)
+    memberMaybe x AcntSet {asList, asInclude} =
+      (if asInclude then id else not) $ x `elem` (AcntID <$> asList)

 --------------------------------------------------------------------------------
 -- random
--- a/lib/Internal/Database.hs
+++ b/lib/Internal/Database.hs
@ -1,9 +1,8 @@
 module Internal.Database
  ( runDB
-  , readDB
+  , readConfigState
  , nukeTables
-  , updateMeta
-  -- , updateDBState
+  , updateDBState
  , tree2Records
  , flattenAcntRoot
  , indexAcntRoot
@ -11,18 +10,16 @@ module Internal.Database
  , mkPool
  , insertEntry
  , readUpdates
+  , insertAll
  , updateTx
-  , sync
  )
 where

 import Conduit
 import Control.Monad.Except
-import Control.Monad.IO.Rerunnable
 import Control.Monad.Logger
 import Data.Decimal
 import Data.Hashable
-import qualified Data.Text.IO as TI
 import Database.Esqueleto.Experimental ((:&) (..), (==.), (?.), (^.))
 import qualified Database.Esqueleto.Experimental as E
 import Database.Esqueleto.Internal.Internal (SqlSelect)
@ -39,84 +36,16 @@ import Database.Persist.Sqlite hiding
  , (==.)
  , (||.)
  )
-import Internal.Budget
-import Internal.History
+import GHC.Err
 import Internal.Types.Main
 import Internal.Utils
-import RIO hiding (LogFunc, isNothing, logDebug, on, (^.))
+import RIO hiding (LogFunc, isNothing, on, (^.))
 import qualified RIO.List as L
 import qualified RIO.Map as M
 import qualified RIO.NonEmpty as NE
 import qualified RIO.Set as S
 import qualified RIO.Text as T

-sync
-  :: (MonadUnliftIO m, MonadRerunnableIO m)
-  => ConnectionPool
-  -> FilePath
-  -> Config
-  -> [Budget]
-  -> [History]
-  -> m ()
-sync pool root c bs hs = do
-  -- _ <- askLoggerIO
-
-  (meta, txState, budgets, history) <- runSqlQueryT pool $ do
-    runMigration migrateAll
-    liftIOExceptT $ readDB c bs hs
-
-  -- Read raw transactions according to state. If a transaction is already in
-  -- the database, don't read it but record the commit so we can update it.
-  (budgets', history') <-
-    flip runReaderT txState $ do
-      -- TODO collect errors here
-      b <- liftIOExceptT $ readBudgetCRUD budgets
-      h <- readHistoryCRUD root history
-      return (b, h)
-  liftIO $ TI.putStr $ formatBuildPlan history budgets
-
-  -- Update the DB.
-  runSqlQueryT pool $ withTransaction $ flip runReaderT txState $ do
-    -- NOTE this must come first (unless we defer foreign keys)
-    updateMeta meta
-    res <- runExceptT $ do
-      -- TODO multithread this :)
-      insertBudgets budgets'
-      insertHistory history'
-    -- NOTE this rerunnable thing is a bit misleading; fromEither will throw
-    -- whatever error is encountered above in an IO context, but the first
-    -- thrown error should be caught despite possibly needing to be rerun
-    rerunnableIO $ fromEither res
-
-formatBuildPlan :: PreHistoryCRUD -> PreBudgetCRUD -> T.Text
-formatBuildPlan
-  CRUDOps {coCreate = hc, coRead = hr, coUpdate = hu, coDelete = hd}
-  CRUDOps {coCreate = bc, coDelete = bd} =
-    T.unlines $ "Build plan:" : (T.append "  " <$> ht ++ [""] ++ bt)
-    where
-      ht =
-        [ T.append "History transfers to create: " $ tshow hCt
-        , T.append "History statements to create: " $ tshow hCs
-        , T.append "History entries to read: " $ tshow $ length hr
-        , T.append "History entry sets to update: " $ tshow $ length hu
-        ]
-          ++ formatDel "History" hd
-      bt =
-        T.append "Budgets to create: " (tshow $ bgtLabel <$> bc)
-          : formatDel "Budget" bd
-      toDel what thing n = T.unwords [what, thing, "to delete:", tshow n]
-      formatDel what (DeleteTxs e a b c' d) =
-        [ f "commits" e
-        , f "transactions" a
-        , f "entry sets" b
-        , f "entries" c'
-        , f "tag relations" d
-        ]
-        where
-          f :: T.Text -> [a] -> T.Text
-          f thing = toDel what thing . length
-      (hCt, hCs) = bimap length length hc
-
 runDB
  :: MonadUnliftIO m
  => SqlConfig
@ -177,116 +106,58 @@ nukeTables = do
 --     toFullPath path name = T.unwords [unValue @T.Text path, "/", unValue @T.Text name]
 --     toBal = maybe "???" (fmtRational 2) . unValue

-readDB
+readConfigState
  :: (MonadAppError m, MonadSqlQuery m)
  => Config
  -> [Budget]
  -> [History]
-  -> m (MetaCRUD, TxState, PreBudgetCRUD, PreHistoryCRUD)
-readDB c bs hs = do
-  curAcnts <- readCurrentIds
-  curPaths <- readCurrentIds
-  curCurs <- readCurrentIds
-  curTags <- readCurrentIds
+  -> m ConfigState
+readConfigState c bs hs = do
+  (acnts2Ins, acntsRem, acnts2Del) <- diff newAcnts
+  (pathsIns, _, pathsDel) <- diff newPaths
+  (curs2Ins, cursRem, curs2Del) <- diff newCurs
+  (tags2Ins, tagsRem, tags2Del) <- diff newTags
+  let amap = makeAcntMap $ acnts2Ins ++ (fst <$> acntsRem)
+  let cmap = currencyMap $ curs2Ins ++ (fst <$> cursRem)
+  let tmap = makeTagMap $ tags2Ins ++ (fst <$> tagsRem)
+  let fromMap f = S.fromList . fmap f . M.elems
+  let existing =
+        ExistingConfig (fromMap fst amap) (fromMap id tmap) (fromMap cpID cmap)
+
  (curBgts, curHistTrs, curHistSts) <- readCurrentCommits
+  -- TODO refine this test to include the whole db (with data already mixed
+  -- in this algorithm)
  let bsRes = BudgetSpan <$> resolveScope budgetInterval
  let hsRes = HistorySpan <$> resolveScope statementInterval
  combineErrorM bsRes hsRes $ \bscope hscope -> do
-    -- ASSUME the db must be empty if these are empty
-    let dbempty = null curAcnts && null curCurs && null curTags
-    let meta =
-          MetaCRUD
-            { mcCurrencies = makeCD newCurs curCurs
-            , mcTags = makeCD newTags curTags
-            , mcAccounts = makeCD newAcnts curAcnts
-            , mcPaths = makeCD newPaths curPaths
-            , mcBudgetScope = bscope
-            , mcHistoryScope = hscope
-            }
-    let txS =
-          TxState
-            { tsAccountMap = amap
-            , tsCurrencyMap = cmap
-            , tsTagMap = tmap
-            , tsBudgetScope = bscope
-            , tsHistoryScope = hscope
-            }
+    let dbempty = null $ curBgts ++ curHistTrs ++ curHistSts
    (bChanged, hChanged) <- readScopeChanged dbempty bscope hscope
-    budgets <- makeBudgetCRUD existing bs curBgts bChanged
-    history <- makeStatementCRUD existing (ts, curHistTrs) (ss, curHistSts) hChanged
-    return (meta, txS, budgets, history)
+    bgt <- makeTxCRUD existing bs curBgts bChanged
+    hTrans <- makeTxCRUD existing ts curHistTrs hChanged
+    hStmt <- makeTxCRUD existing ss curHistSts hChanged
+
+    return $
+      ConfigState
+        { csCurrencies = CRUDOps curs2Ins () () curs2Del
+        , csTags = CRUDOps tags2Ins () () tags2Del
+        , csAccounts = CRUDOps acnts2Ins () () acnts2Del
+        , csPaths = CRUDOps pathsIns () () pathsDel
+        , csBudgets = bgt
+        , csHistTrans = hTrans
+        , csHistStmts = hStmt
+        , csAccountMap = amap
+        , csCurrencyMap = cmap
+        , csTagMap = tmap
+        , csBudgetScope = bscope
+        , csHistoryScope = hscope
+        }
  where
    (ts, ss) = splitHistory hs
-    makeCD new old =
-      let (cs, _, ds) = setDiffWith (\a b -> E.entityKey a == b) new old
-       in CRUDOps cs () () ds
+    diff new = setDiffWith (\a b -> E.entityKey a == b) new <$> readCurrentIds
    (newAcnts, newPaths) = indexAcntRoot $ accounts c
    newTags = tag2Record <$> tags c
    newCurs = currency2Record <$> currencies c
    resolveScope f = liftExcept $ resolveDaySpan $ f $ scope c
-    amap = makeAcntMap newAcnts
-    cmap = currencyMap newCurs
-    tmap = makeTagMap newTags
-    fromMap f = S.fromList . fmap f . M.elems
-    existing = ExistingConfig (fromMap fst amap) (fromMap id tmap) (fromMap cpID cmap)
-
-makeBudgetCRUD
-  :: MonadSqlQuery m
-  => ExistingConfig
-  -> [Budget]
-  -> [CommitHash]
-  -> Bool
-  -> m (CRUDOps [Budget] () () DeleteTxs)
-makeBudgetCRUD existing new old scopeChanged = do
-  (toIns, toDel) <-
-    if scopeChanged
-      then (new,) <$> readTxIds old
-      else do
-        let (toDelHashes, overlap, toIns) = setDiffHashes old new
-        toDel <- readTxIds toDelHashes
-        (toInsRetry, _) <- readInvalidIds existing overlap
-        return (toIns ++ (snd <$> toInsRetry), toDel)
-  return $ CRUDOps toIns () () toDel
-
-makeStatementCRUD
-  :: (MonadAppError m, MonadSqlQuery m)
-  => ExistingConfig
-  -> ([PairedTransfer], [CommitHash])
-  -> ([Statement], [CommitHash])
-  -> Bool
-  -> m
-      ( CRUDOps
-          ([PairedTransfer], [Statement])
-          [ReadEntry]
-          [Either TotalUpdateEntrySet FullUpdateEntrySet]
-          DeleteTxs
-      )
-makeStatementCRUD existing ts ss scopeChanged = do
-  (toInsTs, toDelTs, validTs) <- uncurry diff ts
-  (toInsSs, toDelSs, validSs) <- uncurry diff ss
-  let toDelAllHashes = toDelTs ++ toDelSs
-  -- If we are inserting or deleting something or the scope changed, pull out
-  -- the remainder of the entries to update/read as we are (re)inserting other
-  -- stuff (this is necessary because a given transaction may depend on the
-  -- value of previous transactions, even if they are already in the DB).
-  (toRead, toUpdate) <- case (toInsTs, toInsSs, toDelAllHashes, scopeChanged) of
-    ([], [], [], False) -> return ([], [])
-    _ -> readUpdates $ validTs ++ validSs
-  toDelAll <- readTxIds toDelAllHashes
-  return $ CRUDOps (toInsTs, toInsSs) toRead toUpdate toDelAll
-  where
-    diff :: (MonadSqlQuery m, Hashable a) => [a] -> [CommitHash] -> m ([a], [CommitHash], [CommitHash])
-    diff new old = do
-      let (toDelHashes, overlap, toIns) = setDiffHashes old new
-      -- Check the overlap for rows with accounts/tags/currencies that
-      -- won't exist on the next update. Those with invalid IDs will be set aside
-      -- to delete and reinsert (which may also fail) later
-      (invalid, valid) <- readInvalidIds existing overlap
-      let (toDelAllHashes, toInsAll) = bimap (toDelHashes ++) (toIns ++) $ L.unzip invalid
-      return (toInsAll, toDelAllHashes, valid)
-
-setDiffHashes :: Hashable a => [CommitHash] -> [a] -> ([CommitHash], [(CommitHash, a)], [a])
-setDiffHashes = setDiffWith (\a b -> CommitHash (hash b) == a)

 readScopeChanged
  :: (MonadAppError m, MonadSqlQuery m)
@ -304,6 +175,37 @@ readScopeChanged dbempty bscope hscope = do
      return (bscope /= b, hscope /= h)
    _ -> throwAppError $ DBError DBMultiScope

+makeTxCRUD
+  :: (MonadAppError m, MonadSqlQuery m, Hashable a)
+  => ExistingConfig
+  -> [a]
+  -> [CommitHash]
+  -> Bool
+  -> m
+      ( CRUDOps
+          [a]
+          [ReadEntry]
+          [Either TotalUpdateEntrySet FullUpdateEntrySet]
+          DeleteTxs
+      )
+makeTxCRUD existing newThings curThings scopeChanged = do
+  let (toDelHashes, overlap, toIns) =
+        setDiffWith (\a b -> hash b == unCommitHash a) curThings newThings
+  -- Check the overlap for rows with accounts/tags/currencies that
+  -- won't exist on the next update. Those with invalid IDs will be set aside
+  -- to delete and reinsert (which may also fail) later
+  (noRetry, toInsRetry) <- readInvalidIds existing overlap
+  let (toDelAllHashes, toInsAll) = bimap (toDelHashes ++) (toIns ++) $ L.unzip toInsRetry
+  -- If we are inserting or deleting something or the scope changed, pull out
+  -- the remainder of the entries to update/read as we are (re)inserting other
+  -- stuff (this is necessary because a given transaction may depend on the
+  -- value of previous transactions, even if they are already in the DB).
+  (toRead, toUpdate) <- case (toInsAll, toDelAllHashes, scopeChanged) of
+    ([], [], False) -> return ([], [])
+    _ -> readUpdates noRetry
+  toDelAll <- readTxIds toDelAllHashes
+  return $ CRUDOps toInsAll toRead toUpdate toDelAll
+
 readTxIds :: MonadSqlQuery m => [CommitHash] -> m DeleteTxs
 readTxIds cs = do
  xs <- selectE $ do
@ -316,29 +218,33 @@ readTxIds cs = do
        `E.on` (\(_ :& t :& es) -> t ^. TransactionRId ==. es ^. EntrySetRTransaction)
          `E.innerJoin` E.table
        `E.on` (\(_ :& _ :& es :& e) -> es ^. EntrySetRId ==. e ^. EntryREntryset)
-          `E.leftJoin` E.table
-        `E.on` (\(_ :& _ :& _ :& e :& t) -> E.just (e ^. EntryRId) ==. t ?. TagRelationREntry)
+          `E.innerJoin` E.table
+        `E.on` (\(_ :& _ :& _ :& e :& t) -> e ^. EntryRId ==. t ^. TagRelationREntry)
    E.where_ $ commits ^. CommitRHash `E.in_` E.valList cs
    return
-      ( commits ^. CommitRId
-      , txs ^. TransactionRId
+      ( txs ^. TransactionRId
      , ess ^. EntrySetRId
      , es ^. EntryRId
-      , ts ?. TagRelationRId
+      , ts ^. TagRelationRId
      )
-  let (cms, txs, ss, es, ts) = L.unzip5 xs
+  let (txs, ss, es, ts) = L.unzip4 xs
  return $
    DeleteTxs
-      { dtCommits = go cms
-      , dtTxs = go txs
+      { dtTxs = go txs
      , dtEntrySets = go ss
      , dtEntries = go es
-      , dtTagRelations = catMaybes $ E.unValue <$> ts
+      , dtTagRelations = E.unValue <$> ts
      }
  where
    go :: Eq a => [E.Value a] -> [a]
    go = fmap (E.unValue . NE.head) . NE.group

+splitHistory :: [History] -> ([PairedTransfer], [Statement])
+splitHistory = partitionEithers . fmap go
+  where
+    go (HistTransfer x) = Left x
+    go (HistStatement x) = Right x
+
 makeTagMap :: [Entity TagR] -> TagMap
 makeTagMap = M.fromList . fmap (\e -> (tagRSymbol $ entityVal e, entityKey e))

@ -349,7 +255,7 @@ currency2Record :: Currency -> Entity CurrencyR
 currency2Record c@Currency {curSymbol, curFullname, curPrecision} =
  Entity (toKey c) $ CurrencyR (CurID curSymbol) curFullname (fromIntegral curPrecision)

-readCurrentIds :: (PersistEntity a, MonadSqlQuery m) => m [Key a]
+readCurrentIds :: PersistEntity a => MonadSqlQuery m => m [Key a]
 readCurrentIds = fmap (E.unValue <$>) $ selectE $ do
  rs <- E.from E.table
  return (rs ^. E.persistIdField)
@ -357,8 +263,8 @@ readCurrentIds = fmap (E.unValue <$>) $ selectE $ do
 readCurrentCommits :: MonadSqlQuery m => m ([CommitHash], [CommitHash], [CommitHash])
 readCurrentCommits = do
  xs <- selectE $ do
-    commits <- E.from E.table
-    return (commits ^. CommitRHash, commits ^. CommitRType)
+    rs <- E.from E.table
+    return (rs ^. CommitRHash, rs ^. CommitRType)
  return $ foldr go ([], [], []) xs
  where
    go (x, t) (bs, ts, hs) =
@ -481,55 +387,39 @@ indexAcntRoot = bimap concat concat . L.unzip . fmap (uncurry tree2Records) . fl
 updateCD
  :: ( MonadSqlQuery m
     , PersistRecordBackend a SqlBackend
+     , PersistRecordBackend b SqlBackend
     )
-  => EntityCRUDOps a
+  => CDOps (Entity a) (Key b)
  -> m ()
 updateCD (CRUDOps cs () () ds) = do
  mapM_ deleteKeyE ds
  insertEntityManyE cs

-- TODO defer foreign keys so I don't need to confusingly reverse this stuff
 deleteTxs :: MonadSqlQuery m => DeleteTxs -> m ()
-deleteTxs DeleteTxs {dtTxs, dtEntrySets, dtEntries, dtTagRelations, dtCommits} = do
-  mapM_ deleteKeyE dtTagRelations
-  mapM_ deleteKeyE dtEntries
-  mapM_ deleteKeyE dtEntrySets
+deleteTxs DeleteTxs {dtTxs, dtEntrySets, dtEntries, dtTagRelations} = do
  mapM_ deleteKeyE dtTxs
-  mapM_ deleteKeyE dtCommits
+  mapM_ deleteKeyE dtEntrySets
+  mapM_ deleteKeyE dtEntries
+  mapM_ deleteKeyE dtTagRelations

-- updateDBState :: (MonadFinance m, MonadSqlQuery m) => m ()
-- updateDBState = do
--   updateCD =<< asks csCurrencies
--   updateCD =<< asks csAccounts
--   updateCD =<< asks csPaths
--   updateCD =<< asks csTags
--   -- deleteTxs =<< asks (coDelete . csBudgets)
--   -- deleteTxs =<< asks (coDelete . csHistory)
--   b <- asks csBudgetScope
--   h <- asks csHistoryScope
--   repsertE (E.toSqlKey 1) $ ConfigStateR h b
-
-updateMeta :: MonadSqlQuery m => MetaCRUD -> m ()
-updateMeta
-  MetaCRUD
-    { mcCurrencies
-    , mcAccounts
-    , mcPaths
-    , mcTags
-    , mcBudgetScope
-    , mcHistoryScope
-    } = do
-    updateCD mcCurrencies
-    updateCD mcAccounts
-    updateCD mcPaths
-    updateCD mcTags
-    repsertE (E.toSqlKey 1) $ ConfigStateR mcHistoryScope mcBudgetScope
+updateDBState :: (MonadFinance m, MonadSqlQuery m) => m ()
+updateDBState = do
+  updateCD =<< asks csCurrencies
+  updateCD =<< asks csAccounts
+  updateCD =<< asks csPaths
+  updateCD =<< asks csTags
+  deleteTxs =<< asks (coDelete . csBudgets)
+  deleteTxs =<< asks (coDelete . csHistTrans)
+  deleteTxs =<< asks (coDelete . csHistStmts)
+  b <- asks csBudgetScope
+  h <- asks csHistoryScope
+  repsertE (E.toSqlKey 1) $ ConfigStateR h b

 readInvalidIds
  :: MonadSqlQuery m
  => ExistingConfig
  -> [(CommitHash, a)]
-  -> m ([(CommitHash, a)], [CommitHash])
+  -> m ([CommitHash], [(CommitHash, a)])
 readInvalidIds ExistingConfig {ecAccounts, ecCurrencies, ecTags} xs = do
  rs <- selectE $ do
    (commits :& _ :& entrysets :& entries :& tags) <-
@ -554,13 +444,14 @@ readInvalidIds ExistingConfig {ecAccounts, ecCurrencies, ecTags} xs = do
  let cs = go ecCurrencies $ fmap (\(i, E.Value c, _, _) -> (i, c)) rs
  let as = go ecAccounts $ fmap (\(i, _, E.Value a, _) -> (i, a)) rs
  let ts = go ecTags [(i, t) | (i, _, _, E.Value (Just t)) <- rs]
-  let invalid = (cs `S.union` as) `S.union` ts
-  return $ second (fst <$>) $ L.partition ((`S.member` invalid) . fst) xs
+  let valid = (cs `S.intersection` as) `S.intersection` ts
+  let (a0, _) = first (fst <$>) $ L.partition ((`S.member` valid) . fst) xs
+  return (a0, [])
  where
    go existing =
      S.fromList
        . fmap (E.unValue . fst)
-        . L.filter (not . all (`S.member` existing) . snd)
+        . L.filter (all (`S.member` existing) . snd)
        . groupKey id

 readUpdates
@ -586,10 +477,9 @@ readUpdates hashes = do
      ,
        (
          ( entrysets ^. EntrySetRId
-          , entrysets ^. EntrySetRIndex
          , txs ^. TransactionRDate
+          , txs ^. TransactionRBudgetName
          , txs ^. TransactionRPriority
-          , txs ^. TransactionRDescription
          ,
            ( entrysets ^. EntrySetRCurrency
            , currencies ^. CurrencyRPrecision
@ -599,12 +489,11 @@ readUpdates hashes = do
        )
      )
  let (toUpdate, toRead) = L.partition (E.unValue . fst) xs
-  toUpdate' <- liftExcept $ mapErrors makeUES $ groupKey (\(i, _, _, _, _, _) -> i) (snd <$> toUpdate)
+  toUpdate' <- liftExcept $ mapErrors makeUES $ groupKey (\(i, _, _, _, _) -> i) (snd <$> toUpdate)
  let toRead' = fmap (makeRE . snd) toRead
  return (toRead', toUpdate')
  where
-    makeUES ((_, esi, day, pri, desc, (curID, prec)), es) = do
-      let sk = TxSortKey (E.unValue day) (E.unValue pri) (E.unValue desc)
+    makeUES ((_, day, name, pri, (curID, prec)), es) = do
      let prec' = fromIntegral $ E.unValue prec
      let cur = E.unValue curID
      let res =
@ -622,7 +511,8 @@ readUpdates hashes = do
            Left x ->
              Left $
                UpdateEntrySet
-                  { utCurrency = cur
+                  { utDate = E.unValue day
+                  , utCurrency = cur
                  , utFrom0 = x
                  , utTo0 = to0
                  , utFromRO = fromRO
@ -630,13 +520,14 @@ readUpdates hashes = do
                  , utFromUnk = fromUnk
                  , utToUnk = toUnk
                  , utTotalValue = realFracToDecimalP prec' tot
-                  , utSortKey = sk
-                  , utIndex = E.unValue esi
+                  , utBudget = E.unValue name
+                  , utPriority = E.unValue pri
                  }
            Right x ->
              Right $
                UpdateEntrySet
-                  { utCurrency = cur
+                  { utDate = E.unValue day
+                  , utCurrency = cur
                  , utFrom0 = x
                  , utTo0 = to0
                  , utFromRO = fromRO
@ -644,20 +535,20 @@ readUpdates hashes = do
                  , utFromUnk = fromUnk
                  , utToUnk = toUnk
                  , utTotalValue = ()
-                  , utSortKey = sk
-                  , utIndex = E.unValue esi
+                  , utBudget = E.unValue name
+                  , utPriority = E.unValue pri
                  }
        -- TODO this error is lame
-        _ -> throwAppError $ DBError DBUpdateUnbalanced
-    makeRE ((_, esi, day, pri, desc, (curID, prec)), entry) = do
+        _ -> throwAppError $ DBError $ DBUpdateUnbalanced
+    makeRE ((_, day, name, pri, (curID, prec)), entry) = do
      let e = entityVal entry
       in ReadEntry
-            { reCurrency = E.unValue curID
+            { reDate = E.unValue day
+            , reCurrency = E.unValue curID
            , reAcnt = entryRAccount e
            , reValue = realFracToDecimal (fromIntegral $ E.unValue prec) (entryRValue e)
-            , reSortKey = TxSortKey (E.unValue day) (E.unValue pri) (E.unValue desc)
-            , reESIndex = E.unValue esi
-            , reIndex = entryRIndex e
+            , reBudget = E.unValue name
+            , rePriority = E.unValue pri
            }

 splitFrom
@ -774,8 +665,8 @@ readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) o
  (Nothing, Nothing) -> return $ Left $ makeUnkUE k e
  (Just v, Nothing) -> err $ DBLinkInvalidValue v False
  (Just v, Just TFixed) -> err $ DBLinkInvalidValue v True
-  (Nothing, Just TBalance) -> err DBLinkInvalidBalance
-  (Nothing, Just TPercent) -> err DBLinkInvalidPercent
+  (Nothing, Just TBalance) -> err $ DBLinkInvalidBalance
+  (Nothing, Just TPercent) -> err $ DBLinkInvalidPercent
  where
    go = return . Right . Right
    err = throwAppError . DBError . DBLinkError k
@ -789,72 +680,21 @@ makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimalP prec $ entryRVal
 makeUnkUE :: EntryRId -> EntryR -> UpdateEntry EntryRId ()
 makeUnkUE k e = makeUE k e ()

-- updateEntries
--   :: (MonadSqlQuery m, MonadFinance m, MonadRerunnableIO m)
--   => [ ( BudgetName
--        , CRUDOps
--           [Tx CommitR]
--           [ReadEntry]
--           [(Either TotalUpdateEntrySet FullUpdateEntrySet)]
--           DeleteTxs
--        )
--      ]
--   -> m ()
-- updateEntries es = do
--   res <- runExceptT $ mapErrors (uncurry insertAll) es
--   void $ rerunnableIO $ fromEither res
-
-insertBudgets
+insertAll
  :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
-  => FinalBudgetCRUD
+  => [EntryCRU]
  -> m ()
-insertBudgets (CRUDOps bs () () ds) = do
-  deleteTxs ds
-  mapM_ go bs
-  where
-    go (name, cs) = do
-      -- TODO useless overhead?
-      (toUpdate, toInsert) <- balanceTxs (ToInsert <$> cs)
+insertAll ebs = do
+  (toUpdate, toInsert) <- balanceTxs ebs
  mapM_ updateTx toUpdate
-      forM_ (groupWith (txmCommit . itxMeta) toInsert) $
+  forM_ (groupWith itxCommit toInsert) $
    \(c, ts) -> do
      ck <- insert c
-          mapM_ (insertTx name ck) ts
+      mapM_ (insertTx ck) ts

-insertHistory
-  :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
-  => FinalHistoryCRUD
-  -> m ()
-insertHistory (CRUDOps cs rs us ds) = do
-  (toUpdate, toInsert) <- balanceTxs $ (ToInsert <$> cs) ++ (ToRead <$> rs) ++ (ToUpdate <$> us)
-  mapM_ updateTx toUpdate
-  forM_ (groupWith (txmCommit . itxMeta) toInsert) $
-    \(c, ts) -> do
-      ck <- insert c
-      mapM_ (insertTx historyName ck) ts
-  deleteTxs ds
-
-- insertAll
--   :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
--   => BudgetName
--   -> CRUDOps
--       [Tx CommitR]
--       [ReadEntry]
--       [Either TotalUpdateEntrySet FullUpdateEntrySet]
--       DeleteTxs
--   -> m ()
-- insertAll b (CRUDOps cs rs us ds) = do
--   (toUpdate, toInsert) <- balanceTxs $ (ToInsert <$> cs) ++ (ToRead <$> rs) ++ (ToUpdate <$> us)
--   mapM_ updateTx toUpdate
--   forM_ (groupWith itxCommit toInsert) $
--     \(c, ts) -> do
--       ck <- insert c
--       mapM_ (insertTx b ck) ts
--   deleteTxs ds
-
-insertTx :: MonadSqlQuery m => BudgetName -> CommitRId -> InsertTx -> m ()
-insertTx b c InsertTx {itxMeta = TxMeta {txmDate, txmPriority, txmDesc}, itxEntrySets} = do
-  k <- insert $ TransactionR c txmDate b txmDesc txmPriority
+insertTx :: MonadSqlQuery m => CommitRId -> InsertTx -> m ()
+insertTx c InsertTx {itxDate, itxDescr, itxEntrySets, itxBudget, itxPriority} = do
+  k <- insert $ TransactionR c itxDate itxDescr itxBudget itxPriority
  mapM_ (uncurry (insertEntrySet k)) $ zip [0 ..] (NE.toList itxEntrySets)
  where
    insertEntrySet tk i InsertEntrySet {iesCurrency, iesFromEntries, iesToEntries} = do
@ -900,6 +740,3 @@ deleteKeyE q = unsafeLiftSql "esqueleto-deleteKey" (E.deleteKey q)

 insertEntityManyE :: (MonadSqlQuery m, PersistRecordBackend a SqlBackend) => [Entity a] -> m ()
 insertEntityManyE q = unsafeLiftSql "esqueleto-insertEntityMany" (E.insertEntityMany q)
-
-historyName :: BudgetName
-historyName = BudgetName "history"
--- a/lib/Internal/History.hs
+++ b/lib/Internal/History.hs
@ -2,7 +2,6 @@ module Internal.History
  ( readHistStmt
  , readHistTransfer
  , splitHistory
-  , readHistoryCRUD
  )
 where

@ -23,20 +22,7 @@ import qualified RIO.Text as T
 import RIO.Time
 import qualified RIO.Vector as V
 import Text.Regex.TDFA hiding (matchAll)
-
-readHistoryCRUD
-  :: (MonadUnliftIO m, MonadFinance m)
-  => FilePath
-  -> PreHistoryCRUD
-  -> m FinalHistoryCRUD
-readHistoryCRUD root o@CRUDOps {coCreate = (ts, ss)} = do
-  -- TODO multithread this for some extra fun :)
-
-  ss' <- mapErrorsIO (readHistStmt root) ss
-  fromEitherM $ runExceptT $ do
-    let sRes = mapErrors (ExceptT . return) ss'
-    let tRes = mapErrors readHistTransfer ts
-    combineError sRes tRes $ \ss'' ts' -> o {coCreate = concat ss'' ++ concat ts'}
+import Text.Regex.TDFA.Text

 -- NOTE keep statement and transfer readers separate because the former needs
 -- the IO monad, and thus will throw IO errors rather than using the ExceptT
@ -55,8 +41,8 @@ readHistTransfer
  => PairedTransfer
  -> m [Tx CommitR]
 readHistTransfer ht = do
-  bounds <- asks (unHSpan . tsHistoryScope)
-  expandTransfer c bounds ht
+  bounds <- asks (unHSpan . csHistoryScope)
+  expandTransfer c historyName bounds ht
  where
    c = CommitR (CommitHash $ hash ht) CTHistoryTransfer

@ -67,28 +53,23 @@ readHistStmt
  :: (MonadUnliftIO m, MonadFinance m)
  => FilePath
  -> Statement
-  -> m (Either AppException [Tx CommitR])
+  -> m [Tx CommitR]
 readHistStmt root i = do
-  bounds <- asks (unHSpan . tsHistoryScope)
  bs <- readImport root i
-  return $ filter (inDaySpan bounds . txmDate . txMeta) . fmap go <$> bs
+  bounds <- asks (unHSpan . csHistoryScope)
+  return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = c}) bs
  where
-    go t@Tx {txMeta = m} =
-      t {txMeta = m {txmCommit = CommitR (CommitHash $ hash i) CTHistoryStatement}}
+    c = CommitR (CommitHash $ hash i) CTHistoryStatement

 -- TODO this probably won't scale well (pipes?)
-readImport
-  :: (MonadUnliftIO m, MonadFinance m)
-  => FilePath
-  -> Statement
-  -> m (Either AppException [Tx ()])
+readImport :: (MonadUnliftIO m, MonadFinance m) => FilePath -> Statement -> m [Tx ()]
 readImport root Statement {stmtTxOpts, stmtParsers, stmtSkipLines, stmtDelim, stmtPaths} = do
  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 paths
-  runExceptT (matchRecords compiledMatches records)
+  fromEither =<< runExceptT (matchRecords compiledMatches records)
  where
    paths = (root </>) <$> stmtPaths

@ -112,93 +93,39 @@ readImport_ n delim tns p = do
 -- TODO handle this better, this maybe thing is a hack to skip lines with
 -- blank dates but will likely want to make this more flexible
 parseTxRecord :: FilePath -> TxOptsRe -> NamedRecord -> Parser (Maybe TxRecord)
-parseTxRecord
-  p
-  TxOpts
-    { toDate
-    , toDesc
-    , toAmount
-    , toOther
-    , toDateFmt
-    , toSkipBlankDate
-    , toSkipBlankAmount
-    , toSkipBlankDescription
-    , toSkipBlankOther
-    , toSkipMissingFields
-    }
-  r =
-    do
-      -- TODO this is confusing as hell
-      --
-      -- try and parse all fields; if a parse fails, either trip an error
-      -- or return a Nothing if we want to deliberately skip missing fields
-      d <- getField toDate
-      e <- getField toDesc
-      os <-
-        fmap M.fromList . sequence
-          <$> mapM (\n -> fmap (n,) <$> getField n) toOther
-      (af, ax) <- case toAmount of
-        -- the amount column is extra confusing because it can either be one
-        -- or two columns, so keep track of this with a maybe
-        AmountSingle TxAmount1 {a1Column, a1Fmt} -> do
-          f <- getField a1Column
-          return (a1Fmt, Right <$> f)
-        AmountDual TxAmount2 {a2Positive, a2Negative, a2Fmt} -> do
-          f1 <- getField a2Positive
-          f2 <- getField a2Negative
-          return $ (a2Fmt,) $ case (f1, f2) of
-            (Just a, Just b) -> Just $ Left (a, b)
-            _ -> Nothing
-      case (d, e, os, ax) of
-        -- If all lookups were successful, check that none of the fields are
-        -- blank, and if they are return nothing to skip this line
-        (Just d', Just e', Just os', Just ax') ->
-          if (toSkipBlankDate && d' == "")
-            || (toSkipBlankDescription && e' == "")
-            || (toSkipBlankAmount && (ax' == Right "" || ax' == Left ("", "")))
-            || elem "" (mapMaybe (`M.lookup` os') toSkipBlankOther)
+parseTxRecord p TxOpts {toDate, toAmountFmt, toDesc, toAmount, toOther, toDateFmt} r = do
+  d <- r .: T.encodeUtf8 toDate
+  if d == ""
    then return Nothing
-            else -- if we are skipping nothing, proceed to parse the date and amount
-            -- columns
-            do
-              a <- case ax' of
-                Right a -> parseDecimal True af a
-                Left ("", a) -> ((-1) *) <$> parseDecimal False af a
-                Left (a, _) -> parseDecimal False af a
-              d'' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d'
-              return $ Just $ TxRecord d'' a e' os' p
-        -- if no lookups succeeded, return nothing to skip this line. Note that
-        -- a parse fail will trigger a failure error further up, so that case
-        -- is already dealt with implicitly
-        _ -> return Nothing
-    where
-      getField :: FromField a => T.Text -> Parser (Maybe a)
-      getField f = case runParser $ r .: T.encodeUtf8 f of
-        Left err -> if toSkipMissingFields then return Nothing else fail err
-        Right x -> return $ Just x
+    else do
+      a <- parseDecimal toAmountFmt =<< r .: T.encodeUtf8 toAmount
+      e <- r .: T.encodeUtf8 toDesc
+      os <- M.fromList <$> mapM (\n -> (n,) <$> r .: T.encodeUtf8 n) toOther
+      d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
+      return $ Just $ TxRecord d' a e os p

-matchRecords :: MonadFinance m => [StatementParserRe] -> [TxRecord] -> AppExceptT m [Tx ()]
+matchRecords :: MonadFinance m => [MatchRe] -> [TxRecord] -> AppExceptT m [Tx ()]
 matchRecords ms rs = do
  (matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
  case (matched, unmatched, notfound) of
    (ms_, [], []) -> return ms_
    (_, us, ns) -> throwError $ AppException [StatementError us ns]

-matchPriorities :: [StatementParserRe] -> [MatchGroup]
+matchPriorities :: [MatchRe] -> [MatchGroup]
 matchPriorities =
  fmap matchToGroup
    . L.groupBy (\a b -> spPriority a == spPriority b)
    . L.sortOn (Down . spPriority)

-matchToGroup :: [StatementParserRe] -> MatchGroup
+matchToGroup :: [MatchRe] -> MatchGroup
 matchToGroup ms =
  uncurry MatchGroup $
    first (L.sortOn spDate) $
      L.partition (isJust . spDate) ms

 data MatchGroup = MatchGroup
-  { mgDate :: ![StatementParserRe]
-  , mgNoDate :: ![StatementParserRe]
+  { mgDate :: ![MatchRe]
+  , mgNoDate :: ![MatchRe]
  }
  deriving (Show)

@ -237,9 +164,9 @@ zipperSlice f x = go

 zipperMatch
  :: MonadFinance m
-  => Unzipped StatementParserRe
+  => Unzipped MatchRe
  -> TxRecord
-  -> AppExceptT m (Zipped StatementParserRe, MatchRes (Tx ()))
+  -> AppExceptT m (Zipped MatchRe, MatchRes (Tx ()))
 zipperMatch (Unzipped bs cs as) x = go [] cs
  where
    go _ [] = return (Zipped bs $ cs ++ as, MatchFail)
@ -254,9 +181,9 @@ zipperMatch (Unzipped bs cs as) x = go [] cs

 zipperMatch'
  :: MonadFinance m
-  => Zipped StatementParserRe
+  => Zipped MatchRe
  -> TxRecord
-  -> AppExceptT m (Zipped StatementParserRe, MatchRes (Tx ()))
+  -> AppExceptT m (Zipped MatchRe, MatchRes (Tx ()))
 zipperMatch' z x = go z
  where
    go (Zipped bs (a : as)) = do
@ -267,7 +194,7 @@ zipperMatch' z x = go z
          return (Zipped (maybe bs (: bs) $ matchDec a) as, skipOrPass)
    go z' = return (z', MatchFail)

-matchDec :: StatementParserRe -> Maybe StatementParserRe
+matchDec :: MatchRe -> Maybe MatchRe
 matchDec m = case spTimes m of
  Just 1 -> Nothing
  Just n -> Just $ m {spTimes = Just $ n - 1}
@ -277,7 +204,7 @@ matchAll
  :: MonadFinance m
  => [MatchGroup]
  -> [TxRecord]
-  -> AppExceptT m ([Tx ()], [TxRecord], [StatementParserRe])
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchAll = go ([], [])
  where
    go (matched, unused) gs rs = case (gs, rs) of
@ -291,7 +218,7 @@ matchGroup
  :: MonadFinance m
  => MatchGroup
  -> [TxRecord]
-  -> AppExceptT m ([Tx ()], [TxRecord], [StatementParserRe])
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do
  (md, rest, ud) <- matchDates ds rs
  (mn, unmatched, un) <- matchNonDates ns rest
@ -299,9 +226,9 @@ matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do

 matchDates
  :: MonadFinance m
-  => [StatementParserRe]
+  => [MatchRe]
  -> [TxRecord]
-  -> AppExceptT m ([Tx ()], [TxRecord], [StatementParserRe])
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchDates ms = go ([], [], initZipper ms)
  where
    go (matched, unmatched, z) [] =
@ -324,9 +251,9 @@ matchDates ms = go ([], [], initZipper ms)

 matchNonDates
  :: MonadFinance m
-  => [StatementParserRe]
+  => [MatchRe]
  -> [TxRecord]
-  -> AppExceptT m ([Tx ()], [TxRecord], [StatementParserRe])
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchNonDates ms = go ([], [], initZipper ms)
  where
    go (matched, unmatched, z) [] =
@ -343,11 +270,7 @@ matchNonDates ms = go ([], [], initZipper ms)
            MatchFail -> (matched, r : unmatched)
       in go (m, u, resetZipper z') rs

-matches
-  :: MonadFinance m
-  => StatementParserRe
-  -> TxRecord
-  -> AppExceptT m (MatchRes (Tx ()))
+matches :: MonadFinance m => MatchRe -> TxRecord -> AppExceptT m (MatchRes (Tx ()))
 matches
  StatementParser {spTx, spOther, spVal, spDate, spDesc, spPriority}
  r@TxRecord {trDate, trAmount, trDesc, trOther} = do
@ -377,7 +300,9 @@ toTx
  r@TxRecord {trAmount, trDate, trDesc} = do
    combineError curRes subRes $ \(cur, f, t) ss ->
      Tx
-        { txMeta = TxMeta trDate priority trDesc ()
+        { txDate = trDate
+        , txDescr = trDesc
+        , txCommit = ()
        , txPrimary =
            Left $
              EntrySet
@ -387,10 +312,12 @@ toTx
                , esTo = t
                }
        , txOther = Left <$> ss
+        , txBudget = historyName
+        , txPriority = priority
        }
    where
      curRes = do
-        m <- asks tsCurrencyMap
+        m <- asks csCurrencyMap
        cur <- liftInner $ resolveCurrency m r tgCurrency
        let prec = cpPrec cur
        let fromRes = liftInner $ resolveHalfEntry resolveFromValue prec r () tgFrom
@ -404,7 +331,7 @@ resolveSubGetter
  -> TxSubGetter
  -> AppExceptT m SecondayEntrySet
 resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
-  m <- asks tsCurrencyMap
+  m <- asks csCurrencyMap
  cur <- liftInner $ resolveCurrency m r tsgCurrency
  let prec = cpPrec cur
  let toRes = resolveHalfEntry resolveToValue prec r () tsgTo
@ -522,17 +449,11 @@ readRational s = case T.split (== '.') s of
    err = throwError $ AppException [ConversionError s False]

 compileOptions :: TxOpts T.Text -> AppExcept TxOptsRe
-compileOptions = mapM (compileRegex True)
+compileOptions o@TxOpts {toAmountFmt = pat} = do
+  re <- compileRegex True pat
+  return $ o {toAmountFmt = re}

-- compileOptions o@TxOpts {toAmount = pat} = case pat of
--   AmountSingle (TxAmount1 {a1Fmt}) -> do
--     re <- compileRegex True a1Fmt
--     return $ o {toAmountFmt = re}
--   AmountDual (TxAmount2 {a2Fmt}) -> do
--     re <- compileRegex True a2Fmt
--     return $ o {toAmountFmt = re}
-
-compileMatch :: StatementParser T.Text -> AppExcept StatementParserRe
+compileMatch :: StatementParser T.Text -> AppExcept MatchRe
 compileMatch m@StatementParser {spDesc, spOther} = do
  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
  where
@ -540,15 +461,42 @@ compileMatch m@StatementParser {spDesc, spOther} = do
    dres = mapM go spDesc
    ores = combineErrors $ fmap (mapM go) spOther

-parseDecimal :: MonadFail m => Bool -> (T.Text, Regex) -> T.Text -> m Decimal
-parseDecimal wantSign (pat, re) s = case (wantSign, matchGroupsMaybe s re) of
-  (True, [sign, num]) -> do
-    k <- readSign sign
-    x <- readNum num
-    return $ k * x
-  (False, [num]) -> readNum num
+compileRegex :: Bool -> T.Text -> AppExcept (Text, Regex)
+compileRegex groups pat = case res of
+  Right re -> return (pat, re)
+  Left _ -> throwError $ AppException [RegexError pat]
+  where
+    res =
+      compile
+        (blankCompOpt {newSyntax = True})
+        (blankExecOpt {captureGroups = groups})
+        pat
+
+matchMaybe :: T.Text -> Regex -> AppExcept Bool
+matchMaybe q re = case execute re q of
+  Right res -> return $ isJust res
+  Left _ -> throwError $ AppException [RegexError "this should not happen"]
+
+matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
+matchGroupsMaybe q re = case regexec re q of
+  Right Nothing -> []
+  Right (Just (_, _, _, xs)) -> xs
+  -- this should never fail as regexec always returns Right
+  Left _ -> []
+
+parseDecimal :: MonadFail m => (T.Text, Regex) -> T.Text -> m Decimal
+parseDecimal (pat, re) s = case matchGroupsMaybe s re of
+  [sign, x, ""] -> Decimal 0 . uncurry (*) <$> readWhole sign x
+  [sign, x, y] -> do
+    d <- readT "decimal" y
+    let p = T.length y
+    (k, w) <- readWhole sign x
+    return $ Decimal (fromIntegral p) (k * (w * (10 ^ p) + d))
  _ -> msg "malformed decimal"
  where
+    readT what t = case readMaybe $ T.unpack t of
+      Just d -> return $ fromInteger d
+      _ -> msg $ T.unwords ["could not parse", what, singleQuote t]
    msg :: MonadFail m => T.Text -> m a
    msg m =
      fail $
@ -558,10 +506,10 @@ parseDecimal wantSign (pat, re) s = case (wantSign, matchGroupsMaybe s re) of
      | x == "-" = return (-1)
      | x == "+" || x == "" = return 1
      | otherwise = msg $ T.append "invalid sign: " x
-    readNum x =
-      maybe
-        (msg $ T.unwords ["could not parse", singleQuote x])
-        return
-        $ readMaybe
-        $ T.unpack
-        $ T.filter (/= ',') x
+    readWhole sign x = do
+      w <- readT "whole number" x
+      k <- readSign sign
+      return (k, w)
+
+historyName :: BudgetName
+historyName = BudgetName "history"
--- a/lib/Internal/Types/Database.hs
+++ b/lib/Internal/Types/Database.hs
@ -24,12 +24,10 @@ CommitR sql=commits
    type ConfigType
    UniqueCommitHash hash
    deriving Show Eq Ord
-
 ConfigStateR sql=config_state
    historySpan HistorySpan
    budgetSpan BudgetSpan
    deriving Show
-
 CurrencyR sql=currencies
    symbol CurID
    fullname T.Text
@ -37,14 +35,12 @@ CurrencyR sql=currencies
    UniqueCurrencySymbol symbol
    UniqueCurrencyFullname fullname
    deriving Show Eq Ord
-
 TagR sql=tags
    symbol TagID
    fullname T.Text
    UniqueTagSymbol symbol
    UniqueTagFullname fullname
    deriving Show Eq Ord
-
 AccountR sql=accounts
    name T.Text
    fullpath AcntPath
@ -53,28 +49,24 @@ AccountR sql=accounts
    leaf Bool
    UniqueAccountFullpath fullpath
    deriving Show Eq Ord
-
 AccountPathR sql=account_paths
    parent AccountRId 
    child AccountRId 
    depth Int
    deriving Show Eq Ord
-
 TransactionR sql=transactions
    commit CommitRId 
    date Day
-    budgetName BudgetName
    description TxDesc
+    budgetName BudgetName
    priority Int
    deriving Show Eq
-
 EntrySetR sql=entry_sets
    transaction TransactionRId 
    currency CurrencyRId 
    index EntrySetIndex
    rebalance Bool
    deriving Show Eq
-
 EntryR sql=entries
    entryset EntrySetRId  
    account AccountRId 
@ -85,16 +77,12 @@ EntryR sql=entries
    cachedType (Maybe TransferType)
    cachedLink (Maybe EntryIndex)
    deriving Show Eq
-
 TagRelationR sql=tag_relations
    entry EntryRId 
    tag TagRId
    deriving Show Eq
 |]

-newtype TxIndex = TxIndex {unTxIndex :: Int}
-  deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)
-
 newtype EntrySetIndex = EntrySetIndex {unEntrySetIndex :: Int}
  deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)

@ -102,7 +90,7 @@ newtype EntryIndex = EntryIndex {unEntryIndex :: Int}
  deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)

 newtype TxDesc = TxDesc {unTxDesc :: T.Text}
-  deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField, IsString)
+  deriving newtype (Show, Eq, Ord, PersistField, PersistFieldSql, FromField)

 newtype Precision = Precision {unPrecision :: Word8}
  deriving newtype (Eq, Ord, Num, Show, Real, Enum, Integral, PersistField, PersistFieldSql)
--- a/lib/Internal/Types/Dhall.hs
+++ b/lib/Internal/Types/Dhall.hs
@ -49,16 +49,17 @@ makeHaskellTypesWith
  , SingleConstructor "ModPat" "ModPat" "(./dhall/Types.dhall).ModPat.Type"
  , SingleConstructor "CronPat" "CronPat" "(./dhall/Types.dhall).CronPat.Type"
  , SingleConstructor "ValMatcher" "ValMatcher" "(./dhall/Types.dhall).ValMatcher.Type"
-  , SingleConstructor "TxAmount1" "TxAmount1" "(./dhall/Types.dhall).TxAmount1_"
-  , SingleConstructor "TxAmount2" "TxAmount2" "(./dhall/Types.dhall).TxAmount2_"
  , SingleConstructor
      "Amount"
      "Amount"
      "\\(w : Type) -> \\(v : Type) -> ((./dhall/Types.dhall).Amount w v).Type"
  , SingleConstructor
-      "AcntMatcher_"
-      "AcntMatcher_"
-      "\\(re : Type) -> ((./dhall/Types.dhall).AcntMatcher_ re).Type"
+      "TxOpts"
+      "TxOpts"
+      "\\(re : Type) -> ((./dhall/Types.dhall).TxOpts_ re).Type"
+  , SingleConstructor "AcntSet" "AcntSet" "(./dhall/Types.dhall).AcntSet.Type"
+  , SingleConstructor "TransferMatcher" "TransferMatcher" "(./dhall/Types.dhall).TransferMatcher.Type"
+  , SingleConstructor "ShadowTransfer" "ShadowTransfer" "(./dhall/Types.dhall).ShadowTransfer"
  , SingleConstructor "Field" "Field" "(./dhall/Types.dhall).Field"
  , SingleConstructor "Entry" "Entry" "(./dhall/Types.dhall).Entry"
  , SingleConstructor "PretaxValue" "PretaxValue" "(./dhall/Types.dhall).PretaxValue"
@ -87,7 +88,11 @@ deriveProduct
  , "CronPat"
  , "DatePat"
  , "TaggedAcnt"
+  , "Budget"
  , "Income"
+  , "ShadowTransfer"
+  , "TransferMatcher"
+  , "AcntSet"
  , "DateMatcher"
  , "ValMatcher"
  , "YMDMatcher"
@ -186,33 +191,15 @@ newtype BudgetName = BudgetName {unBudgetName :: T.Text}
  deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)

 data Budget = Budget
-  { bgtLabel :: !BudgetName
-  , bgtIncomes :: ![Income]
-  , bgtPretax :: ![MultiAllocation PretaxValue]
-  , bgtTax :: ![MultiAllocation TaxValue]
-  , bgtPosttax :: ![MultiAllocation PosttaxValue]
-  , bgtTransfers :: ![PairedTransfer]
-  , bgtShadowTransfers :: ![ShadowTransfer]
+  { bgtLabel :: BudgetName
+  , bgtIncomes :: [Income]
+  , bgtPretax :: [MultiAllocation PretaxValue]
+  , bgtTax :: [MultiAllocation TaxValue]
+  , bgtPosttax :: [MultiAllocation PosttaxValue]
+  , bgtTransfers :: [PairedTransfer]
+  , bgtShadowTransfers :: [ShadowTransfer]
  , bgtInterval :: !(Maybe Interval)
  }
-  deriving (Generic, Hashable, FromDhall)
-
-data ShadowTransfer = ShadowTransfer
-  { stFrom :: !TaggedAcnt
-  , stTo :: !TaggedAcnt
-  , stCurrency :: !CurID
-  , stDesc :: !Text
-  , stMatch :: !(TransferMatcher_ Text)
-  , stRatio :: !Double
-  }
-  deriving (Generic, Hashable, FromDhall)
-
-data TransferMatcher_ re = TransferMatcher_
-  { tmFrom :: !(Maybe (AcntMatcher_ re))
-  , tmTo :: !(Maybe (AcntMatcher_ re))
-  , tmDate :: !(Maybe DateMatcher)
-  , tmVal :: !ValMatcher
-  }

 deriving instance Hashable PretaxValue

@ -226,6 +213,8 @@ deriving instance Hashable TaxValue

 deriving instance Hashable PosttaxValue

+deriving instance Hashable Budget
+
 deriving instance Hashable TransferValue

 deriving instance Hashable TransferType
@ -325,17 +314,11 @@ data Transfer a c w v = Transfer
  }
  deriving (Eq, Show)

-deriving instance Generic (TransferMatcher_ Text)
+deriving instance Hashable ShadowTransfer

-deriving instance Hashable (TransferMatcher_ Text)
+deriving instance Hashable AcntSet

-deriving instance FromDhall (TransferMatcher_ Text)
-
-deriving instance Generic (AcntMatcher_ Text)
-
-deriving instance Hashable (AcntMatcher_ Text)
-
-deriving instance FromDhall (AcntMatcher_ Text)
+deriving instance Hashable TransferMatcher

 deriving instance Hashable ValMatcher

@ -466,44 +449,12 @@ deriving instance Eq a => Eq (TxOpts a)

 deriving instance Generic (TxOpts a)

-deriving instance Hashable (TxOpts T.Text)
+deriving instance Hashable a => Hashable (TxOpts a)

-deriving instance FromDhall (TxOpts T.Text)
+deriving instance FromDhall a => FromDhall (TxOpts a)

 deriving instance Show a => Show (TxOpts a)

-deriving instance Eq re => Eq (TxAmount1 re)
-
-deriving instance Eq re => Eq (TxAmount2 re)
-
-deriving instance Show re => Show (TxAmount1 re)
-
-deriving instance Show re => Show (TxAmount2 re)
-
-deriving instance Generic (TxAmount1 T.Text)
-
-deriving instance Generic (TxAmount2 T.Text)
-
-deriving instance Hashable (TxAmount1 T.Text)
-
-deriving instance Hashable (TxAmount2 T.Text)
-
-deriving instance FromDhall (TxAmount1 T.Text)
-
-deriving instance FromDhall (TxAmount2 T.Text)
-
-deriving instance Functor TxAmount1
-
-deriving instance Functor TxAmount2
-
-deriving instance Foldable TxAmount1
-
-deriving instance Foldable TxAmount2
-
-deriving instance Traversable TxAmount1
-
-deriving instance Traversable TxAmount2
-
 data Statement = Statement
  { stmtPaths :: ![FilePath]
  , stmtParsers :: ![StatementParser T.Text]
@ -513,29 +464,6 @@ data Statement = Statement
  }
  deriving (Eq, Hashable, Generic, FromDhall, Show)

-data TxAmountSpec re = AmountSingle (TxAmount1 re) | AmountDual (TxAmount2 re)
-  deriving (Eq, Show, Functor, Foldable, Traversable)
-
-deriving instance Generic (TxAmountSpec T.Text)
-
-deriving instance FromDhall (TxAmountSpec T.Text)
-
-deriving instance Hashable (TxAmountSpec T.Text)
-
-data TxOpts re = TxOpts
-  { toDate :: !T.Text
-  , toAmount :: !(TxAmountSpec re)
-  , toDesc :: !T.Text
-  , toOther :: ![T.Text]
-  , toDateFmt :: !T.Text
-  , toSkipBlankDate :: !Bool
-  , toSkipBlankAmount :: !Bool
-  , toSkipBlankDescription :: !Bool
-  , toSkipBlankOther :: ![Text]
-  , toSkipMissingFields :: !Bool
-  }
-  deriving (Functor, Foldable, Traversable)
-
 -- | the value of a field in entry (text version)
 -- can either be a raw (constant) value, a lookup from the record, or a map
 -- between the lookup and some other value
--- a/lib/Internal/Types/Main.hs
+++ b/lib/Internal/Types/Main.hs
@ -26,51 +26,32 @@ import Text.Regex.TDFA
 --------------------------------------------------------------------------------
 -- database cache types

-type MonadFinance = MonadReader TxState
+type MonadFinance = MonadReader ConfigState

 data DeleteTxs = DeleteTxs
-  { dtCommits :: ![CommitRId]
-  , dtTxs :: ![TransactionRId]
+  { dtTxs :: ![TransactionRId]
  , dtEntrySets :: ![EntrySetRId]
  , dtEntries :: ![EntryRId]
  , dtTagRelations :: ![TagRelationRId]
  }
  deriving (Show)

-type EntityCRUDOps r = CRUDOps [Entity r] () () [Key r]
+type CDOps c d = CRUDOps [c] () () [d]

-data MetaCRUD = MetaCRUD
-  { mcCurrencies :: !(EntityCRUDOps CurrencyR)
-  , mcAccounts :: !(EntityCRUDOps AccountR)
-  , mcPaths :: !(EntityCRUDOps AccountPathR)
-  , mcTags :: !(EntityCRUDOps TagR)
-  , mcBudgetScope :: !BudgetSpan
-  , mcHistoryScope :: !HistorySpan
-  }
-
-type BudgetCRUDOps b = CRUDOps [b] () () DeleteTxs
-
-type PreBudgetCRUD = BudgetCRUDOps Budget
-
-type FinalBudgetCRUD = BudgetCRUDOps (BudgetName, [Tx CommitR])
-
-type HistoryCRUDOps h =
-  CRUDOps
-    h
-    [ReadEntry]
-    [Either TotalUpdateEntrySet FullUpdateEntrySet]
-    DeleteTxs
-
-type PreHistoryCRUD = HistoryCRUDOps ([PairedTransfer], [Statement])
-
-type FinalHistoryCRUD = HistoryCRUDOps [Tx CommitR]
-
-data TxState = TxState
-  { tsAccountMap :: !AccountMap
-  , tsCurrencyMap :: !CurrencyMap
-  , tsTagMap :: !TagMap
-  , tsBudgetScope :: !BudgetSpan
-  , tsHistoryScope :: !HistorySpan
+-- TODO split the entry stuff from the account metadata stuff
+data ConfigState = ConfigState
+  { csCurrencies :: !(CDOps (Entity CurrencyR) CurrencyRId)
+  , csAccounts :: !(CDOps (Entity AccountR) AccountRId)
+  , csPaths :: !(CDOps (Entity AccountPathR) AccountPathRId)
+  , csTags :: !(CDOps (Entity TagR) TagRId)
+  , csBudgets :: !(CRUDOps [Budget] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
+  , csHistTrans :: !(CRUDOps [PairedTransfer] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
+  , csHistStmts :: !(CRUDOps [Statement] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
+  , csAccountMap :: !AccountMap
+  , csCurrencyMap :: !CurrencyMap
+  , csTagMap :: !TagMap
+  , csBudgetScope :: !BudgetSpan
+  , csHistoryScope :: !HistorySpan
  }
  deriving (Show)

@ -102,22 +83,13 @@ data CachedEntry
  | CachedBalance Decimal
  | CachedPercent Double

-data TxSortKey = TxSortKey
-  { tskDate :: !Day
-  , tskPriority :: !Int
-  , tskDesc :: !TxDesc
-  }
-  deriving (Show, Eq, Ord)
-
-- TODO this should actually be a ReadTx since it will be compared with other
-- Tx's to get the insert/update order correct
 data ReadEntry = ReadEntry
  { reCurrency :: !CurrencyRId
  , reAcnt :: !AccountRId
  , reValue :: !Decimal
-  , reIndex :: !EntryIndex
-  , reESIndex :: !EntrySetIndex
-  , reSortKey :: !TxSortKey
+  , reDate :: !Day
+  , rePriority :: !Int
+  , reBudget :: !BudgetName
  }
  deriving (Show)

@ -157,9 +129,10 @@ data UpdateEntrySet f t = UpdateEntrySet
  , utFromRO :: ![UE_RO]
  , utToRO :: ![UE_RO]
  , utCurrency :: !CurrencyRId
+  , utDate :: !Day
  , utTotalValue :: !t
-  , utIndex :: !EntrySetIndex
-  , utSortKey :: !TxSortKey
+  , utBudget :: !BudgetName
+  , utPriority :: !Int
  }
  deriving (Show)

@ -222,18 +195,14 @@ type ShadowEntrySet = TotalEntrySet Double EntryValue EntryLink
 data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text
  deriving (Eq, Ord, Show)

-data TxMeta k = TxMeta
-  { txmDate :: !Day
-  , txmPriority :: !Int
-  , txmDesc :: !TxDesc
-  , txmCommit :: !k
-  }
-  deriving (Show, Eq, Ord)
-
 data Tx k = Tx
-  { txMeta :: !(TxMeta k)
+  { txDescr :: !TxDesc
+  , txDate :: !Day
+  , txPriority :: !Int
  , txPrimary :: !(Either PrimaryEntrySet TransferEntrySet)
  , txOther :: ![Either SecondayEntrySet ShadowEntrySet]
+  , txCommit :: !k
+  , txBudget :: !BudgetName
  }
  deriving (Generic, Show)

@ -249,8 +218,12 @@ data InsertEntrySet = InsertEntrySet
  }

 data InsertTx = InsertTx
-  { itxMeta :: !(TxMeta CommitR)
+  { itxDescr :: !TxDesc
+  , itxDate :: !Day
+  , itxPriority :: !Int
  , itxEntrySets :: !(NonEmpty InsertEntrySet)
+  , itxCommit :: !CommitR
+  , itxBudget :: !BudgetName
  }
  deriving (Generic)

@ -306,7 +279,7 @@ data AppError
  | LookupError !LookupSuberr !T.Text
  | DatePatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
  | DaySpanError !Gregorian !(Maybe Gregorian)
-  | StatementError ![TxRecord] ![StatementParserRe]
+  | StatementError ![TxRecord] ![MatchRe]
  | PeriodError !Day !Day
  | LinkError !EntryIndex !EntryIndex
  | DBError !DBSubError
@ -323,9 +296,7 @@ type AppExceptT = ExceptT AppException

 type AppExcept = AppExceptT Identity

-type StatementParserRe = StatementParser (T.Text, Regex)
-
-type TransferMatcherRe = TransferMatcher_ Regex
+type MatchRe = StatementParser (T.Text, Regex)

 type TxOptsRe = TxOpts (T.Text, Regex)

--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@ -51,9 +51,6 @@ module Internal.Utils
  , keyVals
  , realFracToDecimalP
  , roundToP
-  , compileRegex
-  , matchMaybe
-  , matchGroupsMaybe
  )
 where

@ -72,8 +69,6 @@ import RIO.State
 import qualified RIO.Text as T
 import RIO.Time
 import qualified RIO.Vector as V
-import Text.Regex.TDFA hiding (matchAll)
-import Text.Regex.TDFA.Text

 --------------------------------------------------------------------------------
 -- intervals
@ -130,7 +125,7 @@ expandCronPat b CronPat {cpYear, cpMonth, cpDay, cpWeekly} =

 expandMDYPat :: Natural -> Natural -> MDYPat -> AppExcept [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 (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]
@ -156,7 +151,7 @@ askDays
  -> Maybe Interval
  -> m [Day]
 askDays dp i = do
-  globalSpan <- asks (unBSpan . tsBudgetScope)
+  globalSpan <- asks (unBSpan . csBudgetScope)
  case i of
    Just i' -> do
      localSpan <- liftExcept $ resolveDaySpan i'
@ -499,7 +494,7 @@ showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
      , ("description", doubleQuote $ unTxDesc e)
      ]

-showMatch :: StatementParserRe -> T.Text
+showMatch :: MatchRe -> T.Text
 showMatch StatementParser {spDate, spVal, spDesc, spOther, spTimes, spPriority} =
  T.append "Unused match: " $ keyVals [(x, y) | (x, Just y) <- kvs]
  where
@ -604,7 +599,7 @@ uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
 uncurry3 f (a, b, c) = f a b c

 lookupAccount :: (MonadAppError m, MonadFinance m) => AcntID -> m (AccountRId, AcntType)
-lookupAccount = lookupFinance AcntField tsAccountMap
+lookupAccount = lookupFinance AcntField csAccountMap

 lookupAccountKey :: (MonadAppError m, MonadFinance m) => AcntID -> m AccountRId
 lookupAccountKey = fmap fst . lookupAccount
@ -613,7 +608,7 @@ lookupAccountType :: (MonadAppError m, MonadFinance m) => AcntID -> m AcntType
 lookupAccountType = fmap snd . lookupAccount

 lookupCurrency :: (MonadAppError m, MonadFinance m) => CurID -> m CurrencyPrec
-lookupCurrency = lookupFinance CurField tsCurrencyMap
+lookupCurrency = lookupFinance CurField csCurrencyMap

 lookupCurrencyKey :: (MonadAppError m, MonadFinance m) => CurID -> m CurrencyRId
 lookupCurrencyKey = fmap cpID . lookupCurrency
@ -622,12 +617,12 @@ lookupCurrencyPrec :: (MonadAppError m, MonadFinance m) => CurID -> m Precision
 lookupCurrencyPrec = fmap cpPrec . lookupCurrency

 lookupTag :: (MonadAppError m, MonadFinance m) => TagID -> m TagRId
-lookupTag = lookupFinance TagField tsTagMap
+lookupTag = lookupFinance TagField csTagMap

 lookupFinance
  :: (MonadAppError m, MonadFinance m, Ord k, Show k)
  => EntryIDType
-  -> (TxState -> M.Map k a)
+  -> (ConfigState -> M.Map k a)
  -> k
  -> m a
 lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< asks f
@ -644,38 +639,39 @@ balanceTxs ebs =
      fmap (Just . Left) $
        liftInnerS $
          either rebalanceTotalEntrySet rebalanceFullEntrySet utx
-    go (ToRead ReadEntry {reCurrency, reAcnt, reValue}) = do
-      modify $ mapAdd_ (reAcnt, reCurrency) reValue
+    go (ToRead ReadEntry {reCurrency, reAcnt, reValue, reBudget}) = do
+      modify $ mapAdd_ (reAcnt, (reCurrency, reBudget)) reValue
      return Nothing
-    go (ToInsert Tx {txPrimary, txOther, txMeta}) = do
-      e <- either balancePrimaryEntrySet balanceSecondaryEntrySet txPrimary
+    go (ToInsert Tx {txPrimary, txOther, txDescr, txCommit, txDate, txBudget, txPriority}) = do
+      e <- either (balancePrimaryEntrySet txBudget) (balanceSecondaryEntrySet txBudget) txPrimary
      let tot = sum $ fmap (eValue . ieEntry) $ NE.toList $ iesFromEntries e
      es <- mapErrors (goOther tot) txOther
-      let tx = InsertTx {itxMeta = txMeta, itxEntrySets = e :| es}
+      let tx =
+            -- TODO this is lame
+            InsertTx
+              { itxDescr = txDescr
+              , itxDate = txDate
+              , itxEntrySets = e :| es
+              , itxCommit = txCommit
+              , itxBudget = txBudget
+              , itxPriority = txPriority
+              }
      return $ Just $ Right tx
      where
        goOther tot =
          either
-            balanceSecondaryEntrySet
-            (balancePrimaryEntrySet . fromShadow tot)
+            (balanceSecondaryEntrySet txBudget)
+            (balancePrimaryEntrySet txBudget . fromShadow tot)
        fromShadow tot e@EntrySet {esTotalValue} = e {esTotalValue = tot *. esTotalValue}

-- NOTE this sorting thing is super wonky; I'm basically sorting three different
-- levels of the hierarchy directory and assuming there will be no overlaps.
-- First, sort at the transaction level by day, priority, and description as
-- tiebreaker. Anything that shares those three keys will have an unstable sort
-- order. Within the entrysets, use the index as it appears in the
-- configuration, and same with the entries. Since we assume no overlap, nothing
-- "bad" should happen if the levels above entries/entrysets sort on 'Nothing'
-- for the indices they don't have at their level.
-binDate :: EntryCRU -> (TxSortKey, Maybe EntrySetIndex, Maybe EntryIndex)
-binDate (ToRead ReadEntry {reSortKey, reESIndex, reIndex}) = (reSortKey, Just reESIndex, Just reIndex)
-binDate (ToInsert Tx {txMeta = (TxMeta t p d _)}) = (TxSortKey t p d, Nothing, Nothing)
+binDate :: EntryCRU -> (Day, Int)
+binDate (ToRead ReadEntry {reDate, rePriority}) = (reDate, rePriority)
+binDate (ToInsert Tx {txDate, txPriority}) = (txDate, txPriority)
 binDate (ToUpdate u) = either go go u
  where
-    go UpdateEntrySet {utSortKey, utIndex} = (utSortKey, Just utIndex, Nothing)
+    go UpdateEntrySet {utDate, utPriority} = (utDate, utPriority)

-type BCKey = CurrencyRId
+type BCKey = (CurrencyRId, BudgetName)

 type ABCKey = (AccountRId, BCKey)

@ -696,14 +692,17 @@ rebalanceTotalEntrySet
    , utToRO
    , utCurrency
    , utTotalValue
+    , utBudget
    } =
    do
-      (fval, fs, tpairs) <- rebalanceDebit utCurrency utFromRO utFromUnk
+      (fval, fs, tpairs) <- rebalanceDebit bc utFromRO utFromUnk
      let f0val = utTotalValue - fval
-      modify $ mapAdd_ (f0Acnt, utCurrency) f0val
+      modify $ mapAdd_ (f0Acnt, bc) f0val
      let tsLinked = tpairs ++ (unlink f0val <$> f0links)
-      ts <- rebalanceCredit utCurrency utTotalValue utTo0 utToUnk utToRO tsLinked
+      ts <- rebalanceCredit bc utTotalValue utTo0 utToUnk utToRO tsLinked
      return (f0 {ueValue = StaticValue f0val} : fs ++ ts)
+    where
+      bc = (utCurrency, utBudget)

 rebalanceFullEntrySet :: FullUpdateEntrySet -> State EntryBals [UEBalanced]
 rebalanceFullEntrySet
@ -715,15 +714,17 @@ rebalanceFullEntrySet
    , utFromRO
    , utToRO
    , utCurrency
+    , utBudget
    } =
    do
-      (ftot, fs, tpairs) <- rebalanceDebit utCurrency rs ls
-      ts <- rebalanceCredit utCurrency ftot utTo0 utToUnk utToRO tpairs
+      (ftot, fs, tpairs) <- rebalanceDebit bc rs ls
+      ts <- rebalanceCredit bc ftot utTo0 utToUnk utToRO tpairs
      return (fs ++ ts)
    where
      (rs, ls) = case utFrom0 of
        Left x -> (x : utFromRO, utFromUnk)
        Right x -> (utFromRO, x : utFromUnk)
+      bc = (utCurrency, utBudget)

 rebalanceDebit
  :: BCKey
@ -757,7 +758,7 @@ rebalanceCredit
  -> [UE_RO]
  -> [UEBalanced]
  -> State EntryBals [UEBalanced]
-rebalanceCredit k tot t0@UpdateEntry {ueAcnt = t0Acnt} us rs bs = do
+rebalanceCredit k tot t0 us rs bs = do
  (tval, ts) <-
    fmap (second catMaybes) $
      sumM goTo $
@ -765,9 +766,7 @@ rebalanceCredit k tot t0@UpdateEntry {ueAcnt = t0Acnt} us rs bs = do
          (UETLinked <$> bs)
            ++ (UETUnk <$> us)
            ++ (UETReadOnly <$> rs)
-  let t0val = -(tot + tval)
-  modify $ mapAdd_ (t0Acnt, k) t0val
-  return (t0 {ueValue = StaticValue t0val} : ts)
+  return (t0 {ueValue = StaticValue (-(tot + tval))} : ts)
  where
    idx = projectUET ueIndex ueIndex ueIndex
    goTo (UETReadOnly e) = (,Nothing) <$> updateFixed k e
@ -807,9 +806,11 @@ updateUnknown k e = do

 balancePrimaryEntrySet
  :: (MonadAppError m, MonadFinance m)
-  => PrimaryEntrySet
+  => BudgetName
+  -> PrimaryEntrySet
  -> StateT EntryBals m InsertEntrySet
 balancePrimaryEntrySet
+  budgetName
  EntrySet
    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
@ -821,7 +822,7 @@ balancePrimaryEntrySet
      let t0res = resolveAcntAndTags t0
      let fsres = mapErrors resolveAcntAndTags fs
      let tsres = mapErrors resolveAcntAndTags ts
-      let bc = esCurrency
+      let bc = (esCurrency, budgetName)
      combineErrorM (combineError f0res fsres (,)) (combineError t0res tsres (,)) $
        \(f0', fs') (t0', ts') -> do
          let balFrom = fmap liftInnerS . balanceDeferred
@ -830,9 +831,11 @@ balancePrimaryEntrySet

 balanceSecondaryEntrySet
  :: (MonadAppError m, MonadFinance m)
-  => SecondayEntrySet
+  => BudgetName
+  -> SecondayEntrySet
  -> StateT EntryBals m InsertEntrySet
 balanceSecondaryEntrySet
+  budgetName
  EntrySet
    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
@ -849,7 +852,7 @@ balanceSecondaryEntrySet
    where
      entrySum = sum . fmap (eValue . ieEntry)
      balFrom = balanceEntry (fmap liftInnerS . balanceDeferred) bc
-      bc = esCurrency
+      bc = (esCurrency, budgetName)

 balanceFinal
  :: (MonadAppError m)
@ -859,10 +862,10 @@ balanceFinal
  -> Entry AccountRId () TagRId
  -> [Entry AccountRId EntryLink TagRId]
  -> StateT EntryBals m InsertEntrySet
-balanceFinal curID tot fs t0 ts = do
+balanceFinal k@(curID, _) tot fs t0 ts = do
  let fv = V.fromList $ NE.toList $ fmap (eValue . ieEntry) fs
  let balTo = balanceLinked fv
-  ts' <- balanceTotalEntrySet balTo curID tot t0 ts
+  ts' <- balanceTotalEntrySet balTo k tot t0 ts
  return $
    InsertEntrySet
      { iesCurrency = curID
@ -960,18 +963,20 @@ findBalance k e = do
 expandTransfers
  :: (MonadAppError m, MonadFinance m)
  => CommitR
+  -> BudgetName
  -> DaySpan
  -> [PairedTransfer]
  -> m [Tx CommitR]
-expandTransfers tc bounds = fmap concat . mapErrors (expandTransfer tc bounds)
+expandTransfers tc name bounds = fmap concat . mapErrors (expandTransfer tc name bounds)

 expandTransfer
  :: (MonadAppError m, MonadFinance m)
  => CommitR
+  -> BudgetName
  -> DaySpan
  -> PairedTransfer
  -> m [Tx CommitR]
-expandTransfer tc bounds Transfer {transAmounts, transTo, transCurrency, transFrom} = do
+expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, transFrom} = do
  txs <- mapErrors go transAmounts
  return $ concat txs
  where
@ -992,9 +997,13 @@ expandTransfer tc bounds Transfer {transAmounts, transTo, transCurrency, transFr
        withDates bounds pat $ \day ->
          return
            Tx
-              { txMeta = TxMeta day (fromIntegral pri) (TxDesc desc) tc
+              { txCommit = tc
+              , txDate = day
              , txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v''
              , txOther = []
+              , txDescr = TxDesc desc
+              , txBudget = name
+              , txPriority = fromIntegral pri
              }

 entryPair
@ -1041,26 +1050,3 @@ realFracToDecimalP p = realFracToDecimal (unPrecision p)

 roundToP :: Integral i => Precision -> DecimalRaw i -> DecimalRaw i
 roundToP p = roundTo (unPrecision p)
-
-compileRegex :: Bool -> T.Text -> AppExcept (Text, Regex)
-compileRegex groups pat = case res of
-  Right re -> return (pat, re)
-  Left _ -> throwError $ AppException [RegexError pat]
-  where
-    res =
-      compile
-        (blankCompOpt {newSyntax = True})
-        (blankExecOpt {captureGroups = groups})
-        pat
-
-matchMaybe :: T.Text -> Regex -> AppExcept Bool
-matchMaybe q re = case execute re q of
-  Right res -> return $ isJust res
-  Left _ -> throwError $ AppException [RegexError "this should not happen"]
-
-matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
-matchGroupsMaybe q re = case regexec re q of
-  Right Nothing -> []
-  Right (Just (_, _, _, xs)) -> xs
-  -- this should never fail as regexec always returns Right
-  Left _ -> []