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 :: Parser Mode
-sync_ =
+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,126 +278,54 @@ 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) ->
-        { toDate :
+        { Type =
-            {-
+            { toDate :
-            Column title for date
+                {-
-            -}
+                Column title for date
-            Text
+                -}
-        , toAmount :
+                Text
-            {-
+            , toAmount :
-            Column title for amount
+                {-
-            -}
+                Column title for amount
-            TxAmountSpec_ re
+                -}
-        , toDesc :
+                Text
-            {-
+            , toDesc :
-            Column title for description
+                {-
-            -}
+                Column title for description
-            Text
+                -}
-        , toOther :
+                Text
-            {-
+            , toOther :
-            Titles of other columns to include; these will be available in
+                {-
-            a map for use in downstream processing (see 'Field')
+                Titles of other columns to include; these will be available in
-            -}
+                a map for use in downstream processing (see 'Field')
-            List Text
+                -}
-        , toDateFmt :
+                List Text
-            {-
+            , toDateFmt :
-            Format of the date field as specified in the
+                {-
-            Data.Time.Format.formattime Haskell function.
+                Format of the date field as specified in the
-            -}
+                Data.Time.Format.formattime Haskell function.
-            Text
+                -}
-        , toSkipBlankDate :
+                Text
-            {-
+            , toAmountFmt :
-            Skip line if date field is a blank
+                {- Format of the amount field. Must include three fields for the
-            -}
+                sign, numerator, and denominator of the amount.
-            Bool
+                -}
-        , toSkipBlankAmount :
+                re
-            {-
+            }
-            Skip line if amount field(s) is(are) a blank
+        , default =
-            -}
+          { toDate = "Date"
-            Bool
+          , toAmount = "Amount"
-        , toSkipBlankDescription :
+          , toDesc = "Description"
-            {-
+          , toOther = [] : List Text
-            Skip line if description field is a blank
+          , toDateFmt = "%0m/%0d/%Y"
-            -}
+          , toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
-            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
        }
-let TxAmountSpec = TxAmountSpec_ Text
+let TxOpts = TxOpts_ Text
 let TxOpts =
      { Type = TxOpts_ Text
      , default =
        { toDate = "Date"
        , toAmount = TxAmountSpec.AmountSingle TxAmount1::{=}
        , toDesc = "Description"
        , toOther = [] : List Text
        , toDateFmt = "%0m/%0d/%Y"
        , toSkipBlankDate = False
        , toSkipBlankAmount = False
        , toSkipBlankDescription = False
        , toSkipBlankOther = [] : List Text
        , toSkipMissingFields = False
        }
      }
 let Field =
    {-
@ -1056,40 +984,54 @@ 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 =
-        { Type = { amPat : re, amInvert : Bool }, default.amInvert = False }
+          { 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) ->
+      { Type =
-        { tmFrom : Optional (AcntMatcher_ re).Type
+          { tmFrom :
-        , tmTo : Optional (AcntMatcher_ re).Type
+              {-
-        , tmDate :
+              List of accounts (which may be empty) to match with the
-            {-
+              starting account in a transfer.
-            If given, means to match the date of a transfer.
+              -}
-            -}
+              AcntSet.Type
-            Optional DateMatcher
+          , tmTo :
-        , tmVal :
+              {-
-            {-
+              List of accounts (which may be empty) to match with the
-            If given, means to match the value of a transfer.
+              ending account in a transfer.
-            -}
+              -}
-            ValMatcher.Type
+              AcntSet.Type
-        }
+          , tmDate :
-
+              {-
-let TransferMatcher =
+              If given, means to match the date of a transfer.
-      { Type = TransferMatcher_ Text
+              -}
              Optional DateMatcher
          , tmVal :
              {-
              If given, means to match the value of a transfer.
              -}
              ValMatcher.Type
          }
      , default =
-        { tmFrom = None AcntMatcher.Type
+        { tmFrom = AcntSet.default
-        , tmTo = None AcntMatcher.Type
+        , 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
+readBudget :: (MonadAppError m, MonadFinance m) => Budget -> m [Tx CommitR]
 readBudgetCRUD o@CRUDOps {coCreate} = do
  bs <- mapM readBudget coCreate
  return $ o {coCreate = bs}
 readBudget :: (MonadAppError m, MonadFinance m) => Budget -> m (BudgetName, [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 res1 = mapErrors (readIncome c bgtLabel intAllos budgetSpan) bgtIncomes
-          let res2 = expandTransfers c budgetSpan bgtTransfers
+          let res2 = expandTransfers c bgtLabel budgetSpan bgtTransfers
-          combineErrorM (concat <$> res1) res2 $ \is ts ->
+          txs <- combineError (concat <$> res1) res2 (++)
-            addShadowTransfers bgtShadowTransfers (is ++ ts)
+          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,55 +347,33 @@ fromShadow
  -> ShadowTransfer
  -> m (Maybe ShadowEntrySet)
 fromShadow tx ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stMatch} =
-  combineErrorM curRes mRes $ \cur compiled -> do
+  combineErrorM curRes shaRes $ \cur sha -> do
    res <- liftExcept $ shadowMatches compiled tx
    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
+    curRes = lookupCurrencyKey (CurID stCurrency)
-    mRes = liftExcept $ compileMatch stMatch
+    shaRes = liftExcept $ shadowMatches stMatch tx
-shadowMatches :: TransferMatcherRe -> Tx CommitR -> AppExcept Bool
+shadowMatches :: TransferMatcher -> Tx CommitR -> AppExcept Bool
-shadowMatches
+shadowMatches TransferMatcher {tmFrom, tmTo, tmDate, tmVal} Tx {txPrimary, txDate} = do
-  TransferMatcher_ {tmFrom, tmTo, tmDate, tmVal}
+  -- NOTE this will only match against the primary entry set since those
-  Tx {txPrimary, txMeta = TxMeta {txmDate}} =
+  -- are what are guaranteed to exist from a transfer
-    do
+  valRes <- case txPrimary of
-      -- ASSUME these will never fail and thus I don't need to worry about
+    Left es -> valMatches tmVal $ toRational $ esTotalValue es
-      -- stacking the errors
+    Right _ -> return True
-      fromRes <- acntMatches fa tmFrom
+  return $
-      toRes <- acntMatches ta tmTo
+    memberMaybe fa tmFrom
-      -- NOTE this will only match against the primary entry set since those
+      && memberMaybe ta tmTo
-      -- are what are guaranteed to exist from a transfer
+      && maybe True (`dateMatches` txDate) tmDate
-      valRes <- case txPrimary of
+      && valRes
        Left es -> valMatches tmVal $ toRational $ esTotalValue es
        Right _ -> return True
      return $
        fromRes
          && toRes
          && maybe True (`dateMatches` txmDate) tmDate
          && valRes
    where
      fa = either getAcntFrom getAcntFrom txPrimary
      ta = either getAcntTo getAcntTo txPrimary
      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
+    fa = either getAcntFrom getAcntFrom txPrimary
-      (_, p) <- compileRegex False amPat
+    ta = either getAcntTo getAcntTo txPrimary
-      return $ a {amPat = p}
+    getAcntFrom = getAcnt esFrom
-    tres = mapM go tmTo
+    getAcntTo = getAcnt esTo
-    fres = mapM go tmFrom
+    getAcnt f = eAcnt . hesPrimary . f
-
+    memberMaybe x AcntSet {asList, asInclude} =
-- memberMaybe x AcntSet {asList, asInclude} =
+      (if asInclude then id else not) $ x `elem` (AcntID <$> asList)
 --   (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 GHC.Err
 import Internal.History
 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)
+  -> m ConfigState
-readDB c bs hs = do
+readConfigState c bs hs = do
-  curAcnts <- readCurrentIds
+  (acnts2Ins, acntsRem, acnts2Del) <- diff newAcnts
-  curPaths <- readCurrentIds
+  (pathsIns, _, pathsDel) <- diff newPaths
-  curCurs <- readCurrentIds
+  (curs2Ins, cursRem, curs2Del) <- diff newCurs
-  curTags <- readCurrentIds
+  (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 $ curBgts ++ curHistTrs ++ curHistSts
    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
            }
    (bChanged, hChanged) <- readScopeChanged dbempty bscope hscope
-    budgets <- makeBudgetCRUD existing bs curBgts bChanged
+    bgt <- makeTxCRUD existing bs curBgts bChanged
-    history <- makeStatementCRUD existing (ts, curHistTrs) (ss, curHistSts) hChanged
+    hTrans <- makeTxCRUD existing ts curHistTrs hChanged
-    return (meta, txS, budgets, history)
+    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 =
+    diff new = setDiffWith (\a b -> E.entityKey a == b) new <$> readCurrentIds
      let (cs, _, ds) = setDiffWith (\a b -> E.entityKey a == b) new old
       in CRUDOps cs () () ds
    (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.innerJoin` E.table
-        `E.on` (\(_ :& _ :& _ :& e :& t) -> E.just (e ^. EntryRId) ==. t ?. TagRelationREntry)
+        `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
+    rs <- E.from E.table
-    return (commits ^. CommitRHash, commits ^. CommitRType)
+    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
+deleteTxs DeleteTxs {dtTxs, dtEntrySets, dtEntries, dtTagRelations} = do
  mapM_ deleteKeyE dtTagRelations
  mapM_ deleteKeyE dtEntries
  mapM_ deleteKeyE dtEntrySets
  mapM_ deleteKeyE dtTxs
-  mapM_ deleteKeyE dtCommits
+  mapM_ deleteKeyE dtEntrySets
  mapM_ deleteKeyE dtEntries
  mapM_ deleteKeyE dtTagRelations
-- updateDBState :: (MonadFinance m, MonadSqlQuery m) => m ()
+updateDBState :: (MonadFinance m, MonadSqlQuery m) => m ()
-- updateDBState = do
+updateDBState = do
--   updateCD =<< asks csCurrencies
+  updateCD =<< asks csCurrencies
--   updateCD =<< asks csAccounts
+  updateCD =<< asks csAccounts
--   updateCD =<< asks csPaths
+  updateCD =<< asks csPaths
--   updateCD =<< asks csTags
+  updateCD =<< asks csTags
--   -- deleteTxs =<< asks (coDelete . csBudgets)
+  deleteTxs =<< asks (coDelete . csBudgets)
--   -- deleteTxs =<< asks (coDelete . csHistory)
+  deleteTxs =<< asks (coDelete . csHistTrans)
--   b <- asks csBudgetScope
+  deleteTxs =<< asks (coDelete . csHistStmts)
--   h <- asks csHistoryScope
+  b <- asks csBudgetScope
--   repsertE (E.toSqlKey 1) $ ConfigStateR h b
+  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
 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
+  let valid = (cs `S.intersection` as) `S.intersection` ts
-  return $ second (fst <$>) $ L.partition ((`S.member` invalid) . fst) xs
+  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
+    makeUES ((_, day, name, pri, (curID, prec)), es) = do
      let sk = TxSortKey (E.unValue day) (E.unValue pri) (E.unValue desc)
      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
+                  , utBudget = E.unValue name
-                  , utIndex = E.unValue esi
+                  , 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
+                  , utBudget = E.unValue name
-                  , utIndex = E.unValue esi
+                  , utPriority = E.unValue pri
                  }
        -- TODO this error is lame
-        _ -> throwAppError $ DBError DBUpdateUnbalanced
+        _ -> throwAppError $ DBError $ DBUpdateUnbalanced
-    makeRE ((_, esi, day, pri, desc, (curID, prec)), entry) = do
+    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)
+            , reBudget = E.unValue name
-            , reESIndex = E.unValue esi
+            , rePriority = E.unValue pri
            , reIndex = entryRIndex e
            }
 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 TBalance) -> err $ DBLinkInvalidBalance
-  (Nothing, Just TPercent) -> err DBLinkInvalidPercent
+  (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
+insertAll
 --   :: (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
  :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
-  => FinalBudgetCRUD
+  => [EntryCRU]
  -> m ()
-insertBudgets (CRUDOps bs () () ds) = do
+insertAll ebs = do
-  deleteTxs ds
+  (toUpdate, toInsert) <- balanceTxs ebs
  mapM_ go bs
  where
    go (name, cs) = do
      -- TODO useless overhead?
      (toUpdate, toInsert) <- balanceTxs (ToInsert <$> cs)
      mapM_ updateTx toUpdate
      forM_ (groupWith (txmCommit . itxMeta) toInsert) $
        \(c, ts) -> do
          ck <- insert c
          mapM_ (insertTx name 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) $
+  forM_ (groupWith itxCommit toInsert) $
    \(c, ts) -> do
      ck <- insert c
-      mapM_ (insertTx historyName ck) ts
+      mapM_ (insertTx ck) ts
  deleteTxs ds
-- insertAll
+insertTx :: MonadSqlQuery m => CommitRId -> InsertTx -> m ()
--   :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
+insertTx c InsertTx {itxDate, itxDescr, itxEntrySets, itxBudget, itxPriority} = do
--   => BudgetName
+  k <- insert $ TransactionR c itxDate itxDescr itxBudget itxPriority
 --   -> 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
  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)
-
+import Text.Regex.TDFA.Text
 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'}
 -- 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)
+  bounds <- asks (unHSpan . csHistoryScope)
-  expandTransfer c bounds ht
+  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} =
+    c = CommitR (CommitHash $ hash i) CTHistoryStatement
      t {txMeta = m {txmCommit = CommitR (CommitHash $ hash i) CTHistoryStatement}}
 -- TODO this probably won't scale well (pipes?)
-readImport
+readImport :: (MonadUnliftIO m, MonadFinance m) => FilePath -> Statement -> m [Tx ()]
  :: (MonadUnliftIO m, MonadFinance m)
  => FilePath
  -> Statement
  -> m (Either AppException [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
+parseTxRecord p TxOpts {toDate, toAmountFmt, toDesc, toAmount, toOther, toDateFmt} r = do
-  p
+  d <- r .: T.encodeUtf8 toDate
-  TxOpts
+  if d == ""
-    { toDate
+    then return Nothing
-    , toDesc
+    else do
-    , toAmount
+      a <- parseDecimal toAmountFmt =<< r .: T.encodeUtf8 toAmount
-    , toOther
+      e <- r .: T.encodeUtf8 toDesc
-    , toDateFmt
+      os <- M.fromList <$> mapM (\n -> (n,) <$> r .: T.encodeUtf8 n) toOther
-    , toSkipBlankDate
+      d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
-    , toSkipBlankAmount
+      return $ Just $ TxRecord d' a e os p
    , 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)
            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
-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]
+  { mgDate :: ![MatchRe]
-  , mgNoDate :: ![StatementParserRe]
+  , 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
+matches :: MonadFinance m => MatchRe -> TxRecord -> AppExceptT m (MatchRes (Tx ()))
  :: MonadFinance m
  => StatementParserRe
  -> 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
+compileMatch :: StatementParser T.Text -> AppExcept MatchRe
 --   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 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
+compileRegex :: Bool -> T.Text -> AppExcept (Text, Regex)
-parseDecimal wantSign (pat, re) s = case (wantSign, matchGroupsMaybe s re) of
+compileRegex groups pat = case res of
-  (True, [sign, num]) -> do
+  Right re -> return (pat, re)
-    k <- readSign sign
+  Left _ -> throwError $ AppException [RegexError pat]
-    x <- readNum num
+  where
-    return $ k * x
+    res =
-  (False, [num]) -> readNum num
+      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 =
+    readWhole sign x = do
-      maybe
+      w <- readT "whole number" x
-        (msg $ T.unwords ["could not parse", singleQuote x])
+      k <- readSign sign
-        return
+      return (k, w)
-        $ readMaybe
+
-        $ T.unpack
+historyName :: BudgetName
-        $ T.filter (/= ',') x
+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_"
+      "TxOpts"
-      "AcntMatcher_"
+      "TxOpts"
-      "\\(re : Type) -> ((./dhall/Types.dhall).AcntMatcher_ re).Type"
+      "\\(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
+  { bgtLabel :: BudgetName
-  , bgtIncomes :: ![Income]
+  , bgtIncomes :: [Income]
-  , bgtPretax :: ![MultiAllocation PretaxValue]
+  , bgtPretax :: [MultiAllocation PretaxValue]
-  , bgtTax :: ![MultiAllocation TaxValue]
+  , bgtTax :: [MultiAllocation TaxValue]
-  , bgtPosttax :: ![MultiAllocation PosttaxValue]
+  , bgtPosttax :: [MultiAllocation PosttaxValue]
-  , bgtTransfers :: ![PairedTransfer]
+  , bgtTransfers :: [PairedTransfer]
-  , bgtShadowTransfers :: ![ShadowTransfer]
+  , 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 Hashable TransferMatcher
 deriving instance Generic (AcntMatcher_ Text)
 deriving instance Hashable (AcntMatcher_ Text)
 deriving instance FromDhall (AcntMatcher_ Text)
 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
+-- TODO split the entry stuff from the account metadata stuff
-  { mcCurrencies :: !(EntityCRUDOps CurrencyR)
+data ConfigState = ConfigState
-  , mcAccounts :: !(EntityCRUDOps AccountR)
+  { csCurrencies :: !(CDOps (Entity CurrencyR) CurrencyRId)
-  , mcPaths :: !(EntityCRUDOps AccountPathR)
+  , csAccounts :: !(CDOps (Entity AccountR) AccountRId)
-  , mcTags :: !(EntityCRUDOps TagR)
+  , csPaths :: !(CDOps (Entity AccountPathR) AccountPathRId)
-  , mcBudgetScope :: !BudgetSpan
+  , csTags :: !(CDOps (Entity TagR) TagRId)
-  , mcHistoryScope :: !HistorySpan
+  , csBudgets :: !(CRUDOps [Budget] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
-  }
+  , csHistTrans :: !(CRUDOps [PairedTransfer] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
-
+  , csHistStmts :: !(CRUDOps [Statement] [ReadEntry] [Either TotalUpdateEntrySet FullUpdateEntrySet] DeleteTxs)
-type BudgetCRUDOps b = CRUDOps [b] () () DeleteTxs
+  , csAccountMap :: !AccountMap
-
+  , csCurrencyMap :: !CurrencyMap
-type PreBudgetCRUD = BudgetCRUDOps Budget
+  , csTagMap :: !TagMap
-
+  , csBudgetScope :: !BudgetSpan
-type FinalBudgetCRUD = BudgetCRUDOps (BudgetName, [Tx CommitR])
+  , csHistoryScope :: !HistorySpan
 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
  }
  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
+  , reDate :: !Day
-  , reESIndex :: !EntrySetIndex
+  , rePriority :: !Int
-  , reSortKey :: !TxSortKey
+  , 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
+  , utBudget :: !BudgetName
-  , utSortKey :: !TxSortKey
+  , 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 MatchRe = StatementParser (T.Text, Regex)
 type TransferMatcherRe = TransferMatcher_ 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
+    go (ToRead ReadEntry {reCurrency, reAcnt, reValue, reBudget}) = do
-      modify $ mapAdd_ (reAcnt, reCurrency) reValue
+      modify $ mapAdd_ (reAcnt, (reCurrency, reBudget)) reValue
      return Nothing
-    go (ToInsert Tx {txPrimary, txOther, txMeta}) = do
+    go (ToInsert Tx {txPrimary, txOther, txDescr, txCommit, txDate, txBudget, txPriority}) = do
-      e <- either balancePrimaryEntrySet balanceSecondaryEntrySet txPrimary
+      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
+            (balanceSecondaryEntrySet txBudget)
-            (balancePrimaryEntrySet . fromShadow tot)
+            (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
+binDate :: EntryCRU -> (Day, Int)
-- levels of the hierarchy directory and assuming there will be no overlaps.
+binDate (ToRead ReadEntry {reDate, rePriority}) = (reDate, rePriority)
-- First, sort at the transaction level by day, priority, and description as
+binDate (ToInsert Tx {txDate, txPriority}) = (txDate, txPriority)
 -- 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 (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
+      (ftot, fs, tpairs) <- rebalanceDebit bc rs ls
-      ts <- rebalanceCredit utCurrency ftot utTo0 utToUnk utToRO tpairs
+      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)
+  return (t0 {ueValue = StaticValue (-(tot + tval))} : ts)
  modify $ mapAdd_ (t0Acnt, k) t0val
  return (t0 {ueValue = StaticValue t0val} : 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 _ -> []