diff --git a/app/Main.hs b/app/Main.hs
index 666c943..878fc5d 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,13 +2,17 @@
 
 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 Dhall hiding (double, record)
+import qualified Dhall hiding (double, record)
 import Internal.Budget
 import Internal.Database
 import Internal.History
@@ -17,6 +21,7 @@ import Internal.Utils
 import Options.Applicative
 import RIO
 import RIO.FilePath
+-- import qualified RIO.Map as M
 import qualified RIO.Text as T
 
 main :: IO ()
@@ -30,14 +35,26 @@ main = parse =<< execParser o
             <> header "pwncash - your budget, your life"
         )
 
-data Options = Options FilePath Mode
+type ConfigPath = FilePath
+
+type BudgetPath = FilePath
+
+type HistoryPath = FilePath
+
+data Options = Options !ConfigPath !Mode
 
 data Mode
   = Reset
   | DumpCurrencies
   | DumpAccounts
   | DumpAccountKeys
-  | Sync
+  | Sync !SyncOptions
+
+data SyncOptions = SyncOptions
+  { syncBudgets :: ![BudgetPath]
+  , syncHistories :: ![HistoryPath]
+  , syncThreads :: !Int
+  }
 
 configFile :: Parser FilePath
 configFile =
@@ -104,6 +121,35 @@ sync =
         <> short 'S'
         <> help "Sync config to database"
     )
+    <*> syncOptions
+
+syncOptions :: Parser SyncOptions
+syncOptions =
+  SyncOptions
+    <$> many
+      ( strOption
+          ( long "budget"
+              <> short 'b'
+              <> metavar "BUDGET"
+              <> help "path to a budget config"
+          )
+      )
+    <*> many
+      ( strOption
+          ( long "history"
+              <> short 'H'
+              <> metavar "HISTORY"
+              <> help "path to a history config"
+          )
+      )
+    <*> option
+      auto
+      ( long "threads"
+          <> short 't'
+          <> metavar "THREADS"
+          <> value 1
+          <> help "number of threads for syncing"
+      )
 
 parse :: Options -> IO ()
 parse (Options c Reset) = do
@@ -112,7 +158,8 @@ parse (Options c Reset) = do
 parse (Options c DumpAccounts) = runDumpAccounts c
 parse (Options c DumpAccountKeys) = runDumpAccountKeys c
 parse (Options c DumpCurrencies) = runDumpCurrencies c
-parse (Options c Sync) = runSync c
+parse (Options c (Sync SyncOptions {syncBudgets, syncHistories, syncThreads})) =
+  runSync syncThreads c syncBudgets syncHistories
 
 runDumpCurrencies :: MonadUnliftIO m => FilePath -> m ()
 runDumpCurrencies c = do
@@ -150,50 +197,70 @@ runDumpAccountKeys c = do
   ar <- accounts <$> readConfig c
   let ks =
         paths2IDs $
-          fmap (double . fst) $
-            concatMap (t3 . uncurry tree2Records) $
-              flattenAcntRoot ar
+          fmap (double . accountRFullpath . E.entityVal) $
+            fst $
+              indexAcntRoot ar
   mapM_ (uncurry printPair) ks
   where
     printPair i p = do
-      liftIO $ putStrLn $ T.unpack $ T.concat [acntPath2Text p, ": ", i]
-    t3 (_, _, x) = x
+      liftIO $ putStrLn $ T.unpack $ T.concat [acntPath2Text p, ": ", unAcntID i]
     double x = (x, x)
 
-runSync :: FilePath -> IO ()
-runSync c = do
+runSync :: Int -> FilePath -> [FilePath] -> [FilePath] -> IO ()
+runSync threads c bs hs = do
+  setNumCapabilities threads
+  -- putStrLn "reading config"
   config <- readConfig c
-  let (hTs, hSs) = splitHistory $ statements config
+  -- 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 $ do
     -- _ <- askLoggerIO
 
-    -- get the current DB state
-    (state, updates) <- runSqlQueryT pool $ do
+    -- Get the current DB state.
+    state <- runSqlQueryT pool $ do
       runMigration migrateAll
-      liftIOExceptT $ getDBState config
+      liftIOExceptT $ readConfigState config bs' hs'
 
-    -- read desired statements from disk
-    bSs <-
-      flip runReaderT state $
-        catMaybes <$> mapErrorsIO (readHistStmt root) hSs
+    -- 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
+    -- Update the DB.
     runSqlQueryT pool $ withTransaction $ flip runReaderT state $ do
-      let hTransRes = mapErrors insertHistTransfer hTs
-      let bgtRes = mapErrors insertBudget $ budget config
-      updateDBState updates -- TODO this will only work if foreign keys are deferred
+      -- NOTE this must come first (unless we defer foreign keys)
+      updateDBState
       res <- runExceptT $ do
-        mapM_ (uncurry insertHistStmt) bSs
-        combineError hTransRes bgtRes $ \_ _ -> ()
+        (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 (InsertException es) = do
+    err (AppException es) = do
       liftIO $ mapM_ TI.putStrLn $ concatMap showError es
       exitFailure
 
--- showBalances
-
 readConfig :: MonadUnliftIO m => FilePath -> m Config
-readConfig confpath = liftIO $ unfix <$> Dhall.inputFile Dhall.auto confpath
+readConfig = fmap unfix . readDhall
+
+readDhall :: Dhall.FromDhall a => MonadUnliftIO m => FilePath -> m a
+readDhall confpath = liftIO $ Dhall.inputFile Dhall.auto confpath
diff --git a/budget.cabal b/budget.cabal
index aa0f2b3..428696b 100644
--- a/budget.cabal
+++ b/budget.cabal
@@ -75,7 +75,8 @@ library
       ViewPatterns
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields -Werror -O2
   build-depends:
-      base >=4.12 && <10
+      Decimal >=0.5.2
+    , base >=4.12 && <10
     , cassava
     , conduit >=1.3.4.2
     , containers >=0.6.4.1
@@ -144,7 +145,8 @@ executable pwncash
       ViewPatterns
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wpartial-fields -Werror -O2 -threaded
   build-depends:
-      base >=4.12 && <10
+      Decimal >=0.5.2
+    , base >=4.12 && <10
     , budget
     , cassava
     , conduit >=1.3.4.2
diff --git a/dhall/Types.dhall b/dhall/Types.dhall
index 2e584b2..f0b1190 100644
--- a/dhall/Types.dhall
+++ b/dhall/Types.dhall
@@ -278,51 +278,54 @@ let DatePat =
     -}
       < Cron : CronPat.Type | Mod : ModPat.Type >
 
-let TxOpts =
+let TxOpts_ =
     {- Additional metadata to use when parsing a statement -}
-      { Type =
-          { toDate :
-              {-
-              Column title for date
-              -}
-              Text
-          , toAmount :
-              {-
-              Column title for amount
-              -}
-              Text
-          , toDesc :
-              {-
-              Column title for description
-              -}
-              Text
-          , toOther :
-              {-
-              Titles of other columns to include; these will be available in
-              a map for use in downstream processing (see 'Field')
-              -}
-              List Text
-          , toDateFmt :
-              {-
-              Format of the date field as specified in the
-              Data.Time.Format.formattime Haskell function.
-              -}
-              Text
-          , toAmountFmt :
-              {- Format of the amount field. Must include three fields for the
-              sign, numerator, and denominator of the amount.
-              -}
-              Text
+      \(re : Type) ->
+        { Type =
+            { toDate :
+                {-
+                Column title for date
+                -}
+                Text
+            , toAmount :
+                {-
+                Column title for amount
+                -}
+                Text
+            , toDesc :
+                {-
+                Column title for description
+                -}
+                Text
+            , toOther :
+                {-
+                Titles of other columns to include; these will be available in
+                a map for use in downstream processing (see 'Field')
+                -}
+                List Text
+            , toDateFmt :
+                {-
+                Format of the date field as specified in the
+                Data.Time.Format.formattime Haskell function.
+                -}
+                Text
+            , toAmountFmt :
+                {- Format of the amount field. Must include three fields for the
+                sign, numerator, and denominator of the amount.
+                -}
+                re
+            }
+        , default =
+          { toDate = "Date"
+          , toAmount = "Amount"
+          , toDesc = "Description"
+          , toOther = [] : List Text
+          , toDateFmt = "%0m/%0d/%Y"
+          , toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
           }
-      , default =
-        { toDate = "Date"
-        , toAmount = "Amount"
-        , toDesc = "Description"
-        , toOther = [] : List Text
-        , toDateFmt = "%0m/%0d/%Y"
-        , toAmountFmt = "([-+])?([0-9]+)\\.?([0-9]+)?"
         }
-      }
+
+let TxOpts = TxOpts_ Text
 
 let Field =
     {-
@@ -402,9 +405,45 @@ let EntryNumGetter =
 
     LookupN: lookup the value from a field
     ConstN: a constant value
-    AmountN: the value of the 'Amount' column
+    AmountN: the value of the 'Amount' column times a scaling factor
+    BalanceN: the amount required to make the target account reach a balance
+    PercentN: the amount required to make an account reach a given percentage
     -}
-      < LookupN : Text | ConstN : Double | AmountN : Double >
+      < LookupN : Text
+      | ConstN : Double
+      | AmountN : Double
+      | BalanceN : Double
+      | PercentN : Double
+      >
+
+let LinkedNumGetter =
+    {-
+    Means to get a numeric value from another entry
+    -}
+      { Type =
+          { lngIndex :
+              {-
+              Index of the entry to link.
+              -}
+              Natural
+          , lngScale :
+              {-
+              Factor by which to multiply the value of the linked entry.
+              -}
+              Double
+          }
+      , default = { lngScale = 1.0, lngIndex = 0 }
+      }
+
+let LinkedEntryNumGetter =
+    {-
+    Means to get a numeric value from a statement row or another entry getter.
+
+    Linked: a number referring to the entry on the 'from' side of the
+    transaction (with 0 being the primary entry)
+    Getter: a normal getter
+    -}
+      < Linked : LinkedNumGetter.Type | Getter : EntryNumGetter >
 
 let EntryTextGetter =
     {-
@@ -443,7 +482,6 @@ let Entry =
     -}
       \(a : Type) ->
       \(v : Type) ->
-      \(c : Type) ->
       \(t : Type) ->
         { eAcnt :
             {-
@@ -455,11 +493,6 @@ let Entry =
             Pertains to value for this entry.
             -}
             v
-        , eCurrency :
-            {-
-            Pertains to value for this entry.
-            -}
-            c
         , eComment :
             {-
             A short description of this entry (if none, use a blank string)
@@ -474,35 +507,107 @@ let Entry =
 
 let EntryGetter =
     {-
-    Means for getting an entry from a given row in a statement
+    Means for getting an entry from a given row in a statement (debit side)
+    -}
+      \(n : Type) ->
+        { Type = Entry EntryAcntGetter n TagID
+        , default = { eComment = "", eTags = [] : List TagID }
+        }
+
+let FromEntryGetter =
+    {-
+    Means for getting an entry from a given row in a statement (debit side)
+    -}
+      EntryGetter EntryNumGetter
+
+let ToEntryGetter =
+    {-
+    Means for getting an entry from a given row in a statement (credit side)
+    -}
+      EntryGetter LinkedEntryNumGetter
+
+let TxHalfGetter =
+    {-
+    Means of transforming one row in a statement to either the credit or debit
+    half of a transaction
+    -}
+      \(e : Type) ->
+        { Type =
+            { thgAcnt :
+                {-
+                Account from which this transaction will be balanced. The value
+                of the transaction will be assigned to this account unless
+                other entries are specified (see below).
+
+                This account (and its associated entry) will be denoted
+                'primary'.
+                -}
+                EntryAcntGetter
+            , thgEntries :
+                {-
+                Means of getting additional entries from which this transaction
+                will be balanced. If this list is empty, the total value of the
+                transaction will be assigned to the value defined by 'tsgAcnt'.
+                Otherwise, the entries specified here will be added to this side
+                of this transaction, and their sum value will be subtracted from
+                the total value of the transaction and assigned to 'tsgAcnt'.
+
+                This is useful for situations where a particular transaction
+                denotes values that come from multiple subaccounts.
+                -}
+                List e
+            , thgComment :
+                {-
+                Comment for the primary entry
+                -}
+                Text
+            , thgTags :
+                {-
+                Tags for the primary entry
+                -}
+                List TagID
+            }
+        , default =
+          { thgTags = [] : List TagID
+          , thgComment = ""
+          , thgEntries = [] : List e
+          }
+        }
+
+let FromTxHalfGetter = TxHalfGetter FromEntryGetter.Type
+
+let ToTxHalfGetter = TxHalfGetter ToEntryGetter.Type
+
+let TxSubGetter =
+    {-
+    A means for transforming one row in a statement to a transaction
     -}
       { Type =
-          Entry EntryAcntGetter (Optional EntryNumGetter) EntryCurGetter TagID
-      , default = { eValue = None EntryNumGetter, eComment = "" }
+          { tsgValue : EntryNumGetter
+          , tsgCurrency : EntryCurGetter
+          , tsgFrom : (TxHalfGetter FromEntryGetter.Type).Type
+          , tsgTo : (TxHalfGetter ToEntryGetter.Type).Type
+          }
+      , default = { tsgFrom = TxHalfGetter, tsgTo = TxHalfGetter }
       }
 
 let TxGetter =
     {-
     A means for transforming one row in a statement to a transaction
-
-    Note that N-1 entries need to be specified to make a transaction, as the
-    Nth entry will be balanced with the others.
     -}
-      { tgEntries :
-          {-
-          A means of getting entries for this transaction (minimum 1)
-          -}
-          List EntryGetter.Type
-      , tgCurrency :
-          {-
-          Currency against which entries in this transaction will be balanced
-          -}
-          EntryCurGetter
-      , tgAcnt :
-          {-
-          Account in which entries in this transaction will be balanced
-          -}
-          EntryAcntGetter
+      { Type =
+          { tgFrom : (TxHalfGetter FromEntryGetter.Type).Type
+          , tgTo : (TxHalfGetter ToEntryGetter.Type).Type
+          , tgScale : Double
+          , tgCurrency : EntryCurGetter
+          , tgOtherEntries : List TxSubGetter.Type
+          }
+      , default =
+        { tgOtherEntries = [] : List TxSubGetter.Type
+        , tgFrom = TxHalfGetter
+        , tgTo = TxHalfGetter
+        , tgScale = 1.0
+        }
       }
 
 let StatementParser_ =
@@ -542,7 +647,7 @@ let StatementParser_ =
                 a transaction. If none, don't make a transaction (eg 'skip'
                 this row in the statement).
                 -}
-                Optional TxGetter
+                Optional TxGetter.Type
             , spTimes :
                 {-
                 Match at most this many rows; if none there is no limit
@@ -559,7 +664,7 @@ let StatementParser_ =
           , spVal = ValMatcher::{=}
           , spDesc = None Text
           , spOther = [] : List (FieldMatcher_ re)
-          , spTx = None TxGetter
+          , spTx = None TxGetter.Type
           , spTimes = None Natural
           , spPriority = +0
           }
@@ -577,7 +682,29 @@ let Amount =
     -}
       \(w : Type) ->
       \(v : Type) ->
-        { amtWhen : w, amtValue : v, amtDesc : Text }
+        { Type =
+            { amtWhen : w, amtValue : v, amtDesc : Text, amtPriority : Integer }
+        , default.amtPriority = +0
+        }
+
+let TransferType =
+    {-
+    The type of a budget transfer.
+
+    BTFixed: Tranfer a fixed amount
+    BTPercent: Transfer a percent of the source account to destination
+    BTTarget: Transfer an amount such that the destination has a given target
+              value
+    -}
+      < TPercent | TBalance | TFixed >
+
+let TransferValue =
+    {-
+    Means to determine the value of a budget transfer.
+    -}
+      { Type = { tvVal : Double, tvType : TransferType }
+      , default.tvType = TransferType.TFixed
+      }
 
 let Transfer =
     {-
@@ -590,14 +717,24 @@ let Transfer =
         { transFrom : a
         , transTo : a
         , transCurrency : c
-        , transAmounts : List (Amount w v)
+        , transAmounts : List (Amount w v).Type
         }
 
+let TaggedAcnt =
+    {-
+    An account with a tag
+    -}
+      { Type = { taAcnt : AcntID, taTags : List TagID }
+      , default.taTags = [] : List TagID
+      }
+
 let HistTransfer =
     {-
     A manually specified historical transfer
     -}
-      Transfer AcntID CurID DatePat Double
+      Transfer TaggedAcnt.Type CurID DatePat TransferValue.Type
+
+let TransferAmount = Amount DatePat TransferValue.Type
 
 let Statement =
     {-
@@ -634,44 +771,6 @@ let History =
     -}
       < HistTransfer : HistTransfer | HistStatement : Statement >
 
-let Exchange =
-    {-
-    A currency exchange.
-    -}
-      { xFromCur :
-          {-
-          Starting currency of the exchange.
-          -}
-          CurID
-      , xToCur :
-          {-
-          Ending currency of the exchange.
-          -}
-          CurID
-      , xAcnt :
-          {-
-          account in which the exchange will be documented.
-          -}
-          AcntID
-      , xRate :
-          {-
-          The exchange rate between the currencies.
-          -}
-          Double
-      }
-
-let BudgetCurrency =
-    {-
-    A 'currency' in the budget; either a fixed currency or an exchange
-    -}
-      < NoX : CurID | X : Exchange >
-
-let TaggedAcnt =
-    {-
-    An account with a tag
-    -}
-      { taAcnt : AcntID, taTags : List TagID }
-
 let Allocation =
     {-
     How to allocate a given budget stream. This can be thought of as a Transfer
@@ -679,12 +778,7 @@ let Allocation =
     -}
       \(w : Type) ->
       \(v : Type) ->
-        { alloTo : TaggedAcnt
-        , alloAmts : List (Amount w v)
-        , alloCur :
-            {-TODO allow exchanges here-}
-            CurID
-        }
+        { alloTo : TaggedAcnt.Type, alloAmts : List (Amount w v).Type }
 
 let PretaxValue =
     {-
@@ -779,6 +873,8 @@ let SingleAllocation =
     -}
       Allocation {}
 
+let SingleAlloAmount = \(v : Type) -> Amount {} v
+
 let MultiAllocation =
     {-
     An allocation specialized to capturing multiple income streams within a given
@@ -787,6 +883,8 @@ let MultiAllocation =
     -}
       Allocation Interval
 
+let MultiAlloAmount = \(v : Type) -> Amount Interval v
+
 let HourlyPeriod =
     {-
     Definition for a pay period denominated in hours
@@ -869,18 +967,20 @@ let Income =
               This must be an income AcntID, and is the only place income
               accounts may be specified in the entire budget.
               -}
-              TaggedAcnt
+              TaggedAcnt.Type
           , incToBal :
               {-
               The account to which to send the remainder of the income stream
               (if any) after all allocations have been applied.
               -}
-              TaggedAcnt
+              TaggedAcnt.Type
+          , incPriority : Integer
           }
       , default =
         { incPretax = [] : List (SingleAllocation PretaxValue)
         , incTaxes = [] : List (SingleAllocation TaxValue)
         , incPosttaxx = [] : List (SingleAllocation PosttaxValue)
+        , incPriority = +0
         }
       }
 
@@ -937,17 +1037,6 @@ let TransferMatcher =
         }
       }
 
-let BudgetTransferType =
-    {-
-    The type of a budget transfer.
-
-    BTFixed: Tranfer a fixed amount
-    BTPercent: Transfer a percent of the source account to destination
-    BTTarget: Transfer an amount such that the destination has a given target
-              value
-    -}
-      < BTPercent | BTTarget | BTFixed >
-
 let ShadowTransfer =
     {-
     A transaction analogous to another transfer with given properties.
@@ -956,17 +1045,17 @@ let ShadowTransfer =
           {-
           Source of this transfer
           -}
-          TaggedAcnt
+          TaggedAcnt.Type
       , stTo :
           {-
           Destination of this transfer.
           -}
-          TaggedAcnt
+          TaggedAcnt.Type
       , stCurrency :
           {-
           Currency of this transfer.
           -}
-          BudgetCurrency
+          CurID
       , stDesc :
           {-
           Description of this transfer.
@@ -980,7 +1069,7 @@ let ShadowTransfer =
           specified in other fields of this type.
           -}
           TransferMatcher.Type
-      , stType : BudgetTransferType
+      , stType : TransferType
       , stRatio :
           {-
           Fixed multipler to translate value of matched transfer to this one.
@@ -988,17 +1077,11 @@ let ShadowTransfer =
           Double
       }
 
-let BudgetTransferValue =
-    {-
-    Means to determine the value of a budget transfer.
-    -}
-      { btVal : Double, btType : BudgetTransferType }
-
 let BudgetTransfer =
     {-
     A manually specified transaction for a budget
     -}
-      Transfer TaggedAcnt BudgetCurrency DatePat BudgetTransferValue
+      HistTransfer
 
 let Budget =
     {-
@@ -1040,6 +1123,7 @@ in  { CurID
     , CronPat
     , DatePat
     , TxOpts
+    , TxOpts_
     , StatementParser
     , StatementParser_
     , ValMatcher
@@ -1048,10 +1132,13 @@ in  { CurID
     , FieldMatcher
     , FieldMatcher_
     , EntryNumGetter
+    , LinkedEntryNumGetter
+    , LinkedNumGetter
     , Field
     , FieldMap
     , Entry
-    , EntryGetter
+    , FromEntryGetter
+    , ToEntryGetter
     , EntryTextGetter
     , EntryCurGetter
     , EntryAcntGetter
@@ -1065,9 +1152,8 @@ in  { CurID
     , TransferMatcher
     , ShadowTransfer
     , AcntSet
-    , BudgetCurrency
-    , Exchange
     , TaggedAcnt
+    , AccountTree
     , Account
     , Placeholder
     , PretaxValue
@@ -1076,13 +1162,20 @@ in  { CurID
     , TaxProgression
     , TaxMethod
     , TaxValue
-    , BudgetTransferValue
-    , BudgetTransferType
+    , TransferValue
+    , TransferType
     , TxGetter
+    , TxSubGetter
+    , TxHalfGetter
+    , FromTxHalfGetter
+    , ToTxHalfGetter
     , HistTransfer
     , SingleAllocation
     , MultiAllocation
     , HourlyPeriod
     , Period
     , PeriodType
+    , TransferAmount
+    , MultiAlloAmount
+    , SingleAlloAmount
     }
diff --git a/dhall/common.dhall b/dhall/common.dhall
index b8c96d0..9c1ee71 100644
--- a/dhall/common.dhall
+++ b/dhall/common.dhall
@@ -4,18 +4,10 @@ let List/map =
 
 let T = ./Types.dhall
 
-let nullSplit =
+let nullEntry =
       \(a : T.EntryAcntGetter) ->
-      \(c : T.EntryCurGetter) ->
-        T.EntryGetter::{ eAcnt = a, eCurrency = c, eTags = [] : List T.TagID }
-
-let nullOpts = T.TxOpts::{=}
-
-let nullVal = T.ValMatcher::{=}
-
-let nullMatch = T.StatementParser::{=}
-
-let nullCron = T.CronPat::{=}
+      \(v : T.EntryNumGetter) ->
+        T.FromEntryGetter::{ eAcnt = a, eValue = v }
 
 let nullMod =
       \(by : Natural) ->
@@ -27,21 +19,22 @@ let cron1 =
       \(m : Natural) ->
       \(d : Natural) ->
         T.DatePat.Cron
-          (     nullCron
-            //  { cpYear = Some (T.MDYPat.Single y)
-                , cpMonth = Some (T.MDYPat.Single m)
-                , cpDay = Some (T.MDYPat.Single d)
-                }
-          )
+          T.CronPat::{
+          , cpYear = Some (T.MDYPat.Single y)
+          , cpMonth = Some (T.MDYPat.Single m)
+          , cpDay = Some (T.MDYPat.Single d)
+          }
 
-let matchInf_ = nullMatch
+let matchInf_ = T.StatementParser::{=}
 
-let matchInf = \(x : T.TxGetter) -> nullMatch // { spTx = Some x }
+let matchInf = \(x : T.TxGetter.Type) -> T.StatementParser::{ spTx = Some x }
 
-let matchN_ = \(n : Natural) -> nullMatch // { spTimes = Some n }
+let matchN_ = \(n : Natural) -> T.StatementParser::{ spTimes = Some n }
 
 let matchN =
-      \(n : Natural) -> \(x : T.TxGetter) -> matchInf x // { spTimes = Some n }
+      \(n : Natural) ->
+      \(x : T.TxGetter.Type) ->
+        matchInf x // { spTimes = Some n }
 
 let match1_ = matchN_ 1
 
@@ -86,46 +79,45 @@ let mRngYMD =
       \(r : Natural) ->
         T.DateMatcher.In { _1 = T.YMDMatcher.YMD (greg y m d), _2 = r }
 
-let PartSplit = { _1 : T.AcntID, _2 : Double, _3 : Text }
+let PartEntry = { _1 : T.AcntID, _2 : Double, _3 : Text }
 
-let partN =
-      \(c : T.EntryCurGetter) ->
-      \(a : T.EntryAcntGetter) ->
-      \(comment : Text) ->
-      \(ss : List PartSplit) ->
-        let toSplit =
-              \(x : PartSplit) ->
-                    nullSplit (T.EntryAcntGetter.ConstT x._1) c
-                //  { eValue = Some (T.EntryNumGetter.ConstN x._2)
-                    , eComment = x._3
-                    }
+let partNFrom =
+      \(ss : List PartEntry) ->
+        let toEntry =
+              \(x : PartEntry) ->
+                T.FromEntryGetter::{
+                , eAcnt = T.EntryAcntGetter.ConstT x._1
+                , eValue = T.EntryNumGetter.ConstN x._2
+                , eComment = x._3
+                }
 
-        in    [ nullSplit a c // { eComment = comment } ]
-            # List/map PartSplit T.EntryGetter.Type toSplit ss
+        in  List/map PartEntry T.FromEntryGetter.Type toEntry ss
 
-let part1 =
-      \(c : T.EntryCurGetter) ->
-      \(a : T.EntryAcntGetter) ->
-      \(comment : Text) ->
-        partN c a comment ([] : List PartSplit)
+let partNTo =
+      \(ss : List PartEntry) ->
+        let toEntry =
+              \(x : PartEntry) ->
+                T.ToEntryGetter::{
+                , eAcnt = T.EntryAcntGetter.ConstT x._1
+                , eValue =
+                    T.LinkedEntryNumGetter.Getter (T.EntryNumGetter.ConstN x._2)
+                , eComment = x._3
+                }
 
-let part1_ =
-      \(c : T.EntryCurGetter) ->
-      \(a : T.EntryAcntGetter) ->
-        partN c a "" ([] : List PartSplit)
+        in  List/map PartEntry T.ToEntryGetter.Type toEntry ss
 
 let addDay =
       \(x : T.GregorianM) ->
       \(d : Natural) ->
         { gYear = x.gmYear, gMonth = x.gmMonth, gDay = d }
 
-let mvP = nullVal // { vmSign = Some True }
+let mvP = T.ValMatcher::{ vmSign = Some True }
 
-let mvN = nullVal // { vmSign = Some False }
+let mvN = T.ValMatcher::{ vmSign = Some False }
 
-let mvNum = \(x : Natural) -> nullVal // { vmNum = Some x }
+let mvNum = \(x : Natural) -> T.ValMatcher::{ vmNum = Some x }
 
-let mvDen = \(x : Natural) -> nullVal // { vmDen = Some x }
+let mvDen = \(x : Natural) -> T.ValMatcher::{ vmDen = Some x }
 
 let mvNumP = \(x : Natural) -> mvP // { vmNum = Some x }
 
@@ -135,13 +127,7 @@ let mvDenP = \(x : Natural) -> mvP // { vmDen = Some x }
 
 let mvDenN = \(x : Natural) -> mvN // { vmDen = Some x }
 
-in      { nullSplit
-        , nullMatch
-        , nullVal
-        , nullOpts
-        , nullCron
-        , nullMod
-        , cron1
+in      { cron1
         , mY
         , mYM
         , mYMD
@@ -156,9 +142,8 @@ in      { nullSplit
         , match1
         , greg
         , gregM
-        , partN
-        , part1
-        , part1_
+        , partNFrom
+        , partNTo
         , addDay
         , comma = 44
         , tab = 9
@@ -170,6 +155,8 @@ in      { nullSplit
         , mvDen
         , mvDenP
         , mvDenN
-        , PartSplit
+        , PartEntry
+        , nullEntry
+        , nullMod
         }
     /\  T
diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs
index ec92a72..682dae7 100644
--- a/lib/Internal/Budget.hs
+++ b/lib/Internal/Budget.hs
@@ -1,9 +1,9 @@
-module Internal.Budget (insertBudget) where
+module Internal.Budget (readBudget) where
 
 import Control.Monad.Except
+import Data.Decimal hiding (allocate)
 import Data.Foldable
-import Database.Persist.Monad
-import Internal.Database
+import Data.Hashable
 import Internal.Types.Main
 import Internal.Utils
 import RIO hiding (to)
@@ -13,22 +13,8 @@ import qualified RIO.NonEmpty as NE
 import qualified RIO.Text as T
 import RIO.Time
 
--- each budget (designated at the top level by a 'name') is processed in the
--- following steps
--- 1. expand all transactions given the desired date range and date patterns for
---    each directive in the budget
--- 2. sort all transactions by date
--- 3. propagate all balances forward, and while doing so assign values to each
---    transaction (some of which depend on the 'current' balance of the
---    target account)
--- 4. assign shadow transactions
--- 5. insert all transactions
-
-insertBudget
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => Budget
-  -> m ()
-insertBudget
+readBudget :: (MonadAppError m, MonadFinance m) => Budget -> m [Tx CommitR]
+readBudget
   b@Budget
     { bgtLabel
     , bgtIncomes
@@ -39,15 +25,19 @@ insertBudget
     , bgtPosttax
     , bgtInterval
     } =
-    whenHash CTBudget b () $ \key -> do
-      (intAllos, _) <- combineError intAlloRes acntRes (,)
-      let res1 = mapErrors (insertIncome key bgtLabel intAllos bgtInterval) bgtIncomes
-      let res2 = expandTransfers key bgtLabel bgtInterval bgtTransfers
-      txs <- combineError (concat <$> res1) res2 (++)
-      m <- askDBState kmCurrency
-      shadow <- liftExcept $ addShadowTransfers m bgtShadowTransfers txs
-      void $ mapErrors insertBudgetTx $ balanceTransfers $ txs ++ shadow
+    do
+      spanRes <- getSpan
+      case spanRes of
+        Nothing -> return []
+        Just budgetSpan -> do
+          (intAllos, _) <- combineError intAlloRes acntRes (,)
+          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
       intAlloRes = combineError3 pre_ tax_ post_ (,,)
       pre_ = sortAllos bgtPretax
@@ -58,73 +48,15 @@ insertBudget
         (alloAcnt <$> bgtPretax)
           ++ (alloAcnt <$> bgtTax)
           ++ (alloAcnt <$> bgtPosttax)
+      getSpan = do
+        globalSpan <- asks (unBSpan . csBudgetScope)
+        case bgtInterval of
+          Nothing -> return $ Just globalSpan
+          Just bi -> do
+            localSpan <- liftExcept $ resolveDaySpan bi
+            return $ intersectDaySpan globalSpan localSpan
 
-balanceTransfers :: [UnbalancedTransfer] -> [BalancedTransfer]
-balanceTransfers = snd . L.mapAccumR go M.empty . reverse . L.sortOn ftWhen
-  where
-    go bals f@FlatTransfer {ftFrom, ftTo, ftValue = UnbalancedValue {cvValue, cvType}} =
-      let balTo = M.findWithDefault 0 ftTo bals
-          x = amtToMove balTo cvType cvValue
-          bals' = mapAdd_ ftTo x $ mapAdd_ ftFrom (-x) bals
-       in (bals', f {ftValue = x})
-    -- TODO might need to query signs to make this intuitive; as it is this will
-    -- probably work, but for credit accounts I might need to supply a negative
-    -- target value
-    amtToMove _ BTFixed x = x
-    amtToMove bal BTPercent x = -(x / 100 * bal)
-    amtToMove bal BTTarget x = x - bal
-
--- TODO this seems too general for this module
-mapAdd_ :: (Ord k, Num v) => k -> v -> M.Map k v -> M.Map k v
-mapAdd_ k v = M.alter (maybe (Just v) (Just . (+ v))) k
-
-insertBudgetTx
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => BalancedTransfer
-  -> m ()
-insertBudgetTx FlatTransfer {ftFrom, ftTo, ftMeta, ftCur, ftValue, ftDesc, ftWhen} = do
-  ((sFrom, sTo), exchange) <- entryPair ftFrom ftTo ftCur ftValue
-  insertPair sFrom sTo
-  forM_ exchange $ uncurry insertPair
-  where
-    insertPair from to = do
-      k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc
-      insertBudgetLabel k from
-      insertBudgetLabel k to
-    insertBudgetLabel k entry = do
-      sk <- insertEntry k entry
-      insert_ $ BudgetLabelR sk $ bmName ftMeta
-
-entryPair
-  :: (MonadInsertError m, MonadFinance m)
-  => TaggedAcnt
-  -> TaggedAcnt
-  -> BudgetCurrency
-  -> Rational
-  -> m (EntryPair, Maybe EntryPair)
-entryPair from to cur val = case cur of
-  NoX curid -> (,Nothing) <$> pair curid from to val
-  X Exchange {xFromCur, xToCur, xAcnt, xRate} -> do
-    let middle = TaggedAcnt xAcnt []
-    let res1 = pair xFromCur from middle val
-    let res2 = pair xToCur middle to (val * roundPrecision 3 xRate)
-    combineError res1 res2 $ \a b -> (a, Just b)
-  where
-    pair curid from_ to_ v = do
-      let s1 = entry curid from_ (-v)
-      let s2 = entry curid to_ v
-      combineError s1 s2 (,)
-    entry c TaggedAcnt {taAcnt, taTags} v =
-      resolveEntry $
-        Entry
-          { eAcnt = taAcnt
-          , eValue = v
-          , eComment = ""
-          , eCurrency = c
-          , eTags = taTags
-          }
-
-sortAllo :: MultiAllocation v -> InsertExcept (DaySpanAllocation v)
+sortAllo :: MultiAllocation v -> AppExcept (DaySpanAllocation v)
 sortAllo a@Allocation {alloAmts = as} = do
   bs <- foldSpan [] $ L.sortOn amtWhen as
   return $ a {alloAmts = reverse bs}
@@ -143,100 +75,107 @@ sortAllo a@Allocation {alloAmts = as} = do
 -- TODO this will scan the interval allocations fully each time
 -- iteration which is a total waste, but the fix requires turning this
 -- loop into a fold which I don't feel like doing now :(
-insertIncome
-  :: (MonadInsertError m, MonadFinance m)
-  => CommitRId
-  -> T.Text
+readIncome
+  :: (MonadAppError m, MonadFinance m)
+  => CommitR
+  -> BudgetName
   -> IntAllocations
-  -> Maybe Interval
+  -> DaySpan
   -> Income
-  -> m [UnbalancedTransfer]
-insertIncome
+  -> m [Tx CommitR]
+readIncome
   key
   name
   (intPre, intTax, intPost)
-  localInterval
+  ds
   Income
     { incWhen
     , incCurrency
-    , incFrom
+    , incFrom = TaggedAcnt {taAcnt = srcAcnt, taTags = srcTags}
     , incPretax
     , incPosttax
     , incTaxes
-    , incToBal
+    , incToBal = TaggedAcnt {taAcnt = destAcnt, taTags = destTags}
     , incGross
     , incPayPeriod
+    , incPriority
     } =
     combineErrorM
       (combineError incRes nonIncRes (,))
-      (combineError precRes dayRes (,))
-      $ \_ (precision, days) -> do
-        let gross = roundPrecision precision incGross
-        concat <$> foldDays (allocate precision gross) start days
+      (combineError cpRes dayRes (,))
+      $ \_ (cp, days) -> do
+        let gross = realFracToDecimalP (cpPrec cp) incGross
+        foldDays (allocate cp gross) start days
     where
-      incRes = isIncomeAcnt $ taAcnt incFrom
+      srcAcnt' = AcntID srcAcnt
+      destAcnt' = AcntID destAcnt
+      incRes = isIncomeAcnt srcAcnt'
       nonIncRes =
         mapErrors isNotIncomeAcnt $
-          taAcnt incToBal
+          destAcnt'
             : (alloAcnt <$> incPretax)
             ++ (alloAcnt <$> incTaxes)
             ++ (alloAcnt <$> incPosttax)
-      precRes = lookupCurrencyPrec incCurrency
-      dayRes = askDays incWhen localInterval
+      cpRes = lookupCurrency incCurrency
+      dayRes = liftExcept $ expandDatePat ds incWhen
       start = fromGregorian' $ pStart incPayPeriod
       pType' = pType incPayPeriod
-      meta = BudgetMeta key name
       flatPre = concatMap flattenAllo incPretax
       flatTax = concatMap flattenAllo incTaxes
       flatPost = concatMap flattenAllo incPosttax
       sumAllos = sum . fmap faValue
-      -- TODO ensure these are all the "correct" accounts
-      allocate precision gross prevDay day = do
+      entry0 a c ts = Entry {eAcnt = a, eValue = (), eComment = c, eTags = ts}
+      allocate cp gross prevDay day = do
         scaler <- liftExcept $ periodScaler pType' prevDay day
+        let precision = cpPrec cp
         let (preDeductions, pre) =
               allocatePre precision gross $
                 flatPre ++ concatMap (selectAllos day) intPre
-            tax =
+        let tax =
               allocateTax precision gross preDeductions scaler $
                 flatTax ++ concatMap (selectAllos day) intTax
             aftertaxGross = gross - sumAllos (tax ++ pre)
-            post =
+        let post =
               allocatePost precision aftertaxGross $
                 flatPost ++ concatMap (selectAllos day) intPost
-            balance = aftertaxGross - sumAllos post
-            bal =
-              FlatTransfer
-                { ftMeta = meta
-                , ftWhen = day
-                , ftFrom = incFrom
-                , ftCur = NoX incCurrency
-                , ftTo = incToBal
-                , ftValue = UnbalancedValue BTFixed balance
-                , ftDesc = "balance after deductions"
+        let src = entry0 srcAcnt' "gross income" (TagID <$> srcTags)
+        let dest = entry0 destAcnt' "balance after deductions" (TagID <$> destTags)
+        let allos = allo2Trans <$> (pre ++ tax ++ post)
+        let primary =
+              EntrySet
+                { esTotalValue = gross
+                , esCurrency = cpID cp
+                , esFrom = HalfEntrySet {hesPrimary = src, hesOther = []}
+                , esTo = HalfEntrySet {hesPrimary = dest, hesOther = allos}
                 }
-         in if balance < 0
-              then throwError $ InsertException [IncomeError day name balance]
-              else return (bal : fmap (allo2Trans meta day incFrom) (pre ++ tax ++ post))
+        return $
+          Tx
+            { txCommit = key
+            , txDate = day
+            , txPrimary = Left primary
+            , txOther = []
+            , txDescr = TxDesc ""
+            , txBudget = name
+            , txPriority = incPriority
+            }
 
 periodScaler
   :: PeriodType
   -> Day
   -> Day
-  -> InsertExcept PeriodScaler
+  -> AppExcept PeriodScaler
 periodScaler pt prev cur = return scale
   where
-    n = fromIntegral $ workingDays wds prev cur
+    n = workingDays wds prev cur
     wds = case pt of
       Hourly HourlyPeriod {hpWorkingDays} -> hpWorkingDays
       Daily ds -> ds
-    scale precision x = case pt of
+    scale prec x = case pt of
       Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
-        fromRational (rnd $ x / fromIntegral hpAnnualHours)
+        realFracToDecimalP prec (x / fromIntegral hpAnnualHours)
           * fromIntegral hpDailyHours
-          * n
-      Daily _ -> x * n / 365.25
-      where
-        rnd = roundPrecision precision
+          * fromIntegral n
+      Daily _ -> realFracToDecimalP prec (x * fromIntegral n / 365.25)
 
 -- ASSUME start < end
 workingDays :: [Weekday] -> Day -> Day -> Natural
@@ -252,7 +191,7 @@ workingDays wds start end = fromIntegral $ daysFull + daysTail
 
 -- ASSUME days is a sorted list
 foldDays
-  :: MonadInsertError m
+  :: MonadAppError m
   => (Day -> Day -> m a)
   -> Day
   -> [Day]
@@ -262,27 +201,27 @@ foldDays f start days = case NE.nonEmpty days of
   Just ds
     | any (start >) ds ->
         throwError $
-          InsertException [PeriodError start $ minimum ds]
+          AppException [PeriodError start $ minimum ds]
     | otherwise ->
         combineErrors $
           snd $
             L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
 
-isIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
+isIncomeAcnt :: (MonadAppError m, MonadFinance m) => AcntID -> m ()
 isIncomeAcnt = checkAcntType IncomeT
 
-isNotIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
+isNotIncomeAcnt :: (MonadAppError m, MonadFinance m) => AcntID -> m ()
 isNotIncomeAcnt = checkAcntTypes (AssetT :| [EquityT, ExpenseT, LiabilityT])
 
 checkAcntType
-  :: (MonadInsertError m, MonadFinance m)
+  :: (MonadAppError m, MonadFinance m)
   => AcntType
   -> AcntID
   -> m ()
 checkAcntType t = checkAcntTypes (t :| [])
 
 checkAcntTypes
-  :: (MonadInsertError m, MonadFinance m)
+  :: (MonadAppError m, MonadFinance m)
   => NE.NonEmpty AcntType
   -> AcntID
   -> m ()
@@ -290,83 +229,70 @@ checkAcntTypes ts i = void $ go =<< lookupAccountType i
   where
     go t
       | t `L.elem` ts = return i
-      | otherwise = throwError $ InsertException [AccountError i ts]
+      | otherwise = throwError $ AppException [AccountTypeError i ts]
 
 flattenAllo :: SingleAllocation v -> [FlatAllocation v]
-flattenAllo Allocation {alloAmts, alloCur, alloTo} = fmap go alloAmts
+flattenAllo Allocation {alloAmts, alloTo} = fmap go alloAmts
   where
     go Amount {amtValue, amtDesc} =
       FlatAllocation
-        { faCur = NoX alloCur
-        , faTo = alloTo
+        { faTo = alloTo
         , faValue = amtValue
         , faDesc = amtDesc
         }
 
 -- ASSUME allocations are sorted
 selectAllos :: Day -> DaySpanAllocation v -> [FlatAllocation v]
-selectAllos day Allocation {alloAmts, alloCur, alloTo} =
+selectAllos day Allocation {alloAmts, alloTo} =
   go <$> filter ((`inDaySpan` day) . amtWhen) alloAmts
   where
     go Amount {amtValue, amtDesc} =
       FlatAllocation
-        { faCur = NoX alloCur
-        , faTo = alloTo
+        { faTo = alloTo
         , faValue = amtValue
         , faDesc = amtDesc
         }
 
-allo2Trans
-  :: BudgetMeta
-  -> Day
-  -> TaggedAcnt
-  -> FlatAllocation Rational
-  -> UnbalancedTransfer
-allo2Trans meta day from FlatAllocation {faValue, faTo, faDesc, faCur} =
-  FlatTransfer
-    { ftMeta = meta
-    , ftWhen = day
-    , ftFrom = from
-    , ftCur = faCur
-    , ftTo = faTo
-    , ftValue = UnbalancedValue BTFixed faValue
-    , ftDesc = faDesc
+allo2Trans :: FlatAllocation Decimal -> Entry AcntID EntryLink TagID
+allo2Trans FlatAllocation {faValue, faTo = TaggedAcnt {taAcnt, taTags}, faDesc} =
+  Entry
+    { eValue = LinkValue (EntryFixed faValue)
+    , eComment = faDesc
+    , eAcnt = AcntID taAcnt
+    , eTags = TagID <$> taTags
     }
 
+type PreDeductions = M.Map T.Text Decimal
+
 allocatePre
-  :: Natural
-  -> Rational
+  :: Precision
+  -> Decimal
   -> [FlatAllocation PretaxValue]
-  -> (M.Map T.Text Rational, [FlatAllocation Rational])
+  -> (PreDeductions, [FlatAllocation Decimal])
 allocatePre precision gross = L.mapAccumR go M.empty
   where
-    go m f@FlatAllocation {faValue} =
-      let c = preCategory faValue
-          p = preValue faValue
-          v =
-            if prePercent faValue
-              then (roundPrecision 3 p / 100) * gross
-              else roundPrecision precision p
-       in (mapAdd_ c v m, f {faValue = v})
+    go m f@FlatAllocation {faValue = PretaxValue {preCategory, preValue, prePercent}} =
+      let v =
+            if prePercent
+              then gross *. (preValue / 100)
+              else realFracToDecimalP precision preValue
+       in (mapAdd_ preCategory v m, f {faValue = v})
 
 allocateTax
-  :: Natural
-  -> Rational
-  -> M.Map T.Text Rational
+  :: Precision
+  -> Decimal
+  -> PreDeductions
   -> PeriodScaler
   -> [FlatAllocation TaxValue]
-  -> [FlatAllocation Rational]
+  -> [FlatAllocation Decimal]
 allocateTax precision gross preDeds f = fmap (fmap go)
   where
     go TaxValue {tvCategories, tvMethod} =
       let agi = gross - sum (mapMaybe (`M.lookup` preDeds) tvCategories)
        in case tvMethod of
-            TMPercent p ->
-              roundPrecision precision $
-                fromRational $
-                  roundPrecision 3 p / 100 * agi
+            TMPercent p -> agi *. p / 100
             TMBracket TaxProgression {tpDeductible, tpBrackets} ->
-              let taxDed = roundPrecision precision $ f precision tpDeductible
+              let taxDed = f precision tpDeductible
                in foldBracket f precision (agi - taxDed) tpBrackets
 
 -- | Compute effective tax percentage of a bracket
@@ -380,174 +306,80 @@ allocateTax precision gross preDeds f = fmap (fmap go)
 --
 -- In reality, this can all be done with one loop, but it isn't clear these
 -- three steps are implemented from this alone.
-foldBracket :: PeriodScaler -> Natural -> Rational -> [TaxBracket] -> Rational
-foldBracket f precision agi bs = fst $ foldr go (0, agi) $ L.sortOn tbLowerLimit bs
+foldBracket :: PeriodScaler -> Precision -> Decimal -> [TaxBracket] -> Decimal
+foldBracket f prec agi bs = fst $ foldr go (0, agi) $ L.sortOn tbLowerLimit bs
   where
     go TaxBracket {tbLowerLimit, tbPercent} a@(acc, remain) =
-      let l = roundPrecision precision $ f precision tbLowerLimit
-          p = roundPrecision 3 tbPercent / 100
-       in if remain >= l then (acc + p * (remain - l), l) else a
+      let l = f prec tbLowerLimit
+       in if remain >= l
+            then (acc + (remain - l) *. (tbPercent / 100), l)
+            else a
 
 allocatePost
-  :: Natural
-  -> Rational
+  :: Precision
+  -> Decimal
   -> [FlatAllocation PosttaxValue]
-  -> [FlatAllocation Rational]
-allocatePost precision aftertax = fmap (fmap go)
+  -> [FlatAllocation Decimal]
+allocatePost prec aftertax = fmap (fmap go)
   where
-    go PosttaxValue {postValue, postPercent} =
-      let v = postValue
-       in if postPercent
-            then aftertax * roundPrecision 3 v / 100
-            else roundPrecision precision v
-
---------------------------------------------------------------------------------
--- Standalone Transfer
-
-expandTransfers
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => CommitRId
-  -> T.Text
-  -> Maybe Interval
-  -> [BudgetTransfer]
-  -> m [UnbalancedTransfer]
-expandTransfers key name localInterval ts = do
-  txs <-
-    fmap (L.sortOn ftWhen . concat) $
-      combineErrors $
-        fmap (expandTransfer key name) ts
-  case localInterval of
-    Nothing -> return txs
-    Just i -> do
-      bounds <- liftExcept $ resolveDaySpan i
-      return $ filter (inDaySpan bounds . ftWhen) txs
-
-expandTransfer
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => CommitRId
-  -> T.Text
-  -> BudgetTransfer
-  -> m [UnbalancedTransfer]
-expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} = do
-  precision <- lookupCurrencyPrec $ initialCurrency transCurrency
-  fmap concat $ combineErrors $ fmap (go precision) transAmounts
-  where
-    go
-      precision
-      Amount
-        { amtWhen = pat
-        , amtValue = BudgetTransferValue {btVal = v, btType = y}
-        , amtDesc = desc
-        } =
-        withDates pat $ \day -> do
-          let meta = BudgetMeta {bmCommit = key, bmName = name}
-          return
-            FlatTransfer
-              { ftMeta = meta
-              , ftWhen = day
-              , ftCur = transCurrency
-              , ftFrom = transFrom
-              , ftTo = transTo
-              , ftValue = UnbalancedValue y $ roundPrecision precision v
-              , ftDesc = desc
-              }
-
-withDates
-  :: (MonadSqlQuery m, MonadFinance m, MonadInsertError m)
-  => DatePat
-  -> (Day -> m a)
-  -> m [a]
-withDates dp f = do
-  bounds <- askDBState kmBudgetInterval
-  days <- liftExcept $ expandDatePat bounds dp
-  combineErrors $ fmap f days
+    go PosttaxValue {postValue, postPercent}
+      | postPercent = aftertax *. (postValue / 100)
+      | otherwise = realFracToDecimalP prec postValue
 
 --------------------------------------------------------------------------------
 -- shadow transfers
 
 -- TODO this is going to be O(n*m), which might be a problem?
 addShadowTransfers
-  :: CurrencyMap
-  -> [ShadowTransfer]
-  -> [UnbalancedTransfer]
-  -> InsertExcept [UnbalancedTransfer]
-addShadowTransfers cm ms txs =
-  fmap catMaybes $
-    combineErrors $
-      fmap (uncurry (fromShadow cm)) $
-        [(t, m) | t <- txs, m <- ms]
+  :: (MonadAppError m, MonadFinance m)
+  => [ShadowTransfer]
+  -> [Tx CommitR]
+  -> m [Tx CommitR]
+addShadowTransfers ms = mapErrors go
+  where
+    go tx = do
+      es <- catMaybes <$> mapErrors (fromShadow tx) ms
+      return $ tx {txOther = Right <$> es}
 
 fromShadow
-  :: CurrencyMap
-  -> UnbalancedTransfer
+  :: (MonadAppError m, MonadFinance m)
+  => Tx CommitR
   -> ShadowTransfer
-  -> InsertExcept (Maybe UnbalancedTransfer)
-fromShadow cm tx t@ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stType} = do
-  res <- shadowMatches (stMatch t) tx
-  v <- roundPrecisionCur (initialCurrency stCurrency) cm stRatio
-  return $
-    if not res
-      then Nothing
-      else
-        Just $
-          FlatTransfer
-            { ftMeta = ftMeta tx
-            , ftWhen = ftWhen tx
-            , ftCur = stCurrency
-            , ftFrom = stFrom
-            , ftTo = stTo
-            , ftValue = UnbalancedValue stType $ v * cvValue (ftValue tx)
-            , ftDesc = stDesc
-            }
+  -> m (Maybe ShadowEntrySet)
+fromShadow tx ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stMatch} =
+  combineErrorM curRes shaRes $ \cur sha -> do
+    let es = entryPair stFrom stTo cur stDesc stRatio ()
+    return $ if not sha then Nothing else Just es
+  where
+    curRes = lookupCurrencyKey (CurID stCurrency)
+    shaRes = liftExcept $ shadowMatches stMatch tx
 
-shadowMatches :: TransferMatcher -> UnbalancedTransfer -> InsertExcept Bool
-shadowMatches TransferMatcher {tmFrom, tmTo, tmDate, tmVal} tx = do
-  valRes <- valMatches tmVal $ cvValue $ ftValue tx
+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 $
-    memberMaybe (taAcnt $ ftFrom tx) tmFrom
-      && memberMaybe (taAcnt $ ftTo tx) tmTo
-      && maybe True (`dateMatches` ftWhen tx) tmDate
+    memberMaybe fa tmFrom
+      && memberMaybe ta tmTo
+      && maybe True (`dateMatches` txDate) tmDate
       && valRes
   where
+    fa = either getAcntFrom getAcntFrom txPrimary
+    ta = either getAcntTo getAcntTo txPrimary
+    getAcntFrom = getAcnt esFrom
+    getAcntTo = getAcnt esTo
+    getAcnt f = eAcnt . hesPrimary . f
     memberMaybe x AcntSet {asList, asInclude} =
-      (if asInclude then id else not) $ x `elem` asList
+      (if asInclude then id else not) $ x `elem` (AcntID <$> asList)
 
 --------------------------------------------------------------------------------
 -- random
 
-initialCurrency :: BudgetCurrency -> CurID
-initialCurrency (NoX c) = c
-initialCurrency (X Exchange {xFromCur = c}) = c
-
 alloAcnt :: Allocation w v -> AcntID
-alloAcnt = taAcnt . alloTo
-
-data UnbalancedValue = UnbalancedValue
-  { cvType :: !BudgetTransferType
-  , cvValue :: !Rational
-  }
-  deriving (Show)
-
-type UnbalancedTransfer = FlatTransfer UnbalancedValue
-
-type BalancedTransfer = FlatTransfer Rational
-
-data FlatTransfer v = FlatTransfer
-  { ftFrom :: !TaggedAcnt
-  , ftTo :: !TaggedAcnt
-  , ftValue :: !v
-  , ftWhen :: !Day
-  , ftDesc :: !T.Text
-  , ftMeta :: !BudgetMeta
-  , ftCur :: !BudgetCurrency
-  }
-  deriving (Show)
-
-data BudgetMeta = BudgetMeta
-  { bmCommit :: !CommitRId
-  , bmName :: !T.Text
-  }
-  deriving (Show)
+alloAcnt = AcntID . taAcnt . alloTo
 
 type IntAllocations =
   ( [DaySpanAllocation PretaxValue]
@@ -557,14 +389,11 @@ type IntAllocations =
 
 type DaySpanAllocation = Allocation DaySpan
 
-type EntryPair = (KeyEntry, KeyEntry)
-
-type PeriodScaler = Natural -> Double -> Double
+type PeriodScaler = Precision -> Double -> Decimal
 
 data FlatAllocation v = FlatAllocation
   { faValue :: !v
   , faDesc :: !T.Text
   , faTo :: !TaggedAcnt
-  , faCur :: !BudgetCurrency
   }
   deriving (Functor, Show)
diff --git a/lib/Internal/Database.hs b/lib/Internal/Database.hs
index 0f429a1..bb3d737 100644
--- a/lib/Internal/Database.hs
+++ b/lib/Internal/Database.hs
@@ -1,35 +1,38 @@
 module Internal.Database
   ( runDB
+  , readConfigState
   , nukeTables
-  , updateHashes
   , updateDBState
-  , getDBState
   , tree2Records
   , flattenAcntRoot
+  , indexAcntRoot
   , paths2IDs
   , mkPool
-  , whenHash
-  , whenHash_
   , insertEntry
-  , resolveEntry
+  , readUpdates
+  , insertAll
+  , updateTx
   )
 where
 
 import Conduit
 import Control.Monad.Except
 import Control.Monad.Logger
+import Data.Decimal
 import Data.Hashable
-import Database.Esqueleto.Experimental ((==.), (^.))
+import Database.Esqueleto.Experimental ((:&) (..), (==.), (?.), (^.))
 import qualified Database.Esqueleto.Experimental as E
 import Database.Esqueleto.Internal.Internal (SqlSelect)
 import Database.Persist.Monad
 import Database.Persist.Sqlite hiding
-  ( delete
+  ( Statement
+  , delete
   , deleteWhere
   , insert
   , insertKey
   , insert_
   , runMigration
+  , update
   , (==.)
   , (||.)
   )
@@ -37,10 +40,10 @@ import GHC.Err
 import Internal.Types.Main
 import Internal.Utils
 import RIO hiding (LogFunc, isNothing, on, (^.))
-import RIO.List ((\\))
 import qualified RIO.List as L
 import qualified RIO.Map as M
-import qualified RIO.NonEmpty as N
+import qualified RIO.NonEmpty as NE
+import qualified RIO.Set as S
 import qualified RIO.Text as T
 
 runDB
@@ -103,85 +106,192 @@ nukeTables = do
 --     toFullPath path name = T.unwords [unValue @T.Text path, "/", unValue @T.Text name]
 --     toBal = maybe "???" (fmtRational 2) . unValue
 
-hashConfig :: Config -> [Int]
-hashConfig
-  Config_
-    { budget = bs
-    , statements = ss
-    } = (hash <$> bs) ++ (hash <$> ms) ++ (hash <$> ps)
-    where
-      (ms, ps) = partitionEithers $ fmap go ss
-      go (HistTransfer x) = Left x
-      go (HistStatement x) = Right x
+readConfigState
+  :: (MonadAppError m, MonadSqlQuery m)
+  => Config
+  -> [Budget]
+  -> [History]
+  -> 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)
 
-setDiff :: Eq a => [a] -> [a] -> ([a], [a])
--- setDiff = setDiff' (==)
-setDiff as bs = (as \\ bs, bs \\ as)
+  (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
+    let dbempty = null $ curBgts ++ curHistTrs ++ curHistSts
+    (bChanged, hChanged) <- readScopeChanged dbempty bscope hscope
+    bgt <- makeTxCRUD existing bs curBgts bChanged
+    hTrans <- makeTxCRUD existing ts curHistTrs hChanged
+    hStmt <- makeTxCRUD existing ss curHistSts hChanged
 
--- setDiff' :: Eq a => (a -> b -> Bool) -> [a] -> [b] -> ([a], [b])
--- setDiff' f = go []
---   where
---     go inA [] bs     = (inA, bs)
---     go inA as []     = (as ++ inA, [])
---     go inA (a:as) bs = case inB a bs of
---       Just bs' -> go inA as bs'
---       Nothing  -> go (a:inA) as bs
---     inB _ [] = Nothing
---     inB a (b:bs)
---       | f a b = Just bs
---       | otherwise = inB a bs
-
-getDBHashes :: MonadSqlQuery m => m [Int]
-getDBHashes = fmap (commitRHash . entityVal) <$> dumpTbl
-
-nukeDBHash :: MonadSqlQuery m => Int -> m ()
-nukeDBHash h = deleteE $ do
-  c <- E.from E.table
-  E.where_ (c ^. CommitRHash ==. E.val h)
-
-nukeDBHashes :: MonadSqlQuery m => [Int] -> m ()
-nukeDBHashes = mapM_ nukeDBHash
-
-getConfigHashes :: MonadSqlQuery m => Config -> m ([Int], [Int])
-getConfigHashes c = do
-  let ch = hashConfig c
-  dh <- getDBHashes
-  return $ setDiff dh ch
-
-dumpTbl :: (MonadSqlQuery m, PersistEntity r) => m [Entity r]
-dumpTbl = selectE $ E.from E.table
-
-deleteAccount :: MonadSqlQuery m => Entity AccountR -> m ()
-deleteAccount e = deleteE $ do
-  c <- E.from $ E.table @AccountR
-  E.where_ (c ^. AccountRId ==. E.val k)
+    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
-    k = entityKey e
+    (ts, ss) = splitHistory hs
+    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
 
-deleteCurrency :: MonadSqlQuery m => Entity CurrencyR -> m ()
-deleteCurrency e = deleteE $ do
-  c <- E.from $ E.table @CurrencyR
-  E.where_ (c ^. CurrencyRId ==. E.val k)
+readScopeChanged
+  :: (MonadAppError m, MonadSqlQuery m)
+  => Bool
+  -> BudgetSpan
+  -> HistorySpan
+  -> m (Bool, Bool)
+readScopeChanged dbempty bscope hscope = do
+  rs <- dumpTbl
+  -- TODO these errors should only fire when someone messed with the DB
+  case rs of
+    [] -> if dbempty then return (True, True) else throwAppError $ DBError DBShouldBeEmpty
+    [r] -> do
+      let (ConfigStateR h b) = E.entityVal r
+      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
+    (commits :& txs :& ess :& es :& ts) <-
+      E.from
+        $ E.table
+          `E.innerJoin` E.table
+        `E.on` (\(c :& t) -> c ^. CommitRId ==. t ^. TransactionRCommit)
+          `E.innerJoin` E.table
+        `E.on` (\(_ :& t :& es) -> t ^. TransactionRId ==. es ^. EntrySetRTransaction)
+          `E.innerJoin` E.table
+        `E.on` (\(_ :& _ :& es :& e) -> es ^. EntrySetRId ==. e ^. EntryREntryset)
+          `E.innerJoin` E.table
+        `E.on` (\(_ :& _ :& _ :& e :& t) -> e ^. EntryRId ==. t ^. TagRelationREntry)
+    E.where_ $ commits ^. CommitRHash `E.in_` E.valList cs
+    return
+      ( txs ^. TransactionRId
+      , ess ^. EntrySetRId
+      , es ^. EntryRId
+      , ts ^. TagRelationRId
+      )
+  let (txs, ss, es, ts) = L.unzip4 xs
+  return $
+    DeleteTxs
+      { dtTxs = go txs
+      , dtEntrySets = go ss
+      , dtEntries = go es
+      , dtTagRelations = E.unValue <$> ts
+      }
   where
-    k = entityKey e
+    go :: Eq a => [E.Value a] -> [a]
+    go = fmap (E.unValue . NE.head) . NE.group
 
-deleteTag :: MonadSqlQuery m => Entity TagR -> m ()
-deleteTag e = deleteE $ do
-  c <- E.from $ E.table @TagR
-  E.where_ (c ^. TagRId ==. E.val k)
+splitHistory :: [History] -> ([PairedTransfer], [Statement])
+splitHistory = partitionEithers . fmap go
   where
-    k = entityKey e
+    go (HistTransfer x) = Left x
+    go (HistStatement x) = Right x
 
--- TODO slip-n-slide code...
-insertFull
-  :: (PersistRecordBackend r SqlBackend, Typeable r, MonadSqlQuery m)
-  => Entity r
-  -> m ()
-insertFull (Entity k v) = insertKey k v
+makeTagMap :: [Entity TagR] -> TagMap
+makeTagMap = M.fromList . fmap (\e -> (tagRSymbol $ entityVal e, entityKey e))
+
+tag2Record :: Tag -> Entity TagR
+tag2Record t@Tag {tagID, tagDesc} = Entity (toKey t) $ TagR (TagID tagID) tagDesc
 
 currency2Record :: Currency -> Entity CurrencyR
 currency2Record c@Currency {curSymbol, curFullname, curPrecision} =
-  Entity (toKey c) $ CurrencyR curSymbol curFullname (fromIntegral curPrecision)
+  Entity (toKey c) $ CurrencyR (CurID curSymbol) curFullname (fromIntegral curPrecision)
+
+readCurrentIds :: PersistEntity a => MonadSqlQuery m => m [Key a]
+readCurrentIds = fmap (E.unValue <$>) $ selectE $ do
+  rs <- E.from E.table
+  return (rs ^. E.persistIdField)
+
+readCurrentCommits :: MonadSqlQuery m => m ([CommitHash], [CommitHash], [CommitHash])
+readCurrentCommits = do
+  xs <- selectE $ do
+    rs <- E.from E.table
+    return (rs ^. CommitRHash, rs ^. CommitRType)
+  return $ foldr go ([], [], []) xs
+  where
+    go (x, t) (bs, ts, hs) =
+      let y = E.unValue x
+       in case E.unValue t of
+            CTBudget -> (y : bs, ts, hs)
+            CTHistoryTransfer -> (bs, y : ts, hs)
+            CTHistoryStatement -> (bs, ts, y : hs)
+
+setDiffWith :: (a -> b -> Bool) -> [a] -> [b] -> ([a], [(a, b)], [b])
+setDiffWith f = go [] []
+  where
+    go inA inBoth [] bs = (inA, inBoth, bs)
+    go inA inBoth as [] = (as ++ inA, inBoth, [])
+    go inA inBoth (a : as) bs =
+      let (res, bs') = findDelete (f a) bs
+       in case res of
+            Nothing -> go (a : inA) inBoth as bs
+            Just b -> go inA ((a, b) : inBoth) as bs'
+
+findDelete :: (a -> Bool) -> [a] -> (Maybe a, [a])
+findDelete f xs = case break f xs of
+  (ys, []) -> (Nothing, ys)
+  (ys, z : zs) -> (Just z, ys ++ zs)
+
+dumpTbl :: (MonadSqlQuery m, PersistEntity r) => m [Entity r]
+dumpTbl = selectE $ E.from E.table
 
 currencyMap :: [Entity CurrencyR] -> CurrencyMap
 currencyMap =
@@ -189,46 +299,43 @@ currencyMap =
     . fmap
       ( \e ->
           ( currencyRSymbol $ entityVal e
-          , (entityKey e, fromIntegral $ currencyRPrecision $ entityVal e)
+          , CurrencyPrec (entityKey e) $ currencyRPrecision $ entityVal e
           )
       )
 
 toKey :: (ToBackendKey SqlBackend b, Hashable a) => a -> Key b
 toKey = toSqlKey . fromIntegral . hash
 
-tree2Entity :: AcntType -> [T.Text] -> T.Text -> T.Text -> Entity AccountR
-tree2Entity t parents name des =
-  Entity (toSqlKey $ fromIntegral h) $
-    AccountR name (toPath parents) des
-  where
-    p = AcntPath t (reverse (name : parents))
-    h = hash p
-    toPath = T.intercalate "/" . (atName t :) . reverse
+makeAccountEntity :: AccountR -> Entity AccountR
+makeAccountEntity a = Entity (toKey $ accountRFullpath a) a
 
-tree2Records
-  :: AcntType
-  -> AccountTree
-  -> ([Entity AccountR], [AccountPathR], [(AcntPath, (AccountRId, AcntSign, AcntType))])
+makeAccountR :: AcntType -> T.Text -> [T.Text] -> T.Text -> Bool -> AccountR
+makeAccountR atype name parents des = AccountR name path des (accountSign atype)
+  where
+    path = AcntPath atype (reverse $ name : parents)
+
+tree2Records :: AcntType -> AccountTree -> ([Entity AccountR], [Entity AccountPathR])
 tree2Records t = go []
   where
     go ps (Placeholder d n cs) =
-      let e = tree2Entity t (fmap snd ps) n d
-          k = entityKey e
-          (as, aps, ms) = L.unzip3 $ fmap (go ((k, n) : ps)) cs
-          a0 = acnt k n (fmap snd ps) d
-          paths = expand k $ fmap fst ps
-       in (a0 : concat as, paths ++ concat aps, concat ms)
+      let (parentKeys, parentNames) = L.unzip ps
+          a = acnt n parentNames d False
+          k = entityKey a
+          thesePaths = expand k parentKeys
+       in bimap ((a :) . concat) ((thesePaths ++) . concat) $
+            L.unzip $
+              go ((k, n) : ps) <$> cs
     go ps (Account d n) =
-      let e = tree2Entity t (fmap snd ps) n d
-          k = entityKey e
-       in ( [acnt k n (fmap snd ps) d]
-          , expand k $ fmap fst ps
-          , [(AcntPath t $ reverse $ n : fmap snd ps, (k, sign, t))]
-          )
-    toPath = T.intercalate "/" . (atName t :) . reverse
-    acnt k n ps = Entity k . AccountR n (toPath ps)
-    expand h0 hs = (\(h, d) -> AccountPathR h h0 d) <$> zip (h0 : hs) [0 ..]
-    sign = accountSign t
+      let (parentKeys, parentNames) = L.unzip ps
+          a = acnt n parentNames d True
+          k = entityKey a
+       in ([a], expand k parentKeys)
+    expand h0 hs = (\(h, d) -> accountPathRecord h h0 d) <$> zip (h0 : hs) [0 ..]
+    acnt n ps d = makeAccountEntity . makeAccountR t n ps d
+
+accountPathRecord :: Key AccountR -> Key AccountR -> Int -> Entity AccountPathR
+accountPathRecord p c d =
+  Entity (toKey (fromSqlKey p, fromSqlKey c)) $ AccountPathR p c d
 
 paths2IDs :: [(AcntPath, a)] -> [(AcntID, a)]
 paths2IDs =
@@ -236,49 +343,25 @@ paths2IDs =
     . first trimNames
     . L.unzip
     . L.sortOn fst
-    . fmap (first pathList)
-  where
-    pathList (AcntPath t []) = atName t :| []
-    pathList (AcntPath t ns) = N.reverse $ atName t :| ns
+    . fmap (first (NE.reverse . acntPath2NonEmpty))
 
 -- none of these errors should fire assuming that input is sorted and unique
-trimNames :: [N.NonEmpty T.Text] -> [AcntID]
-trimNames = fmap (T.intercalate "_" . reverse) . trimAll 0
+trimNames :: [NonEmpty T.Text] -> [AcntID]
+trimNames = fmap (AcntID . T.intercalate "_") . go []
   where
-    trimAll _ [] = []
-    trimAll i (y : ys) = case L.foldl' (matchPre i) (y, [], []) ys of
-      (a, [], bs) -> reverse $ trim i a : bs
-      (a, as, bs) -> reverse bs ++ trimAll (i + 1) (reverse $ a : as)
-    matchPre i (y, ys, old) new = case (y !? i, new !? i) of
-      (Nothing, Just _) ->
-        case ys of
-          [] -> (new, [], trim i y : old)
-          _ -> err "unsorted input"
-      (Just _, Nothing) -> err "unsorted input"
-      (Nothing, Nothing) -> err "duplicated inputs"
-      (Just a, Just b)
-        | a == b -> (new, y : ys, old)
-        | otherwise ->
-            let next = case ys of
-                  [] -> [trim i y]
-                  _ -> trimAll (i + 1) (reverse $ y : ys)
-             in (new, [], reverse next ++ old)
-    trim i = N.take (i + 1)
-    err msg = errorWithoutStackTrace $ "Import.Database.Ops.hs: " ++ msg
+    go :: [T.Text] -> [NonEmpty T.Text] -> [[T.Text]]
+    go prev = concatMap (go' prev) . groupNonEmpty
+    go' prev (key, rest) = case rest of
+      (_ :| []) -> [key : prev]
+      ([] :| xs) ->
+        let next = key : prev
+            other = go next $ fmap (fromMaybe err . NE.nonEmpty) xs
+         in next : other
+      (x :| xs) -> go (key : prev) $ fmap (fromMaybe err . NE.nonEmpty) (x : xs)
+    err = error "account path list either not sorted or contains duplicates"
 
-(!?) :: N.NonEmpty a -> Int -> Maybe a
-xs !? n
-  | n < 0 = Nothing
-  -- Definition adapted from GHC.List
-  | otherwise =
-      foldr
-        ( \x r k -> case k of
-            0 -> Just x
-            _ -> r (k - 1)
-        )
-        (const Nothing)
-        xs
-        n
+groupNonEmpty :: Ord a => [NonEmpty a] -> [(a, NonEmpty [a])]
+groupNonEmpty = fmap (second (NE.tail <$>)) . groupWith NE.head
 
 flattenAcntRoot :: AccountRoot -> [(AcntType, AccountTree)]
 flattenAcntRoot AccountRoot_ {arIncome, arExpenses, arLiabilities, arAssets, arEquity} =
@@ -288,129 +371,372 @@ flattenAcntRoot AccountRoot_ {arIncome, arExpenses, arLiabilities, arAssets, arE
     ++ ((AssetT,) <$> arAssets)
     ++ ((EquityT,) <$> arEquity)
 
-indexAcntRoot :: AccountRoot -> ([Entity AccountR], [AccountPathR], AccountMap)
-indexAcntRoot r =
-  ( concat ars
-  , concat aprs
-  , M.fromList $ paths2IDs $ concat ms
-  )
+makeAcntMap :: [Entity AccountR] -> AccountMap
+makeAcntMap =
+  M.fromList
+    . paths2IDs
+    . fmap go
+    . filter (accountRLeaf . snd)
+    . fmap (\e -> (E.entityKey e, E.entityVal e))
   where
-    (ars, aprs, ms) = L.unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
+    go (k, v) = let p = accountRFullpath v in (p, (k, apType p))
 
-getDBState
-  :: (MonadInsertError m, MonadSqlQuery m)
-  => Config
-  -> m (DBState, DBUpdates)
-getDBState c = do
-  (del, new) <- getConfigHashes c
-  combineError bi si $ \b s ->
-    ( DBState
-        { kmCurrency = currencyMap cs
-        , kmAccount = am
-        , kmBudgetInterval = b
-        , kmStatementInterval = s
-        , kmTag = tagMap ts
-        , kmNewCommits = new
-        }
-    , DBUpdates
-        { duOldCommits = del
-        , duNewTagIds = ts
-        , duNewAcntPaths = paths
-        , duNewAcntIds = acnts
-        , duNewCurrencyIds = cs
-        }
-    )
+indexAcntRoot :: AccountRoot -> ([Entity AccountR], [Entity AccountPathR])
+indexAcntRoot = bimap concat concat . L.unzip . fmap (uncurry tree2Records) . flattenAcntRoot
+
+updateCD
+  :: ( MonadSqlQuery m
+     , PersistRecordBackend a SqlBackend
+     , PersistRecordBackend b SqlBackend
+     )
+  => CDOps (Entity a) (Key b)
+  -> m ()
+updateCD (CRUDOps cs () () ds) = do
+  mapM_ deleteKeyE ds
+  insertEntityManyE cs
+
+deleteTxs :: MonadSqlQuery m => DeleteTxs -> m ()
+deleteTxs DeleteTxs {dtTxs, dtEntrySets, dtEntries, dtTagRelations} = do
+  mapM_ deleteKeyE dtTxs
+  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 . 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], [(CommitHash, a)])
+readInvalidIds ExistingConfig {ecAccounts, ecCurrencies, ecTags} xs = do
+  rs <- selectE $ do
+    (commits :& _ :& entrysets :& entries :& tags) <-
+      E.from
+        $ E.table
+          `E.innerJoin` E.table
+        `E.on` (\(c :& t) -> c ^. CommitRId ==. t ^. TransactionRCommit)
+          `E.innerJoin` E.table
+        `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 :& r) -> E.just (e ^. EntryRId) ==. r ?. TagRelationREntry)
+    E.where_ $ commits ^. CommitRHash `E.in_` E.valList (fmap fst xs)
+    return
+      ( commits ^. CommitRHash
+      , entrysets ^. EntrySetRCurrency
+      , entries ^. EntryRAccount
+      , tags ?. TagRelationRTag
+      )
+  -- TODO there are faster ways to do this; may/may not matter
+  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 valid = (cs `S.intersection` as) `S.intersection` ts
+  let (a0, _) = first (fst <$>) $ L.partition ((`S.member` valid) . fst) xs
+  return (a0, [])
   where
-    bi = liftExcept $ resolveDaySpan $ budgetInterval $ global c
-    si = liftExcept $ resolveDaySpan $ statementInterval $ global c
-    (acnts, paths, am) = indexAcntRoot $ accounts c
-    cs = currency2Record <$> currencies c
-    ts = toRecord <$> tags c
-    toRecord t@Tag {tagID, tagDesc} = Entity (toKey t) $ TagR tagID tagDesc
-    tagMap = M.fromList . fmap (\e -> (tagRSymbol $ entityVal e, entityKey e))
+    go existing =
+      S.fromList
+        . fmap (E.unValue . fst)
+        . L.filter (all (`S.member` existing) . snd)
+        . groupKey id
 
-updateHashes :: (MonadSqlQuery m) => DBUpdates -> m ()
-updateHashes DBUpdates {duOldCommits} = nukeDBHashes duOldCommits
+readUpdates
+  :: (MonadAppError m, MonadSqlQuery m)
+  => [CommitHash]
+  -> m ([ReadEntry], [Either TotalUpdateEntrySet FullUpdateEntrySet])
+readUpdates hashes = do
+  xs <- selectE $ do
+    (commits :& txs :& entrysets :& entries :& currencies) <-
+      E.from
+        $ E.table @CommitR
+          `E.innerJoin` E.table @TransactionR
+        `E.on` (\(c :& t) -> c ^. CommitRId ==. t ^. TransactionRCommit)
+          `E.innerJoin` E.table @EntrySetR
+        `E.on` (\(_ :& t :& es) -> t ^. TransactionRId ==. es ^. EntrySetRTransaction)
+          `E.innerJoin` E.table @EntryR
+        `E.on` (\(_ :& _ :& es :& e) -> es ^. EntrySetRId ==. e ^. EntryREntryset)
+          `E.innerJoin` E.table @CurrencyR
+        `E.on` (\(_ :& _ :& es :& _ :& cur) -> es ^. EntrySetRCurrency ==. cur ^. CurrencyRId)
+    E.where_ $ commits ^. CommitRHash `E.in_` E.valList hashes
+    return
+      ( entrysets ^. EntrySetRRebalance
+      ,
+        (
+          ( entrysets ^. EntrySetRId
+          , txs ^. TransactionRDate
+          , txs ^. TransactionRBudgetName
+          , txs ^. TransactionRPriority
+          ,
+            ( entrysets ^. EntrySetRCurrency
+            , currencies ^. CurrencyRPrecision
+            )
+          )
+        , entries
+        )
+      )
+  let (toUpdate, toRead) = L.partition (E.unValue . fst) xs
+  toUpdate' <- liftExcept $ mapErrors makeUES $ groupKey (\(i, _, _, _, _) -> i) (snd <$> toUpdate)
+  let toRead' = fmap (makeRE . snd) toRead
+  return (toRead', toUpdate')
+  where
+    makeUES ((_, day, name, pri, (curID, prec)), es) = do
+      let prec' = fromIntegral $ E.unValue prec
+      let cur = E.unValue curID
+      let res =
+            bimap NE.nonEmpty NE.nonEmpty $
+              NE.partition ((< 0) . entryRIndex . snd) $
+                NE.sortWith (entryRIndex . snd) $
+                  fmap (\e -> (entityKey e, entityVal e)) es
+      case res of
+        (Just froms, Just tos) -> do
+          let tot = sum $ fmap (entryRValue . snd) froms
+          (from0, fromRO, fromUnkVec) <- splitFrom prec' $ NE.reverse froms
+          (from0', fromUnk, to0, toRO, toUnk) <- splitTo prec' from0 fromUnkVec tos
+          -- TODO WAP (wet ass programming)
+          return $ case from0' of
+            Left x ->
+              Left $
+                UpdateEntrySet
+                  { utDate = E.unValue day
+                  , utCurrency = cur
+                  , utFrom0 = x
+                  , utTo0 = to0
+                  , utFromRO = fromRO
+                  , utToRO = toRO
+                  , utFromUnk = fromUnk
+                  , utToUnk = toUnk
+                  , utTotalValue = realFracToDecimalP prec' tot
+                  , utBudget = E.unValue name
+                  , utPriority = E.unValue pri
+                  }
+            Right x ->
+              Right $
+                UpdateEntrySet
+                  { utDate = E.unValue day
+                  , utCurrency = cur
+                  , utFrom0 = x
+                  , utTo0 = to0
+                  , utFromRO = fromRO
+                  , utToRO = toRO
+                  , utFromUnk = fromUnk
+                  , utToUnk = toUnk
+                  , utTotalValue = ()
+                  , utBudget = E.unValue name
+                  , utPriority = E.unValue pri
+                  }
+        -- TODO this error is lame
+        _ -> throwAppError $ DBError $ DBUpdateUnbalanced
+    makeRE ((_, day, name, pri, (curID, prec)), entry) = do
+      let e = entityVal entry
+       in ReadEntry
+            { reDate = E.unValue day
+            , reCurrency = E.unValue curID
+            , reAcnt = entryRAccount e
+            , reValue = realFracToDecimal (fromIntegral $ E.unValue prec) (entryRValue e)
+            , reBudget = E.unValue name
+            , rePriority = E.unValue pri
+            }
 
-updateTags :: (MonadFinance m, MonadSqlQuery m) => DBUpdates -> m ()
-updateTags DBUpdates {duNewTagIds} = do
-  tags' <- selectE $ E.from $ E.table @TagR
-  let (toIns, toDel) = setDiff duNewTagIds tags'
-  mapM_ deleteTag toDel
-  mapM_ insertFull toIns
+splitFrom
+  :: Precision
+  -> NonEmpty (EntryRId, EntryR)
+  -> AppExcept (Either UEBlank (Either UE_RO UEUnk), [UE_RO], [UEUnk])
+splitFrom prec (f0 :| fs) = do
+  -- ASSUME entries are sorted by index
+  -- TODO combine errors here
+  let f0Res = readDeferredValue prec f0
+  let fsRes = mapErrors (splitDeferredValue prec) fs
+  combineErrorM f0Res fsRes $ \f0' fs' -> do
+    let (ro, unk) = partitionEithers fs'
+    -- let idxVec = V.fromList $ fmap (either (const Nothing) Just) fs'
+    return (f0', ro, unk)
 
-updateAccounts :: (MonadFinance m, MonadSqlQuery m) => DBUpdates -> m ()
-updateAccounts DBUpdates {duNewAcntIds, duNewAcntPaths} = do
-  acnts' <- dumpTbl
-  let (toIns, toDel) = setDiff duNewAcntIds acnts'
-  deleteWhere ([] :: [Filter AccountPathR])
-  mapM_ deleteAccount toDel
-  mapM_ insertFull toIns
-  mapM_ insert duNewAcntPaths
+splitTo
+  :: Precision
+  -> Either UEBlank (Either UE_RO UEUnk)
+  -> [UEUnk]
+  -> NonEmpty (EntryRId, EntryR)
+  -> AppExcept
+      ( Either (UEBlank, [UELink]) (Either UE_RO (UEUnk, [UELink]))
+      , [(UEUnk, [UELink])]
+      , UEBlank
+      , [UE_RO]
+      , [UEUnk]
+      )
+splitTo prec from0 fromUnk (t0 :| ts) = do
+  -- How to split the credit side of the database transaction in 1024 easy
+  -- steps:
+  --
+  -- 1. Split incoming entries (except primary) into those with links and not
+  let (unlinked, linked) = partitionEithers $ fmap splitLinked ts
 
-updateCurrencies :: (MonadFinance m, MonadSqlQuery m) => DBUpdates -> m ()
-updateCurrencies DBUpdates {duNewCurrencyIds} = do
-  curs' <- selectE $ E.from $ E.table @CurrencyR
-  let (toIns, toDel) = setDiff duNewCurrencyIds curs'
-  mapM_ deleteCurrency toDel
-  mapM_ insertFull toIns
+  -- 2. For unlinked entries, split into read-only and unknown entries
+  let unlinkedRes = partitionEithers <$> mapErrors (splitDeferredValue prec) unlinked
 
-updateDBState :: (MonadFinance m, MonadSqlQuery m) => DBUpdates -> m ()
-updateDBState u = do
-  updateHashes u
-  updateTags u
-  updateAccounts u
-  updateCurrencies u
+  -- 3. For linked entries, split into those that link to the primary debit
+  --    entry and not
+  let (linked0, linkedN) = second (groupKey id) $ L.partition ((== 0) . fst) linked
 
-deleteE :: (MonadSqlQuery m) => E.SqlQuery () -> m ()
-deleteE q = unsafeLiftSql "esqueleto-delete" (E.delete q)
+  -- 4. For linked entries that don't link to the primary debit entry, split
+  --    into those that link to an unknown debit entry or not. Those that
+  --    are not will be read-only and those that are will be collected with
+  --    their linked debit entry
+  let linkedRes = zipPaired prec fromUnk linkedN
+
+  -- 5. For entries linked to the primary debit entry, turn them into linked
+  --    entries (lazily only used when needed later)
+  let from0Res = mapErrors (makeLinkUnk . snd) linked0
+
+  combineErrorM3 from0Res linkedRes unlinkedRes $
+    -- 6. Depending on the type of primary debit entry we have, add linked
+    --    entries if it is either an unknown or a blank (to be solved) entry,
+    --    or turn the remaining linked entries to read-only and add to the other
+    --    read-only entries
+    \from0Links (fromUnk', toROLinkedN) (toROUnlinked, toUnk) -> do
+      let (from0', toROLinked0) = case from0 of
+            Left blnk -> (Left (blnk, from0Links), [])
+            Right (Left ro) -> (Right $ Left ro, makeRoUE prec . snd . snd <$> linked0)
+            Right (Right unk) -> (Right $ Right (unk, from0Links), [])
+      return (from0', fromUnk', primary, toROLinked0 ++ toROLinkedN ++ toROUnlinked, toUnk)
+  where
+    primary = uncurry makeUnkUE t0
+    splitLinked t@(_, e) = maybe (Left t) (Right . (,t)) $ entryRCachedLink e
+
+-- | Match linked credit entries with unknown entries, returning a list of
+-- matches and non-matching (read-only) credit entries. ASSUME both lists are
+-- sorted according to index and 'fst' respectively. NOTE the output will NOT be
+-- sorted.
+zipPaired
+  :: Precision
+  -> [UEUnk]
+  -> [(EntryIndex, NonEmpty (EntryRId, EntryR))]
+  -> AppExcept ([(UEUnk, [UELink])], [UE_RO])
+zipPaired prec = go ([], [])
+  where
+    nolinks = ((,[]) <$>)
+    go acc fs [] = return $ first (nolinks fs ++) acc
+    go (facc, tacc) fs ((ti, tls) : ts) = do
+      let (lesser, rest) = L.span ((< ti) . ueIndex) fs
+      links <- NE.toList <$> mapErrors makeLinkUnk tls
+      let (nextLink, fs') = case rest of
+            (r0 : rs)
+              | ueIndex r0 == ti -> (Just (r0, links), rs)
+              | otherwise -> (Nothing, rest)
+            _ -> (Nothing, rest)
+      let acc' = (nolinks lesser ++ facc, tacc)
+      let ros = NE.toList $ makeRoUE prec . snd <$> tls
+      let f = maybe (second (++ ros)) (\u -> first (u :)) nextLink
+      go (f acc') fs' ts
+
+makeLinkUnk :: (EntryRId, EntryR) -> AppExcept UELink
+makeLinkUnk (k, e) =
+  -- TODO error should state that scale must be present for a link in the db
+  maybe
+    (throwAppError $ DBError $ DBLinkError k DBLinkNoScale)
+    (return . makeUE k e . LinkScale)
+    $ fromRational <$> entryRCachedValue e
+
+splitDeferredValue :: Precision -> (EntryRId, EntryR) -> AppExcept (Either UE_RO UEUnk)
+splitDeferredValue prec p@(k, _) = do
+  res <- readDeferredValue prec p
+  case res of
+    Left _ -> throwAppError $ DBError $ DBLinkError k DBLinkNoValue
+    Right x -> return x
+
+readDeferredValue :: Precision -> (EntryRId, EntryR) -> AppExcept (Either UEBlank (Either UE_RO UEUnk))
+readDeferredValue prec (k, e) = case (entryRCachedValue e, entryRCachedType e) of
+  (Nothing, Just TFixed) -> return $ Right $ Left $ makeRoUE prec e
+  (Just v, Just TBalance) -> go $ fmap EVBalance $ makeUE k e $ realFracToDecimalP prec v
+  (Just v, Just TPercent) -> go $ fmap EVPercent $ makeUE k e $ fromRational v
+  (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
+  where
+    go = return . Right . Right
+    err = throwAppError . DBError . DBLinkError k
+
+makeUE :: i -> EntryR -> v -> UpdateEntry i v
+makeUE k e v = UpdateEntry k (entryRAccount e) v (entryRIndex e)
+
+makeRoUE :: Precision -> EntryR -> UpdateEntry () StaticValue
+makeRoUE prec e = makeUE () e $ StaticValue (realFracToDecimalP prec $ entryRValue e)
+
+makeUnkUE :: EntryRId -> EntryR -> UpdateEntry EntryRId ()
+makeUnkUE k e = makeUE k e ()
+
+insertAll
+  :: (MonadAppError m, MonadSqlQuery m, MonadFinance m)
+  => [EntryCRU]
+  -> m ()
+insertAll ebs = do
+  (toUpdate, toInsert) <- balanceTxs ebs
+  mapM_ updateTx toUpdate
+  forM_ (groupWith itxCommit toInsert) $
+    \(c, ts) -> do
+      ck <- insert c
+      mapM_ (insertTx ck) ts
+
+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
+      let fs = NE.toList iesFromEntries
+      let ts = NE.toList iesToEntries
+      let rebalance = any (isJust . ieCached) (fs ++ ts)
+      esk <- insert $ EntrySetR tk iesCurrency i rebalance
+      mapM_ (uncurry (go esk)) $ zip [0 ..] ts ++ zip (negate <$> [1 ..]) fs
+    go k i e = void $ insertEntry k i e
+
+insertEntry :: MonadSqlQuery m => EntrySetRId -> EntryIndex -> InsertEntry -> m EntryRId
+insertEntry
+  k
+  i
+  InsertEntry
+    { ieEntry = Entry {eValue, eTags, eAcnt, eComment}
+    , ieCached
+    } =
+    do
+      ek <- insert $ EntryR k eAcnt eComment (toRational eValue) i cval ctype deflink
+      mapM_ (insert_ . TagRelationR ek) eTags
+      return ek
+    where
+      (cval, ctype, deflink) = case ieCached of
+        (Just (CachedLink x s)) -> (Just (toRational s), Nothing, Just x)
+        (Just (CachedBalance b)) -> (Just (toRational b), Just TBalance, Nothing)
+        (Just (CachedPercent p)) -> (Just (toRational p), Just TPercent, Nothing)
+        Nothing -> (Nothing, Just TFixed, Nothing)
+
+updateTx :: MonadSqlQuery m => UEBalanced -> m ()
+updateTx UpdateEntry {ueID, ueValue} = update ueID [EntryRValue =. v]
+  where
+    v = toRational $ unStaticValue ueValue
+
+repsertE :: (MonadSqlQuery m, PersistRecordBackend r SqlBackend) => Key r -> r -> m ()
+repsertE k r = unsafeLiftSql "esqueleto-repsert" (E.repsert k r)
 
 selectE :: (MonadSqlQuery m, SqlSelect a r) => E.SqlQuery a -> m [r]
 selectE q = unsafeLiftSql "esqueleto-select" (E.select q)
 
-whenHash
-  :: (Hashable a, MonadFinance m, MonadSqlQuery m)
-  => ConfigType
-  -> a
-  -> b
-  -> (CommitRId -> m b)
-  -> m b
-whenHash t o def f = do
-  let h = hash o
-  hs <- askDBState kmNewCommits
-  if h `elem` hs then f =<< insert (CommitR h t) else return def
+deleteKeyE :: (MonadSqlQuery m, PersistRecordBackend a SqlBackend) => Key a -> m ()
+deleteKeyE q = unsafeLiftSql "esqueleto-deleteKey" (E.deleteKey q)
 
-whenHash_
-  :: (Hashable a, MonadFinance m)
-  => ConfigType
-  -> a
-  -> m b
-  -> m (Maybe (CommitR, b))
-whenHash_ t o f = do
-  let h = hash o
-  let c = CommitR h t
-  hs <- askDBState kmNewCommits
-  if h `elem` hs then Just . (c,) <$> f else return Nothing
-
-insertEntry :: MonadSqlQuery m => TransactionRId -> KeyEntry -> m EntryRId
-insertEntry t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do
-  k <- insert $ EntryR t eCurrency eAcnt eComment eValue
-  mapM_ (insert_ . TagRelationR k) eTags
-  return k
-
-resolveEntry :: (MonadInsertError m, MonadFinance m) => BalEntry -> m KeyEntry
-resolveEntry s@Entry {eAcnt, eCurrency, eValue, eTags} = do
-  let aRes = lookupAccountKey eAcnt
-  let cRes = lookupCurrencyKey eCurrency
-  let sRes = lookupAccountSign eAcnt
-  let tagRes = combineErrors $ fmap lookupTag eTags
-  -- TODO correct sign here?
-  -- TODO lenses would be nice here
-  combineError (combineError3 aRes cRes sRes (,,)) tagRes $
-    \(aid, cid, sign) tags ->
-      s
-        { eAcnt = aid
-        , eCurrency = cid
-        , eValue = eValue * fromIntegral (sign2Int sign)
-        , eTags = tags
-        }
+insertEntityManyE :: (MonadSqlQuery m, PersistRecordBackend a SqlBackend) => [Entity a] -> m ()
+insertEntityManyE q = unsafeLiftSql "esqueleto-insertEntityMany" (E.insertEntityMany q)
diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs
index 2b34f0f..fcc8b0a 100644
--- a/lib/Internal/History.hs
+++ b/lib/Internal/History.hs
@@ -1,15 +1,16 @@
 module Internal.History
-  ( splitHistory
-  , insertHistTransfer
-  , readHistStmt
-  , insertHistStmt
+  ( readHistStmt
+  , readHistTransfer
+  , splitHistory
   )
 where
 
 import Control.Monad.Except
 import Data.Csv
-import Database.Persist.Monad
-import Internal.Database
+import Data.Decimal
+import Data.Foldable
+import Data.Hashable
+import GHC.Real
 import Internal.Types.Main
 import Internal.Utils
 import RIO hiding (to)
@@ -20,107 +21,55 @@ import qualified RIO.Map as M
 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
 
-splitHistory :: [History] -> ([HistTransfer], [Statement])
+-- 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
+-- thingy
+splitHistory :: [History] -> ([PairedTransfer], [Statement])
 splitHistory = partitionEithers . fmap go
   where
     go (HistTransfer x) = Left x
     go (HistStatement x) = Right x
 
-insertHistTransfer
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => HistTransfer
-  -> m ()
-insertHistTransfer
-  m@Transfer
-    { transFrom = from
-    , transTo = to
-    , transCurrency = u
-    , transAmounts = amts
-    } = do
-    whenHash CTManual m () $ \c -> do
-      bounds <- askDBState kmStatementInterval
-      let precRes = lookupCurrencyPrec u
-      let go Amount {amtWhen, amtValue, amtDesc} = do
-            let dayRes = liftExcept $ expandDatePat bounds amtWhen
-            (days, precision) <- combineError dayRes precRes (,)
-            let tx day = txPair day from to u (roundPrecision precision amtValue) amtDesc
-            keys <- combineErrors $ fmap tx days
-            mapM_ (insertTx c) keys
-      void $ combineErrors $ fmap go amts
+--------------------------------------------------------------------------------
+-- Transfers
+
+readHistTransfer
+  :: (MonadAppError m, MonadFinance m)
+  => PairedTransfer
+  -> m [Tx CommitR]
+readHistTransfer ht = do
+  bounds <- asks (unHSpan . csHistoryScope)
+  expandTransfer c historyName bounds ht
+  where
+    c = CommitR (CommitHash $ hash ht) CTHistoryTransfer
+
+--------------------------------------------------------------------------------
+-- Statements
 
 readHistStmt
   :: (MonadUnliftIO m, MonadFinance m)
   => FilePath
   -> Statement
-  -> m (Maybe (CommitR, [KeyTx]))
-readHistStmt root i = whenHash_ CTImport i $ do
+  -> m [Tx CommitR]
+readHistStmt root i = do
   bs <- readImport root i
-  bounds <- askDBState kmStatementInterval
-  liftIOExceptT $ mapErrors resolveTx $ filter (inDaySpan bounds . txDate) bs
-
-insertHistStmt :: (MonadSqlQuery m) => CommitR -> [KeyTx] -> m ()
-insertHistStmt c ks = do
-  ck <- insert c
-  mapM_ (insertTx ck) ks
-
---------------------------------------------------------------------------------
--- low-level transaction stuff
-
--- TODO tags here?
-txPair
-  :: (MonadInsertError m, MonadFinance m)
-  => Day
-  -> AcntID
-  -> AcntID
-  -> CurID
-  -> Rational
-  -> T.Text
-  -> m KeyTx
-txPair day from to cur val desc = resolveTx tx
+  bounds <- asks (unHSpan . csHistoryScope)
+  return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = c}) bs
   where
-    split a v =
-      Entry
-        { eAcnt = a
-        , eValue = v
-        , eComment = ""
-        , eCurrency = cur
-        , eTags = []
-        }
-    tx =
-      Tx
-        { txDescr = desc
-        , txDate = day
-        , txEntries = [split from (-val), split to val]
-        }
-
-resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
-resolveTx t@Tx {txEntries = ss} =
-  fmap (\kss -> t {txEntries = kss}) $
-    combineErrors $
-      fmap resolveEntry ss
-
-insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
-insertTx c Tx {txDate = d, txDescr = e, txEntries = ss} = do
-  k <- insert $ TransactionR c d e
-  mapM_ (insertEntry k) ss
-
---------------------------------------------------------------------------------
--- Statements
+    c = CommitR (CommitHash $ hash i) CTHistoryStatement
 
 -- TODO this probably won't scale well (pipes?)
-readImport :: (MonadUnliftIO m, MonadFinance m) => FilePath -> Statement -> m [BalTx]
+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
-  m <- askDBState kmCurrency
-  fromEither $
-    flip runReader m $
-      runExceptT $
-        matchRecords compiledMatches records
+  fromEither =<< runExceptT (matchRecords compiledMatches records)
   where
     paths = (root </>) <$> stmtPaths
 
@@ -133,9 +82,9 @@ readImport_
   -> m [TxRecord]
 readImport_ n delim tns p = do
   res <- tryIO $ BL.readFile p
-  bs <- fromEither $ first (InsertException . (: []) . InsertIOError . showT) res
+  bs <- fromEither $ first (AppException . (: []) . StatementIOError . tshow) res
   case decodeByNameWithP (parseTxRecord p tns) opts $ skip bs of
-    Left m -> throwIO $ InsertException [ParseError $ T.pack m]
+    Left m -> throwIO $ AppException [ParseError $ T.pack m]
     Right (_, v) -> return $ catMaybes $ V.toList v
   where
     opts = defaultDecodeOptions {decDelimiter = fromIntegral delim}
@@ -149,18 +98,18 @@ parseTxRecord p TxOpts {toDate, toAmountFmt, toDesc, toAmount, toOther, toDateFm
   if d == ""
     then return Nothing
     else do
-      a <- parseRational toAmountFmt =<< r .: T.encodeUtf8 toAmount
+      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 :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM [BalTx]
+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_, [], []) -> liftInner $ combineErrors $ fmap balanceTx ms_
-    (_, us, ns) -> throwError $ InsertException [StatementError us ns]
+    (ms_, [], []) -> return ms_
+    (_, us, ns) -> throwError $ AppException [StatementError us ns]
 
 matchPriorities :: [MatchRe] -> [MatchGroup]
 matchPriorities =
@@ -214,9 +163,10 @@ zipperSlice f x = go
         LT -> z
 
 zipperMatch
-  :: Unzipped MatchRe
+  :: MonadFinance m
+  => Unzipped MatchRe
   -> TxRecord
-  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes RawTx)
+  -> AppExceptT m (Zipped MatchRe, MatchRes (Tx ()))
 zipperMatch (Unzipped bs cs as) x = go [] cs
   where
     go _ [] = return (Zipped bs $ cs ++ as, MatchFail)
@@ -230,9 +180,10 @@ zipperMatch (Unzipped bs cs as) x = go [] cs
            in return (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
 
 zipperMatch'
-  :: Zipped MatchRe
+  :: MonadFinance m
+  => Zipped MatchRe
   -> TxRecord
-  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes RawTx)
+  -> AppExceptT m (Zipped MatchRe, MatchRes (Tx ()))
 zipperMatch' z x = go z
   where
     go (Zipped bs (a : as)) = do
@@ -249,7 +200,11 @@ matchDec m = case spTimes m of
   Just n -> Just $ m {spTimes = Just $ n - 1}
   Nothing -> Just m
 
-matchAll :: [MatchGroup] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
+matchAll
+  :: MonadFinance m
+  => [MatchGroup]
+  -> [TxRecord]
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchAll = go ([], [])
   where
     go (matched, unused) gs rs = case (gs, rs) of
@@ -259,13 +214,21 @@ matchAll = go ([], [])
         (ts, unmatched, us) <- matchGroup g rs
         go (ts ++ matched, us ++ unused) gs' unmatched
 
-matchGroup :: MatchGroup -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
+matchGroup
+  :: MonadFinance m
+  => MatchGroup
+  -> [TxRecord]
+  -> 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
   return (md ++ mn, unmatched, filter ((/= Nothing) . spTimes) $ ud ++ un)
 
-matchDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
+matchDates
+  :: MonadFinance m
+  => [MatchRe]
+  -> [TxRecord]
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
@@ -286,7 +249,11 @@ matchDates ms = go ([], [], initZipper ms)
           go (m, u, z') rs
     findDate m r = maybe EQ (`compareDate` trDate r) $ spDate m
 
-matchNonDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([RawTx], [TxRecord], [MatchRe])
+matchNonDates
+  :: MonadFinance m
+  => [MatchRe]
+  -> [TxRecord]
+  -> AppExceptT m ([Tx ()], [TxRecord], [MatchRe])
 matchNonDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
@@ -303,26 +270,246 @@ matchNonDates ms = go ([], [], initZipper ms)
             MatchFail -> (matched, r : unmatched)
        in go (m, u, resetZipper z') rs
 
-balanceTx :: RawTx -> InsertExcept BalTx
-balanceTx t@Tx {txEntries = ss} = do
-  bs <- balanceEntries ss
-  return $ t {txEntries = bs}
+matches :: MonadFinance m => MatchRe -> TxRecord -> AppExceptT m (MatchRes (Tx ()))
+matches
+  StatementParser {spTx, spOther, spVal, spDate, spDesc, spPriority}
+  r@TxRecord {trDate, trAmount, trDesc, trOther} = do
+    res <- liftInner $
+      combineError3 val other desc $
+        \x y z -> x && y && z && date
+    if res
+      then maybe (return MatchSkip) convert spTx
+      else return MatchFail
+    where
+      val = valMatches spVal $ toRational trAmount
+      date = maybe True (`dateMatches` trDate) spDate
+      other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
+      desc = maybe (return True) (matchMaybe (unTxDesc trDesc) . snd) spDesc
+      convert tg = MatchPass <$> toTx (fromIntegral spPriority) tg r
 
-balanceEntries :: [RawEntry] -> InsertExcept [BalEntry]
-balanceEntries ss =
-  fmap concat
-    <$> mapM (uncurry bal)
-    $ groupByKey
-    $ fmap (\s -> (eCurrency s, s)) ss
+toTx :: MonadFinance m => Int -> TxGetter -> TxRecord -> AppExceptT m (Tx ())
+toTx
+  priority
+  TxGetter
+    { tgFrom
+    , tgTo
+    , tgCurrency
+    , tgOtherEntries
+    , tgScale
+    }
+  r@TxRecord {trAmount, trDate, trDesc} = do
+    combineError curRes subRes $ \(cur, f, t) ss ->
+      Tx
+        { txDate = trDate
+        , txDescr = trDesc
+        , txCommit = ()
+        , txPrimary =
+            Left $
+              EntrySet
+                { esTotalValue = roundToP (cpPrec cur) trAmount *. tgScale
+                , esCurrency = cpID cur
+                , esFrom = f
+                , esTo = t
+                }
+        , txOther = Left <$> ss
+        , txBudget = historyName
+        , txPriority = priority
+        }
+    where
+      curRes = do
+        m <- asks csCurrencyMap
+        cur <- liftInner $ resolveCurrency m r tgCurrency
+        let prec = cpPrec cur
+        let fromRes = liftInner $ resolveHalfEntry resolveFromValue prec r () tgFrom
+        let toRes = liftInner $ resolveHalfEntry resolveToValue prec r () tgTo
+        combineError fromRes toRes (cur,,)
+      subRes = mapErrors (resolveSubGetter r) tgOtherEntries
+
+resolveSubGetter
+  :: MonadFinance m
+  => TxRecord
+  -> TxSubGetter
+  -> AppExceptT m SecondayEntrySet
+resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
+  m <- asks csCurrencyMap
+  cur <- liftInner $ resolveCurrency m r tsgCurrency
+  let prec = cpPrec cur
+  let toRes = resolveHalfEntry resolveToValue prec r () tsgTo
+  let valRes = liftInner $ resolveValue prec r tsgValue
+  liftInner $ combineErrorM toRes valRes $ \t v -> do
+    f <- resolveHalfEntry resolveFromValue prec r v tsgFrom
+    return $
+      EntrySet
+        { esTotalValue = ()
+        , esCurrency = cpID cur
+        , esFrom = f
+        , esTo = t
+        }
+
+resolveHalfEntry
+  :: (Precision -> TxRecord -> n -> AppExcept v')
+  -> Precision
+  -> TxRecord
+  -> v
+  -> TxHalfGetter (EntryGetter n)
+  -> AppExcept (HalfEntrySet v v')
+resolveHalfEntry f prec r v TxHalfGetter {thgAcnt, thgComment, thgTags, thgEntries} =
+  combineError acntRes esRes $ \a es ->
+    HalfEntrySet
+      { hesPrimary =
+          Entry
+            { eAcnt = a
+            , eValue = v
+            , eComment = thgComment
+            , eTags = thgTags
+            }
+      , hesOther = es
+      }
   where
-    haeValue s@Entry {eValue = Just v} = Right s {eValue = v}
-    haeValue s = Left s
-    bal cur rss
-      | length rss < 2 = throwError $ InsertException [BalanceError TooFewEntries cur rss]
-      | otherwise = case partitionEithers $ fmap haeValue rss of
-          ([noVal], val) -> return $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val
-          ([], val) -> return val
-          _ -> throwError $ InsertException [BalanceError NotOneBlank cur rss]
+    acntRes = resolveAcnt r thgAcnt
+    esRes = mapErrors (resolveEntry f prec r) thgEntries
 
-groupByKey :: Ord k => [(k, v)] -> [(k, [v])]
-groupByKey = M.toList . M.fromListWith (++) . fmap (second (: []))
+otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> AppExcept Bool
+otherMatches dict m = case m of
+  Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
+  Desc (Field n (_, md)) -> (`matchMaybe` md) =<< lookup_ MatchText n
+  where
+    lookup_ t n = lookupErr (MatchField t) n dict
+
+resolveEntry
+  :: (Precision -> TxRecord -> n -> AppExcept v)
+  -> Precision
+  -> TxRecord
+  -> EntryGetter n
+  -> AppExcept (Entry AcntID v TagID)
+resolveEntry f prec r s@Entry {eAcnt, eValue} =
+  combineError acntRes valRes $ \a v -> s {eAcnt = a, eValue = v}
+  where
+    acntRes = resolveAcnt r eAcnt
+    valRes = f prec r eValue
+
+resolveFromValue :: Precision -> TxRecord -> EntryNumGetter -> AppExcept EntryValue
+resolveFromValue = resolveValue
+
+resolveToValue :: Precision -> TxRecord -> LinkedEntryNumGetter -> AppExcept EntryLink
+resolveToValue _ _ (Linked l) = return $ LinkIndex l
+resolveToValue prec r (Getter g) = LinkValue <$> resolveValue prec r g
+
+resolveValue :: Precision -> TxRecord -> EntryNumGetter -> AppExcept EntryValue
+resolveValue prec TxRecord {trOther, trAmount} s = case s of
+  (LookupN t) -> EntryFixed . go <$> (readDouble =<< lookupErr EntryValField t trOther)
+  (ConstN c) -> return $ EntryFixed $ go c
+  AmountN m -> return $ EntryFixed $ trAmount *. m
+  BalanceN x -> return $ EntryBalance $ go x
+  PercentN x -> return $ EntryPercent x
+  where
+    go = realFracToDecimalP prec
+
+resolveAcnt :: TxRecord -> EntryAcnt -> AppExcept AcntID
+resolveAcnt r e = AcntID <$> resolveEntryField AcntField r (unAcntID <$> e)
+
+resolveCurrency :: CurrencyMap -> TxRecord -> EntryCur -> AppExcept CurrencyPrec
+resolveCurrency m r c = do
+  i <- resolveEntryField CurField r (unCurID <$> c)
+  case M.lookup (CurID i) m of
+    Just k -> return k
+    Nothing -> throwError $ AppException [LookupError (DBKey CurField) i]
+
+resolveEntryField :: EntryIDType -> TxRecord -> EntryTextGetter T.Text -> AppExcept T.Text
+resolveEntryField t TxRecord {trOther = o} s = case s of
+  ConstT p -> return p
+  LookupT f -> lookup_ f o
+  MapT (Field f m) -> do
+    k <- lookup_ f o
+    lookup_ k m
+  Map2T (Field (f1, f2) m) -> do
+    (k1, k2) <- combineError (lookup_ f1 o) (lookup_ f2 o) (,)
+    lookup_ (k1, k2) m
+  where
+    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> AppExcept v
+    lookup_ = lookupErr (EntryIDField t)
+
+readDouble :: T.Text -> AppExcept Double
+readDouble s = case readMaybe $ T.unpack s of
+  Just x -> return x
+  Nothing -> throwError $ AppException [ConversionError s True]
+
+readRational :: T.Text -> AppExcept Rational
+readRational s = case T.split (== '.') s of
+  [x] -> maybe err (return . fromInteger) $ readT x
+  [x, y] -> case (readT x, readT y) of
+    (Just x', Just y') ->
+      let p = 10 ^ T.length y
+          k = if x' >= 0 then 1 else -1
+       in return $ fromInteger x' + k * y' % p
+    _ -> err
+  _ -> err
+  where
+    readT = readMaybe . T.unpack
+    err = throwError $ AppException [ConversionError s False]
+
+compileOptions :: TxOpts T.Text -> AppExcept TxOptsRe
+compileOptions o@TxOpts {toAmountFmt = pat} = do
+  re <- compileRegex True pat
+  return $ o {toAmountFmt = re}
+
+compileMatch :: StatementParser T.Text -> AppExcept MatchRe
+compileMatch m@StatementParser {spDesc, spOther} = do
+  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
+  where
+    go = compileRegex False
+    dres = mapM go spDesc
+    ores = combineErrors $ fmap (mapM go) spOther
+
+compileRegex :: Bool -> T.Text -> 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 $
+        T.unpack $
+          T.unwords [m, "-", keyVals [("pattern", pat), ("query", s)]]
+    readSign x
+      | x == "-" = return (-1)
+      | x == "+" || x == "" = return 1
+      | otherwise = msg $ T.append "invalid sign: " x
+    readWhole sign x = do
+      w <- readT "whole number" x
+      k <- readSign sign
+      return (k, w)
+
+historyName :: BudgetName
+historyName = BudgetName "history"
diff --git a/lib/Internal/Types/Database.hs b/lib/Internal/Types/Database.hs
index 6ea5506..f85efbc 100644
--- a/lib/Internal/Types/Database.hs
+++ b/lib/Internal/Types/Database.hs
@@ -7,9 +7,12 @@
 -- | Types corresponding to the database model
 module Internal.Types.Database where
 
+import Data.Csv (FromField)
 import Database.Persist.Sql hiding (Desc, In, Statement)
 import Database.Persist.TH
+import Internal.Types.Dhall
 import RIO
+import qualified RIO.NonEmpty as NE
 import qualified RIO.Text as T
 import RIO.Time
 
@@ -17,51 +20,94 @@ share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
   [persistLowerCase|
 CommitR sql=commits
-    hash Int
+    hash CommitHash
     type ConfigType
-    deriving Show Eq
+    UniqueCommitHash hash
+    deriving Show Eq Ord
+ConfigStateR sql=config_state
+    historySpan HistorySpan
+    budgetSpan BudgetSpan
+    deriving Show
 CurrencyR sql=currencies
-    symbol T.Text
+    symbol CurID
     fullname T.Text
-    precision Int
-    deriving Show Eq
+    precision Precision
+    UniqueCurrencySymbol symbol
+    UniqueCurrencyFullname fullname
+    deriving Show Eq Ord
 TagR sql=tags
-    symbol T.Text
+    symbol TagID
     fullname T.Text
-    deriving Show Eq
+    UniqueTagSymbol symbol
+    UniqueTagFullname fullname
+    deriving Show Eq Ord
 AccountR sql=accounts
     name T.Text
-    fullpath T.Text
+    fullpath AcntPath
     desc T.Text
-    deriving Show Eq
+    sign AcntSign
+    leaf Bool
+    UniqueAccountFullpath fullpath
+    deriving Show Eq Ord
 AccountPathR sql=account_paths
-    parent AccountRId OnDeleteCascade
-    child AccountRId OnDeleteCascade
+    parent AccountRId 
+    child AccountRId 
     depth Int
-    deriving Show Eq
+    deriving Show Eq Ord
 TransactionR sql=transactions
-    commit CommitRId OnDeleteCascade
+    commit CommitRId 
     date Day
-    description T.Text
+    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
-    transaction TransactionRId OnDeleteCascade
-    currency CurrencyRId OnDeleteCascade
-    account AccountRId OnDeleteCascade
+    entryset EntrySetRId  
+    account AccountRId 
     memo T.Text
     value Rational
+    index EntryIndex
+    cachedValue (Maybe Rational)
+    cachedType (Maybe TransferType)
+    cachedLink (Maybe EntryIndex)
     deriving Show Eq
 TagRelationR sql=tag_relations
-    entry EntryRId OnDeleteCascade
-    tag TagRId OnDeleteCascade
-BudgetLabelR sql=budget_labels
-    entry EntryRId OnDeleteCascade
-    budgetName T.Text
+    entry EntryRId 
+    tag TagRId
     deriving Show Eq
 |]
 
-data ConfigType = CTBudget | CTManual | CTImport
-  deriving (Eq, Show, Read, Enum)
+newtype EntrySetIndex = EntrySetIndex {unEntrySetIndex :: Int}
+  deriving newtype (Show, Eq, Ord, Num, Real, Enum, Integral, PersistField, PersistFieldSql)
+
+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)
+
+newtype Precision = Precision {unPrecision :: Word8}
+  deriving newtype (Eq, Ord, Num, Show, Real, Enum, Integral, PersistField, PersistFieldSql)
+
+type DaySpan = (Day, Int)
+
+newtype CommitHash = CommitHash {unCommitHash :: Int}
+  deriving newtype (Show, Eq, Num, Ord, PersistField, PersistFieldSql)
+
+newtype BudgetSpan = BudgetSpan {unBSpan :: DaySpan}
+  deriving newtype (Show, Eq, PersistField, PersistFieldSql)
+
+newtype HistorySpan = HistorySpan {unHSpan :: DaySpan}
+  deriving newtype (Show, Eq, PersistField, PersistFieldSql)
+
+data ConfigType = CTBudget | CTHistoryTransfer | CTHistoryStatement
+  deriving (Eq, Show, Read, Enum, Ord)
 
 instance PersistFieldSql ConfigType where
   sqlType _ = SqlString
@@ -69,7 +115,61 @@ instance PersistFieldSql ConfigType where
 instance PersistField ConfigType where
   toPersistValue = PersistText . T.pack . show
 
-  -- TODO these error messages *might* be good enough?
   fromPersistValue (PersistText v) =
     maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
-  fromPersistValue _ = Left "wrong type"
+  fromPersistValue _ = Left "not a string"
+
+data AcntSign = Credit | Debit
+  deriving (Show, Eq, Ord)
+
+instance PersistFieldSql AcntSign where
+  sqlType _ = SqlInt64
+
+instance PersistField AcntSign where
+  toPersistValue Debit = PersistInt64 1
+  toPersistValue Credit = PersistInt64 (-1)
+
+  fromPersistValue (PersistInt64 1) = Right Debit
+  fromPersistValue (PersistInt64 (-1)) = Right Credit
+  fromPersistValue (PersistInt64 v) = Left $ "could not convert to account sign: " <> tshow v
+  fromPersistValue _ = Left "not an Int64"
+
+data AcntType
+  = AssetT
+  | EquityT
+  | ExpenseT
+  | IncomeT
+  | LiabilityT
+  deriving (Show, Eq, Ord, Hashable, Generic, Read)
+
+atName :: AcntType -> T.Text
+atName AssetT = "asset"
+atName EquityT = "equity"
+atName ExpenseT = "expense"
+atName IncomeT = "income"
+atName LiabilityT = "liability"
+
+data AcntPath = AcntPath
+  { apType :: !AcntType
+  , apChildren :: ![T.Text]
+  }
+  deriving (Eq, Ord, Show, Hashable, Generic, Read)
+
+acntPath2Text :: AcntPath -> T.Text
+acntPath2Text = T.intercalate "/" . NE.toList . acntPath2NonEmpty
+
+acntPath2NonEmpty :: AcntPath -> NonEmpty T.Text
+acntPath2NonEmpty (AcntPath t cs) = atName t :| cs
+
+instance PersistFieldSql AcntPath where
+  sqlType _ = SqlString
+
+instance PersistField AcntPath where
+  toPersistValue = PersistText . acntPath2Text
+
+  fromPersistValue (PersistText v) = case T.split (== '/') v of
+    [] -> Left "path is empty"
+    (x : xs) -> case readMaybe $ T.unpack x of
+      Just t -> Right $ AcntPath t xs
+      _ -> Left "could not get account type"
+  fromPersistValue _ = Left "not a string"
diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs
index ea29dbf..1a72ea3 100644
--- a/lib/Internal/Types/Dhall.hs
+++ b/lib/Internal/Types/Dhall.hs
@@ -19,9 +19,9 @@ import Language.Haskell.TH.Syntax (Lift)
 import RIO
 import qualified RIO.Map as M
 import qualified RIO.Text as T
-import RIO.Time
 import Text.Regex.TDFA
 
+-- TODO find a way to conventiently make TaggedAcnt use my newtypes
 makeHaskellTypesWith
   (defaultGenerateOptions {generateToDhallInstance = False, generateFromDhallInstance = False})
   [ MultipleConstructors "SqlConfig" "(./dhall/Types.dhall).SqlConfig"
@@ -33,13 +33,14 @@ makeHaskellTypesWith
   , MultipleConstructors "YMDMatcher" "(./dhall/Types.dhall).YMDMatcher"
   , MultipleConstructors "DateMatcher" "(./dhall/Types.dhall).DateMatcher"
   , MultipleConstructors "EntryNumGetter" "(./dhall/Types.dhall).EntryNumGetter"
-  , MultipleConstructors "BudgetCurrency" "(./dhall/Types.dhall).BudgetCurrency"
-  , MultipleConstructors "BudgetTransferType" "(./dhall/Types.dhall).BudgetTransferType"
+  , MultipleConstructors "LinkedEntryNumGetter" "(./dhall/Types.dhall).LinkedEntryNumGetter"
+  , MultipleConstructors "TransferType" "(./dhall/Types.dhall).TransferType"
   , MultipleConstructors "TaxMethod" "(./dhall/Types.dhall).TaxMethod"
   , MultipleConstructors "PeriodType" "(./dhall/Types.dhall).PeriodType"
+  , SingleConstructor "LinkedNumGetter" "LinkedNumGetter" "(./dhall/Types.dhall).LinkedNumGetter.Type"
   , SingleConstructor "Currency" "Currency" "(./dhall/Types.dhall).Currency"
   , SingleConstructor "Tag" "Tag" "(./dhall/Types.dhall).Tag"
-  , SingleConstructor "TaggedAcnt" "TaggedAcnt" "(./dhall/Types.dhall).TaggedAcnt"
+  , SingleConstructor "TaggedAcnt" "TaggedAcnt" "(./dhall/Types.dhall).TaggedAcnt.Type"
   , SingleConstructor "Gregorian" "Gregorian" "(./dhall/Types.dhall).Gregorian"
   , SingleConstructor "GregorianM" "GregorianM" "(./dhall/Types.dhall).GregorianM"
   , SingleConstructor "Interval" "Interval" "(./dhall/Types.dhall).Interval"
@@ -48,12 +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 "Amount" "Amount" "(./dhall/Types.dhall).Amount"
+  , SingleConstructor
+      "Amount"
+      "Amount"
+      "\\(w : Type) -> \\(v : Type) -> ((./dhall/Types.dhall).Amount w v).Type"
+  , SingleConstructor
+      "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 "Income" "Income" "(./dhall/Types.dhall).Income.Type"
-    SingleConstructor "Exchange" "Exchange" "(./dhall/Types.dhall).Exchange"
   , SingleConstructor "Field" "Field" "(./dhall/Types.dhall).Field"
   , SingleConstructor "Entry" "Entry" "(./dhall/Types.dhall).Entry"
   , SingleConstructor "PretaxValue" "PretaxValue" "(./dhall/Types.dhall).PretaxValue"
@@ -61,14 +67,9 @@ makeHaskellTypesWith
   , SingleConstructor "TaxProgression" "TaxProgression" "(./dhall/Types.dhall).TaxProgression"
   , SingleConstructor "TaxValue" "TaxValue" "(./dhall/Types.dhall).TaxValue"
   , SingleConstructor "PosttaxValue" "PosttaxValue" "(./dhall/Types.dhall).PosttaxValue"
-  , SingleConstructor "BudgetTransferValue" "BudgetTransferValue" "(./dhall/Types.dhall).BudgetTransferValue"
+  , SingleConstructor "TransferValue" "TransferValue" "(./dhall/Types.dhall).TransferValue.Type"
   , SingleConstructor "Period" "Period" "(./dhall/Types.dhall).Period"
   , SingleConstructor "HourlyPeriod" "HourlyPeriod" "(./dhall/Types.dhall).HourlyPeriod"
-  -- , SingleConstructor "ToTx" "ToTx" "(./dhall/Types.dhall).ToTx"
-  -- , SingleConstructor "FieldMatcher" "FieldMatcher" "(./dhall/Types.dhall).FieldMatcher_"
-  -- , SingleConstructor "Match" "Match" "(./dhall/Types.dhall).Match_"
-  -- , SingleConstructor "Budget" "Budget" "(./dhall/Types.dhall).Budget"
-  -- SingleConstructor "Transfer" "Transfer" "(./dhall/Types.dhall).Transfer"
   ]
 
 deriveProduct
@@ -95,9 +96,9 @@ deriveProduct
   , "DateMatcher"
   , "ValMatcher"
   , "YMDMatcher"
-  , "BudgetCurrency"
-  , "Exchange"
   , "EntryNumGetter"
+  , "LinkedNumGetter"
+  , "LinkedEntryNumGetter"
   , "TemporalScope"
   , "SqlConfig"
   , "PretaxValue"
@@ -106,8 +107,8 @@ deriveProduct
   , "TaxProgression"
   , "TaxMethod"
   , "PosttaxValue"
-  , "BudgetTransferValue"
-  , "BudgetTransferType"
+  , "TransferValue"
+  , "TransferType"
   , "Period"
   , "PeriodType"
   , "HourlyPeriod"
@@ -178,22 +179,24 @@ deriving instance Ord DatePat
 
 deriving instance Hashable DatePat
 
-type BudgetTransfer =
-  Transfer TaggedAcnt BudgetCurrency DatePat BudgetTransferValue
+type PairedTransfer = Transfer TaggedAcnt CurID DatePat TransferValue
 
-deriving instance Hashable BudgetTransfer
+deriving instance Hashable PairedTransfer
 
-deriving instance Generic BudgetTransfer
+deriving instance Generic PairedTransfer
 
-deriving instance FromDhall BudgetTransfer
+deriving instance FromDhall PairedTransfer
+
+newtype BudgetName = BudgetName {unBudgetName :: T.Text}
+  deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
 
 data Budget = Budget
-  { bgtLabel :: Text
+  { bgtLabel :: BudgetName
   , bgtIncomes :: [Income]
   , bgtPretax :: [MultiAllocation PretaxValue]
   , bgtTax :: [MultiAllocation TaxValue]
   , bgtPosttax :: [MultiAllocation PosttaxValue]
-  , bgtTransfers :: [BudgetTransfer]
+  , bgtTransfers :: [PairedTransfer]
   , bgtShadowTransfers :: [ShadowTransfer]
   , bgtInterval :: !(Maybe Interval)
   }
@@ -212,15 +215,28 @@ deriving instance Hashable PosttaxValue
 
 deriving instance Hashable Budget
 
-deriving instance Hashable BudgetTransferValue
+deriving instance Hashable TransferValue
 
-deriving instance Hashable BudgetTransferType
+deriving instance Hashable TransferType
+
+deriving instance Read TransferType
+
+instance PersistFieldSql TransferType where
+  sqlType _ = SqlString
+
+instance PersistField TransferType where
+  toPersistValue = PersistText . T.pack . show
+
+  fromPersistValue (PersistText v) =
+    maybe (Left $ "could not parse: " <> v) Right $ readMaybe $ T.unpack v
+  fromPersistValue _ = Left "wrong type"
 
 deriving instance Hashable TaggedAcnt
 
 deriving instance Ord TaggedAcnt
 
-type CurID = T.Text
+newtype CurID = CurID {unCurID :: T.Text}
+  deriving newtype (Eq, Show, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
 
 data Income = Income
   { incGross :: Double
@@ -232,6 +248,7 @@ data Income = Income
   , incFrom :: TaggedAcnt
   , incToBal :: TaggedAcnt
   , incPayPeriod :: !Period
+  , incPriority :: !Int
   }
 
 deriving instance Hashable HourlyPeriod
@@ -250,20 +267,13 @@ deriving instance (FromDhall v, FromDhall w) => FromDhall (Amount w v)
 
 deriving instance (Hashable v, Hashable w) => Hashable (Amount w v)
 
--- deriving instance (Generic w, Generic v, FromDhall w, FromDhall v) => FromDhall (Amount w v)
-
 deriving instance (Show w, Show v) => Show (Amount w v)
 
 deriving instance (Eq w, Eq v) => Eq (Amount w v)
 
-deriving instance Hashable Exchange
-
-deriving instance Hashable BudgetCurrency
-
 data Allocation w v = Allocation
   { alloTo :: TaggedAcnt
   , alloAmts :: [Amount w v]
-  , alloCur :: CurID
   }
   deriving (Eq, Show, Generic, Hashable)
 
@@ -340,6 +350,10 @@ instance Ord DateMatcher where
 
 deriving instance Hashable EntryNumGetter
 
+deriving instance Hashable LinkedNumGetter
+
+deriving instance Hashable LinkedEntryNumGetter
+
 -------------------------------------------------------------------------------
 -- top level type with fixed account tree to unroll the recursion in the dhall
 -- account tree type
@@ -362,7 +376,7 @@ data AccountRoot_ a = AccountRoot_
   , arIncome :: ![a]
   , arLiabilities :: ![a]
   }
-  deriving (Generic)
+  deriving (Generic, Hashable)
 
 type AccountRootF = AccountRoot_ (Fix AccountTreeF)
 
@@ -371,10 +385,8 @@ deriving instance FromDhall AccountRootF
 type AccountRoot = AccountRoot_ AccountTree
 
 data Config_ a = Config_
-  { global :: !TemporalScope
-  , budget :: ![Budget]
+  { scope :: !TemporalScope
   , currencies :: ![Currency]
-  , statements :: ![History]
   , accounts :: !a
   , tags :: ![Tag]
   , sqlConfig :: !SqlConfig
@@ -404,55 +416,44 @@ instance FromDhall a => FromDhall (Config_ a)
 -- dhall type overrides (since dhall can't import types with parameters...yet)
 
 -- TODO newtypes for these?
-type AcntID = T.Text
+newtype AcntID = AcntID {unAcntID :: T.Text}
+  deriving newtype (Eq, Show, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
 
-type TagID = T.Text
-
-type HistTransfer = Transfer AcntID CurID DatePat Double
-
-deriving instance Generic HistTransfer
-
-deriving instance Hashable HistTransfer
-
-deriving instance FromDhall HistTransfer
+newtype TagID = TagID {unTagID :: T.Text}
+  deriving newtype (Eq, Show, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
 
 data History
-  = HistTransfer !HistTransfer
+  = HistTransfer !PairedTransfer
   | HistStatement !Statement
   deriving (Eq, Generic, Hashable, FromDhall)
 
-type EntryGetter = Entry EntryAcnt (Maybe EntryNumGetter) EntryCur TagID
+type EntryGetter n = Entry EntryAcnt n TagID
 
-instance FromDhall EntryGetter
+type FromEntryGetter = EntryGetter EntryNumGetter
 
-deriving instance (Show a, Show c, Show v, Show t) => Show (Entry a v c t)
+type ToEntryGetter = EntryGetter LinkedEntryNumGetter
 
-deriving instance Generic (Entry a v c t)
+instance FromDhall FromEntryGetter
 
-deriving instance (Hashable a, Hashable v, Hashable c, Hashable t) => Hashable (Entry a v c t)
+instance FromDhall ToEntryGetter
 
-deriving instance (Eq a, Eq v, Eq c, Eq t) => Eq (Entry a v c t)
+deriving instance (Show a, Show v, Show t) => Show (Entry a v t)
 
-data Tx s = Tx
-  { txDescr :: !T.Text
-  , txDate :: !Day
-  , txEntries :: ![s]
-  }
-  deriving (Generic)
+deriving instance Generic (Entry a v t)
 
-type ExpTx = Tx EntryGetter
+deriving instance (Hashable a, Hashable v, Hashable t) => Hashable (Entry a v t)
 
-instance FromDhall ExpTx
+deriving instance (Eq a, Eq v, Eq t) => Eq (Entry a v t)
 
-data TxOpts re = TxOpts
-  { toDate :: !T.Text
-  , toAmount :: !T.Text
-  , toDesc :: !T.Text
-  , toOther :: ![T.Text]
-  , toDateFmt :: !T.Text
-  , toAmountFmt :: !re
-  }
-  deriving (Eq, Generic, Hashable, Show, FromDhall)
+deriving instance Eq a => Eq (TxOpts a)
+
+deriving instance Generic (TxOpts a)
+
+deriving instance Hashable a => Hashable (TxOpts a)
+
+deriving instance FromDhall a => FromDhall (TxOpts a)
+
+deriving instance Show a => Show (TxOpts a)
 
 data Statement = Statement
   { stmtPaths :: ![FilePath]
@@ -461,7 +462,7 @@ data Statement = Statement
   , stmtTxOpts :: !(TxOpts T.Text)
   , stmtSkipLines :: !Natural
   }
-  deriving (Eq, Hashable, Generic, FromDhall)
+  deriving (Eq, Hashable, Generic, FromDhall, Show)
 
 -- | the value of a field in entry (text version)
 -- can either be a raw (constant) value, a lookup from the record, or a map
@@ -471,7 +472,7 @@ data EntryTextGetter t
   | LookupT !T.Text
   | MapT !(FieldMap T.Text t)
   | Map2T !(FieldMap (T.Text, T.Text) t)
-  deriving (Eq, Generic, Hashable, Show, FromDhall)
+  deriving (Eq, Generic, Hashable, Show, FromDhall, Functor)
 
 type EntryCur = EntryTextGetter CurID
 
@@ -503,10 +504,32 @@ data FieldMatcher re
 
 deriving instance Show (FieldMatcher T.Text)
 
+data TxHalfGetter e = TxHalfGetter
+  { thgAcnt :: !EntryAcnt
+  , thgComment :: !T.Text
+  , thgTags :: ![TagID]
+  , thgEntries :: ![e]
+  }
+  deriving (Eq, Generic, Hashable, Show)
+
+deriving instance FromDhall (TxHalfGetter FromEntryGetter)
+
+deriving instance FromDhall (TxHalfGetter ToEntryGetter)
+
+data TxSubGetter = TxSubGetter
+  { tsgFrom :: !(TxHalfGetter FromEntryGetter)
+  , tsgTo :: !(TxHalfGetter ToEntryGetter)
+  , tsgValue :: !EntryNumGetter
+  , tsgCurrency :: !EntryCur
+  }
+  deriving (Eq, Generic, Hashable, Show, FromDhall)
+
 data TxGetter = TxGetter
-  { tgCurrency :: !EntryCur
-  , tgAcnt :: !EntryAcnt
-  , tgEntries :: ![EntryGetter]
+  { tgFrom :: !(TxHalfGetter FromEntryGetter)
+  , tgTo :: !(TxHalfGetter ToEntryGetter)
+  , tgCurrency :: !EntryCur
+  , tgOtherEntries :: ![TxSubGetter]
+  , tgScale :: !Double
   }
   deriving (Eq, Generic, Hashable, Show, FromDhall)
 
diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs
index 3be6ee7..3079e4e 100644
--- a/lib/Internal/Types/Main.hs
+++ b/lib/Internal/Types/Main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -12,11 +11,11 @@ module Internal.Types.Main
 where
 
 import Control.Monad.Except
+import Data.Decimal
 import Database.Persist.Sql hiding (Desc, In, Statement)
 import Dhall hiding (embed, maybe)
 import Internal.Types.Database
 import Internal.Types.Dhall
-import Language.Haskell.TH.Syntax (Lift)
 import RIO
 import qualified RIO.Map as M
 import qualified RIO.NonEmpty as NE
@@ -27,99 +26,139 @@ import Text.Regex.TDFA
 --------------------------------------------------------------------------------
 -- database cache types
 
-data ConfigHashes = ConfigHashes
-  { chIncome :: ![Int]
-  , chExpense :: ![Int]
-  , chManual :: ![Int]
-  , chImport :: ![Int]
+type MonadFinance = MonadReader ConfigState
+
+data DeleteTxs = DeleteTxs
+  { dtTxs :: ![TransactionRId]
+  , dtEntrySets :: ![EntrySetRId]
+  , dtEntries :: ![EntryRId]
+  , dtTagRelations :: ![TagRelationRId]
+  }
+  deriving (Show)
+
+type CDOps c d = CRUDOps [c] () () [d]
+
+-- 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)
+
+data ExistingConfig = ExistingConfig
+  { ecAccounts :: !(Set AccountRId)
+  , ecTags :: !(Set TagRId)
+  , ecCurrencies :: !(Set CurrencyRId)
   }
 
-type AccountMap = M.Map AcntID (AccountRId, AcntSign, AcntType)
+type AccountMap = M.Map AcntID (AccountRId, AcntType)
 
-type CurrencyMap = M.Map CurID (CurrencyRId, Natural)
+data CurrencyPrec = CurrencyPrec {cpID :: !CurrencyRId, cpPrec :: !Precision}
+  deriving (Show)
+
+type CurrencyMap = M.Map CurID CurrencyPrec
 
 type TagMap = M.Map TagID TagRId
 
-data DBState = DBState
-  { kmCurrency :: !CurrencyMap
-  , kmAccount :: !AccountMap
-  , kmTag :: !TagMap
-  , kmBudgetInterval :: !DaySpan
-  , kmStatementInterval :: !DaySpan
-  , kmNewCommits :: ![Int]
+data CRUDOps c r u d = CRUDOps
+  { coCreate :: !c
+  , coRead :: !r
+  , coUpdate :: !u
+  , coDelete :: !d
   }
+  deriving (Show)
 
-data DBUpdates = DBUpdates
-  { duOldCommits :: ![Int]
-  , duNewTagIds :: ![Entity TagR]
-  , duNewAcntPaths :: ![AccountPathR]
-  , duNewAcntIds :: ![Entity AccountR]
-  , duNewCurrencyIds :: ![Entity CurrencyR]
+data CachedEntry
+  = CachedLink EntryIndex LinkScale
+  | CachedBalance Decimal
+  | CachedPercent Double
+
+data ReadEntry = ReadEntry
+  { reCurrency :: !CurrencyRId
+  , reAcnt :: !AccountRId
+  , reValue :: !Decimal
+  , reDate :: !Day
+  , rePriority :: !Int
+  , reBudget :: !BudgetName
   }
+  deriving (Show)
 
-type CurrencyM = Reader CurrencyMap
+data UpdateEntry i v = UpdateEntry
+  { ueID :: !i
+  , ueAcnt :: !AccountRId
+  , ueValue :: !v
+  , ueIndex :: !EntryIndex
+  }
+  deriving (Show)
 
-type KeyEntry = Entry AccountRId Rational CurrencyRId TagRId
+deriving instance Functor (UpdateEntry i)
 
-type KeyTx = Tx KeyEntry
+newtype LinkScale = LinkScale {unLinkScale :: Double}
+  deriving newtype (Num, Show, Eq, Ord, Real, Fractional)
 
-type TreeR = Tree ([T.Text], AccountRId)
+newtype StaticValue = StaticValue {unStaticValue :: Decimal}
+  deriving newtype (Num, Show)
 
-type MonadFinance = MonadReader DBState
+data EntryValueUnk = EVBalance Decimal | EVPercent Double deriving (Show)
 
-askDBState :: MonadFinance m => (DBState -> a) -> m a
-askDBState = asks
+type UEUnk = UpdateEntry EntryRId EntryValueUnk
+
+type UELink = UpdateEntry EntryRId LinkScale
+
+type UEBlank = UpdateEntry EntryRId ()
+
+type UE_RO = UpdateEntry () StaticValue
+
+type UEBalanced = UpdateEntry EntryRId StaticValue
+
+data UpdateEntrySet f t = UpdateEntrySet
+  { utFrom0 :: !f
+  , utTo0 :: !UEBlank
+  , utFromUnk :: ![(UEUnk, [UELink])]
+  , utToUnk :: ![UEUnk]
+  , utFromRO :: ![UE_RO]
+  , utToRO :: ![UE_RO]
+  , utCurrency :: !CurrencyRId
+  , utDate :: !Day
+  , utTotalValue :: !t
+  , utBudget :: !BudgetName
+  , utPriority :: !Int
+  }
+  deriving (Show)
+
+type TotalUpdateEntrySet = UpdateEntrySet (UEBlank, [UELink]) Decimal
+
+type FullUpdateEntrySet = UpdateEntrySet (Either UE_RO (UEUnk, [UELink])) ()
+
+data EntryCRU
+  = ToUpdate (Either TotalUpdateEntrySet FullUpdateEntrySet)
+  | ToRead ReadEntry
+  | ToInsert (Tx CommitR)
 
 -------------------------------------------------------------------------------
 -- misc
 
-data AcntType
-  = AssetT
-  | EquityT
-  | ExpenseT
-  | IncomeT
-  | LiabilityT
-  deriving (Show, Eq, Ord, Lift, Hashable, Generic, Read, FromDhall)
-
-atName :: AcntType -> T.Text
-atName AssetT = "asset"
-atName EquityT = "equity"
-atName ExpenseT = "expense"
-atName IncomeT = "income"
-atName LiabilityT = "liability"
-
-data AcntPath = AcntPath
-  { apType :: !AcntType
-  , apChildren :: ![T.Text]
-  }
-  deriving (Eq, Ord, Show, Lift, Hashable, Generic, Read, FromDhall)
-
 data TxRecord = TxRecord
   { trDate :: !Day
-  , trAmount :: !Rational
-  , trDesc :: !T.Text
+  , trAmount :: !Decimal
+  , trDesc :: !TxDesc
   , trOther :: !(M.Map T.Text T.Text)
   , trFile :: !FilePath
   }
   deriving (Show, Eq, Ord)
 
-type DaySpan = (Day, Natural)
-
-data Keyed a = Keyed
-  { kKey :: !Int64
-  , kVal :: !a
-  }
-  deriving (Eq, Show, Functor)
-
 data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
 
-data AcntSign = Credit | Debit
-  deriving (Show)
-
-sign2Int :: AcntSign -> Int
-sign2Int Debit = 1
-sign2Int Credit = 1
-
 accountSign :: AcntType -> AcntSign
 accountSign AssetT = Debit
 accountSign ExpenseT = Debit
@@ -127,21 +166,81 @@ accountSign IncomeT = Credit
 accountSign LiabilityT = Credit
 accountSign EquityT = Credit
 
-type RawEntry = Entry AcntID (Maybe Rational) CurID TagID
+data HalfEntrySet v0 vN = HalfEntrySet
+  { hesPrimary :: !(Entry AcntID v0 TagID)
+  , hesOther :: ![Entry AcntID vN TagID]
+  }
+  deriving (Show)
 
-type BalEntry = Entry AcntID Rational CurID TagID
+data EntrySet v0 vp0 vpN vtN = EntrySet
+  { esTotalValue :: !v0
+  , esCurrency :: !CurrencyRId
+  , esFrom :: !(HalfEntrySet vp0 vpN)
+  , esTo :: !(HalfEntrySet () vtN)
+  }
+  deriving (Show)
 
-type RawTx = Tx RawEntry
+type TotalEntrySet v0 vpN vtN = EntrySet v0 () vpN vtN
 
-type BalTx = Tx BalEntry
+type FullEntrySet vp0 vpN vtN = EntrySet () vp0 vpN vtN
+
+type PrimaryEntrySet = TotalEntrySet Decimal EntryValue EntryLink
+
+type SecondayEntrySet = FullEntrySet EntryValue EntryValue EntryLink
+
+type TransferEntrySet = SecondayEntrySet
+
+type ShadowEntrySet = TotalEntrySet Double EntryValue EntryLink
+
+data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text
+  deriving (Eq, Ord, Show)
+
+data Tx k = Tx
+  { txDescr :: !TxDesc
+  , txDate :: !Day
+  , txPriority :: !Int
+  , txPrimary :: !(Either PrimaryEntrySet TransferEntrySet)
+  , txOther :: ![Either SecondayEntrySet ShadowEntrySet]
+  , txCommit :: !k
+  , txBudget :: !BudgetName
+  }
+  deriving (Generic, Show)
+
+data InsertEntry = InsertEntry
+  { ieCached :: !(Maybe CachedEntry)
+  , ieEntry :: !(Entry AccountRId Decimal TagRId)
+  }
+
+data InsertEntrySet = InsertEntrySet
+  { iesCurrency :: !CurrencyRId
+  , iesFromEntries :: !(NonEmpty InsertEntry)
+  , iesToEntries :: !(NonEmpty InsertEntry)
+  }
+
+data InsertTx = InsertTx
+  { itxDescr :: !TxDesc
+  , itxDate :: !Day
+  , itxPriority :: !Int
+  , itxEntrySets :: !(NonEmpty InsertEntrySet)
+  , itxCommit :: !CommitR
+  , itxBudget :: !BudgetName
+  }
+  deriving (Generic)
+
+data EntryValue_ a = EntryValue_ TransferType a
+  deriving (Show, Functor, Foldable, Traversable)
+
+data EntryValue = EntryFixed Decimal | EntryPercent Double | EntryBalance Decimal
+  deriving (Show, Eq, Ord)
+
+data EntryLink = LinkValue EntryValue | LinkIndex LinkedNumGetter
+  deriving (Show)
 
 data MatchRes a = MatchPass !a | MatchFail | MatchSkip
 
 --------------------------------------------------------------------------------
 -- exception types
 
-data BalanceType = TooFewEntries | NotOneBlank deriving (Show)
-
 data MatchType = MatchNumeric | MatchText deriving (Show)
 
 data EntryIDType = AcntField | CurField | TagField deriving (Show)
@@ -153,48 +252,49 @@ data LookupSuberr
   | DBKey !EntryIDType
   deriving (Show)
 
-data AllocationSuberr
-  = NoAllocations
-  | ExceededTotal
-  | MissingBlank
-  | TooManyBlanks
-  deriving (Show)
-
 data PatternSuberr = ZeroLength | ZeroRepeats deriving (Show)
 
-data InsertError
+data DBLinkSubError
+  = DBLinkNoScale
+  | DBLinkNoValue
+  | DBLinkInvalidValue !Rational !Bool
+  | DBLinkInvalidBalance
+  | DBLinkInvalidPercent
+  deriving (Show)
+
+data DBSubError
+  = DBShouldBeEmpty
+  | DBMultiScope
+  | DBUpdateUnbalanced
+  | DBLinkError !EntryRId !DBLinkSubError
+  deriving (Show)
+
+data AppError
   = RegexError !T.Text
   | MatchValPrecisionError !Natural !Natural
-  | AccountError !AcntID !(NE.NonEmpty AcntType)
-  | InsertIOError !T.Text
+  | AccountTypeError !AcntID !(NE.NonEmpty AcntType)
+  | StatementIOError !T.Text
   | ParseError !T.Text
-  | ConversionError !T.Text
+  | ConversionError !T.Text !Bool
   | LookupError !LookupSuberr !T.Text
-  | BalanceError !BalanceType !CurID ![RawEntry]
-  | IncomeError !Day !T.Text !Rational
-  | PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
+  | DatePatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
   | DaySpanError !Gregorian !(Maybe Gregorian)
   | StatementError ![TxRecord] ![MatchRe]
   | PeriodError !Day !Day
+  | LinkError !EntryIndex !EntryIndex
+  | DBError !DBSubError
   deriving (Show)
 
-newtype InsertException = InsertException [InsertError]
-  deriving (Show, Semigroup) via [InsertError]
+newtype AppException = AppException [AppError]
+  deriving (Show, Semigroup) via [AppError]
 
-instance Exception InsertException
+instance Exception AppException
 
-type MonadInsertError = MonadError InsertException
+type MonadAppError = MonadError AppException
 
-type InsertExceptT = ExceptT InsertException
+type AppExceptT = ExceptT AppException
 
-type InsertExcept = InsertExceptT Identity
-
-data XGregorian = XGregorian
-  { xgYear :: !Int
-  , xgMonth :: !Int
-  , xgDay :: !Int
-  , xgDayOfWeek :: !Int
-  }
+type AppExcept = AppExceptT Identity
 
 type MatchRe = StatementParser (T.Text, Regex)
 
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index fcca4d1..3acf795 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -4,12 +4,11 @@ module Internal.Utils
   , askDays
   , fromWeekday
   , inDaySpan
-  , fmtRational
-  , matches
   , fromGregorian'
   , resolveDaySpan
   , resolveDaySpan_
   , intersectDaySpan
+  , throwAppError
   , liftInner
   , liftExceptT
   , liftExcept
@@ -28,55 +27,53 @@ module Internal.Utils
   , combineErrorIOM3
   , collectErrorsIO
   , mapErrorsIO
-  , parseRational
+  , mapErrorsPooledIO
   , showError
-  , unlessLeft_
-  , unlessLefts_
-  , unlessLeft
-  , unlessLefts
-  , acntPath2Text
-  , showT
   , lookupErr
-  , gregorians
   , uncurry3
-  , fstOf3
-  , sndOf3
-  , thdOf3
-  , xGregToDay
-  , compileMatch
-  , compileOptions
   , dateMatches
   , valMatches
-  , roundPrecision
-  , roundPrecisionCur
+  , lookupAccount
   , lookupAccountKey
-  , lookupAccountSign
   , lookupAccountType
+  , lookupCurrency
   , lookupCurrencyKey
   , lookupCurrencyPrec
   , lookupTag
+  , mapAdd_
+  , groupKey
+  , groupWith
+  , balanceTxs
+  , expandTransfers
+  , expandTransfer
+  , entryPair
+  , singleQuote
+  , keyVals
+  , realFracToDecimalP
+  , roundToP
   )
 where
 
 import Control.Monad.Error.Class
 import Control.Monad.Except
-import Control.Monad.Reader
+import Data.Decimal
 import Data.Time.Format.ISO8601
+import qualified Database.Esqueleto.Experimental as E
 import GHC.Real
 import Internal.Types.Main
 import RIO
 import qualified RIO.List as L
 import qualified RIO.Map as M
 import qualified RIO.NonEmpty as NE
+import RIO.State
 import qualified RIO.Text as T
 import RIO.Time
-import Text.Regex.TDFA
-import Text.Regex.TDFA.Text
+import qualified RIO.Vector as V
 
 --------------------------------------------------------------------------------
 -- intervals
 
-expandDatePat :: DaySpan -> DatePat -> InsertExcept [Day]
+expandDatePat :: DaySpan -> DatePat -> AppExcept [Day]
 expandDatePat b (Cron cp) = expandCronPat b cp
 expandDatePat i (Mod mp) = return $ expandModPat mp i
 
@@ -95,7 +92,7 @@ expandModPat ModPat {mpStart = s, mpBy = b, mpUnit = u, mpRepeats = r} bs =
       Month -> addGregorianMonthsClip
       Year -> addGregorianYearsClip
 
-expandCronPat :: DaySpan -> CronPat -> InsertExcept [Day]
+expandCronPat :: DaySpan -> CronPat -> AppExcept [Day]
 expandCronPat b CronPat {cpYear, cpMonth, cpDay, cpWeekly} =
   combineError3 yRes mRes dRes $ \ys ms ds ->
     filter validWeekday $
@@ -126,14 +123,14 @@ expandCronPat b CronPat {cpYear, cpMonth, cpDay, cpWeekly} =
       | m `elem` [4, 6, 9, 11] && d > 30 = Nothing
       | otherwise = Just $ fromGregorian y m d
 
-expandMDYPat :: Natural -> Natural -> MDYPat -> InsertExcept [Natural]
+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 (After x) = return [max lower x .. upper]
 expandMDYPat lower upper (Before x) = return [lower .. min upper x]
 expandMDYPat lower upper (Between x y) = return [max lower x .. min upper y]
 expandMDYPat lower upper (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r})
-  | b < 1 = throwError $ InsertException [PatternError s b r ZeroLength]
+  | b < 1 = throwAppError $ DatePatternError s b r ZeroLength
   | otherwise = do
       k <- limit r
       return $ dropWhile (<= lower) $ takeWhile (<= k) [s + i * b | i <- [0 ..]]
@@ -142,19 +139,19 @@ expandMDYPat lower upper (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r
     limit (Just n)
       -- this guard not only produces the error for the user but also protects
       -- from an underflow below it
-      | n < 1 = throwError $ InsertException [PatternError s b r ZeroRepeats]
+      | n < 1 = throwAppError $ DatePatternError s b r ZeroRepeats
       | otherwise = return $ min (s + b * (n - 1)) upper
 
 dayToWeekday :: Day -> Int
 dayToWeekday (ModifiedJulianDay d) = mod (fromIntegral d + 2) 7
 
 askDays
-  :: (MonadFinance m, MonadInsertError m)
+  :: (MonadFinance m, MonadAppError m)
   => DatePat
   -> Maybe Interval
   -> m [Day]
 askDays dp i = do
-  globalSpan <- askDBState kmBudgetInterval
+  globalSpan <- asks (unBSpan . csBudgetScope)
   case i of
     Just i' -> do
       localSpan <- liftExcept $ resolveDaySpan i'
@@ -176,33 +173,6 @@ fromWeekday Fri = Friday
 fromWeekday Sat = Saturday
 fromWeekday Sun = Sunday
 
--- | find the next date
--- this is meant to go in a very tight loop and be very fast (hence no
--- complex date functions, most of which heavily use 'mod' and friends)
-nextXGreg :: XGregorian -> XGregorian
-nextXGreg XGregorian {xgYear = y, xgMonth = m, xgDay = d, xgDayOfWeek = w}
-  | m == 12 && d == 31 = XGregorian (y + 1) 1 1 w_
-  | (m == 2 && (not leap && d == 28 || (leap && d == 29)))
-      || (m `elem` [4, 6, 9, 11] && d == 30)
-      || (d == 31) =
-      XGregorian y (m + 1) 1 w_
-  | otherwise = XGregorian y m (d + 1) w_
-  where
-    -- don't use DayOfWeek from Data.Time since this uses mod (which uses a
-    -- division opcode) and thus will be slower than just checking for equality
-    -- and adding
-    w_ = if w == 6 then 0 else w + 1
-    leap = isLeapYear $ fromIntegral y
-
-gregorians :: Day -> [XGregorian]
-gregorians x = L.iterate nextXGreg $ XGregorian (fromIntegral y) m d w
-  where
-    (y, m, d) = toGregorian x
-    w = fromEnum $ dayOfWeek x
-
-xGregToDay :: XGregorian -> Day
-xGregToDay XGregorian {xgYear = y, xgMonth = m, xgDay = d} = fromGregorian (fromIntegral y) m d
-
 gregTup :: Gregorian -> (Integer, Int, Int)
 gregTup Gregorian {gYear, gMonth, gDay} =
   ( fromIntegral gYear
@@ -255,7 +225,7 @@ inDaySpan bs = withinDays (fromDaySpan bs)
 withinDays :: (Day, Day) -> Day -> Bool
 withinDays (d0, d1) x = d0 <= x && x < d1
 
-resolveDaySpan :: Interval -> InsertExcept DaySpan
+resolveDaySpan :: Interval -> AppExcept DaySpan
 resolveDaySpan i@Interval {intStart = s} =
   resolveDaySpan_ (s {gYear = gYear s + 50}) i
 
@@ -268,13 +238,14 @@ intersectDaySpan a b =
     a' = max a0 a1
     b' = min b0 b1
 
-resolveDaySpan_ :: Gregorian -> Interval -> InsertExcept DaySpan
+resolveDaySpan_ :: Gregorian -> Interval -> AppExcept DaySpan
 resolveDaySpan_ def Interval {intStart = s, intEnd = e} =
+  -- TODO the default isn't checked here :/
   case fromGregorian' <$> e of
     Nothing -> return $ toDaySpan_ $ fromGregorian' def
     Just e_
       | s_ < e_ -> return $ toDaySpan_ e_
-      | otherwise -> throwError $ InsertException [DaySpanError s e]
+      | otherwise -> throwAppError $ DaySpanError s e
   where
     s_ = fromGregorian' s
     toDaySpan_ end = toDaySpan (s_, end)
@@ -289,47 +260,9 @@ toDaySpan (a, b) = (a, fromIntegral $ diffDays b a - 1)
 --------------------------------------------------------------------------------
 -- matching
 
-matches :: MatchRe -> TxRecord -> InsertExceptT CurrencyM (MatchRes RawTx)
-matches
-  StatementParser {spTx, spOther, spVal, spDate, spDesc}
-  r@TxRecord {trDate, trAmount, trDesc, trOther} = do
-    res <- liftInner $
-      combineError3 val other desc $
-        \x y z -> x && y && z && date
-    if res
-      then maybe (return MatchSkip) convert spTx
-      else return MatchFail
-    where
-      val = valMatches spVal trAmount
-      date = maybe True (`dateMatches` trDate) spDate
-      other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
-      desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
-      convert (TxGetter cur a ss) = MatchPass <$> toTx cur a ss r
-
-toTx :: EntryCur -> EntryAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx
-toTx sc sa toEntries r@TxRecord {trAmount, trDate, trDesc} = do
-  combineError3 acntRes curRes ssRes $ \a c es ->
-    let fromEntry =
-          Entry
-            { eAcnt = a
-            , eCurrency = c
-            , eValue = Just trAmount
-            , eComment = ""
-            , eTags = [] -- TODO what goes here?
-            }
-     in Tx
-          { txDate = trDate
-          , txDescr = trDesc
-          , txEntries = fromEntry : es
-          }
-  where
-    acntRes = liftInner $ resolveAcnt r sa
-    curRes = liftInner $ resolveCurrency r sc
-    ssRes = combineErrors $ fmap (resolveEntry r) toEntries
-
-valMatches :: ValMatcher -> Rational -> InsertExcept Bool
+valMatches :: ValMatcher -> Rational -> AppExcept Bool
 valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
-  | Just d_ <- vmDen, d_ >= p = throwError $ InsertException [MatchValPrecisionError d_ p]
+  | Just d_ <- vmDen, d_ >= p = throwAppError $ MatchValPrecisionError d_ p
   | otherwise =
       return $
         checkMaybe (s ==) vmSign
@@ -344,23 +277,11 @@ valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
 dateMatches :: DateMatcher -> Day -> Bool
 dateMatches md = (EQ ==) . compareDate md
 
-otherMatches :: M.Map T.Text T.Text -> FieldMatcherRe -> InsertExcept Bool
-otherMatches dict m = case m of
-  Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
-  Desc (Field n (_, md)) -> (`matchMaybe` md) =<< lookup_ MatchText n
-  where
-    lookup_ t n = lookupErr (MatchField t) n dict
+--------------------------------------------------------------------------------
+-- error flow control
 
-resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawEntry
-resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do
-  m <- ask
-  liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
-    v' <- mapM (roundPrecisionCur c m) v
-    return $ s {eAcnt = a, eValue = v', eCurrency = c}
-  where
-    acntRes = resolveAcnt r eAcnt
-    curRes = resolveCurrency r eCurrency
-    valRes = mapM (resolveValue r) eValue
+throwAppError :: MonadAppError m => AppError -> m a
+throwAppError e = throwError $ AppException [e]
 
 liftInner :: Monad m => ExceptT e Identity a -> ExceptT e m a
 liftInner = mapExceptT (return . runIdentity)
@@ -371,50 +292,54 @@ liftExceptT x = runExceptT x >>= either throwError return
 liftExcept :: MonadError e m => Except e a -> m a
 liftExcept = either throwError return . runExcept
 
--- tryError :: MonadError e m => m a -> m (Either e a)
--- tryError action = (Right <$> action) `catchError` (pure . Left)
-
-liftIOExceptT :: MonadIO m => InsertExceptT m a -> m a
+liftIOExceptT :: MonadIO m => AppExceptT m a -> m a
 liftIOExceptT = fromEither <=< runExceptT
 
-liftIOExcept :: MonadIO m => InsertExcept a -> m a
+liftIOExcept :: MonadIO m => AppExcept a -> m a
 liftIOExcept = fromEither . runExcept
 
-combineError :: MonadError InsertException m => m a -> m b -> (a -> b -> c) -> m c
+combineError :: MonadAppError m => m a -> m b -> (a -> b -> c) -> m c
 combineError a b f = combineErrorM a b (\x y -> pure $ f x y)
 
-combineError_ :: MonadError InsertException m => m a -> m b -> m ()
+combineError_ :: MonadAppError m => m a -> m b -> m ()
 combineError_ a b = do
   _ <- catchError a $ \e ->
     throwError =<< catchError (e <$ b) (return . (e <>))
   _ <- b
   return ()
 
-combineErrorM :: MonadError InsertException m => m a -> m b -> (a -> b -> m c) -> m c
+combineErrorM :: MonadAppError m => m a -> m b -> (a -> b -> m c) -> m c
 combineErrorM a b f = do
   a' <- catchError a $ \e ->
     throwError =<< catchError (e <$ b) (return . (e <>))
   f a' =<< b
 
-combineError3 :: MonadError InsertException m => m a -> m b -> m c -> (a -> b -> c -> d) -> m d
+combineError3 :: MonadAppError m => m a -> m b -> m c -> (a -> b -> c -> d) -> m d
 combineError3 a b c f =
   combineError (combineError a b (,)) c $ \(x, y) z -> f x y z
 
-combineErrorM3 :: MonadError InsertException m => m a -> m b -> m c -> (a -> b -> c -> m d) -> m d
+combineErrorM3 :: MonadAppError m => m a -> m b -> m c -> (a -> b -> c -> m d) -> m d
 combineErrorM3 a b c f = do
   combineErrorM (combineErrorM a b (curry return)) c $ \(x, y) z -> f x y z
 
-combineErrors :: MonadError InsertException m => [m a] -> m [a]
+mapErrors :: (Traversable t, MonadAppError m) => (a -> m b) -> t a -> m (t b)
+-- First, record number of each action. Then try each action. On first failure,
+-- note it's position in the sequence, skip ahead to the untried actions,
+-- collect failures and add to the first failure.
+mapErrors f xs = mapM go $ enumTraversable xs
+  where
+    go (n, x) = catchError (f x) $ \e -> do
+      es <- fmap catMaybes $ mapM (err . f) $ drop (n + 1) $ toList xs
+      throwError $ foldr (<>) e es
+    err x = catchError (Nothing <$ x) (pure . Just)
+
+combineErrors :: (Traversable t, MonadAppError m) => t (m a) -> m (t a)
 combineErrors = mapErrors id
 
-mapErrors :: MonadError InsertException m => (a -> m b) -> [a] -> m [b]
-mapErrors f xs = do
-  ys <- mapM (go . f) xs
-  case partitionEithers ys of
-    ([], zs) -> return zs
-    (e : es, _) -> throwError $ foldr (<>) e es
+enumTraversable :: (Num n, Traversable t) => t a -> t (n, a)
+enumTraversable = snd . L.mapAccumL go 0
   where
-    go x = catchError (Right <$> x) (pure . Left)
+    go n x = (n + 1, (n, x))
 
 combineErrorIO2 :: MonadUnliftIO m => m a -> m b -> (a -> b -> c) -> m c
 combineErrorIO2 a b f = combineErrorIOM2 a b (\x y -> pure $ f x y)
@@ -424,137 +349,43 @@ combineErrorIO3 a b c f = combineErrorIOM3 a b c (\x y z -> pure $ f x y z)
 
 combineErrorIOM2 :: MonadUnliftIO m => m a -> m b -> (a -> b -> m c) -> m c
 combineErrorIOM2 a b f = do
-  a' <- catch a $ \(InsertException es) ->
-    (throwIO . InsertException)
-      =<< catch (es <$ b) (\(InsertException es') -> return (es' ++ es))
+  a' <- catch a $ \(AppException es) ->
+    (throwIO . AppException)
+      =<< catch (es <$ b) (\(AppException es') -> return (es' ++ es))
   f a' =<< b
 
 combineErrorIOM3 :: MonadUnliftIO m => m a -> m b -> m c -> (a -> b -> c -> m d) -> m d
 combineErrorIOM3 a b c f =
   combineErrorIOM2 (combineErrorIOM2 a b (curry return)) c $ \(x, y) z -> f x y z
 
-mapErrorsIO :: MonadUnliftIO m => (a -> m b) -> [a] -> m [b]
-mapErrorsIO f xs = do
-  ys <- mapM (go . f) xs
-  case partitionEithers ys of
-    ([], zs) -> return zs
-    (es, _) -> throwIO $ InsertException $ concat es
+mapErrorsPooledIO :: (Traversable t, MonadUnliftIO m) => Int -> (a -> m b) -> t a -> m (t b)
+mapErrorsPooledIO t f xs = pooledMapConcurrentlyN t go $ enumTraversable xs
   where
-    go x = catch (Right <$> x) $ \(InsertException es) -> pure $ Left es
+    go (n, x) = catch (f x) $ \(AppException e) -> do
+      es <- fmap catMaybes $ mapM (err . f) $ drop (n + 1) $ toList xs
+      throwIO $ AppException $ foldr (<>) e es
+    err x = catch (Nothing <$ x) $ \(AppException es) -> pure $ Just es
 
-collectErrorsIO :: MonadUnliftIO m => [m a] -> m [a]
+mapErrorsIO :: (Traversable t, MonadUnliftIO m) => (a -> m b) -> t a -> m (t b)
+mapErrorsIO f xs = mapM go $ enumTraversable xs
+  where
+    go (n, x) = catch (f x) $ \(AppException e) -> do
+      es <- fmap catMaybes $ mapM (err . f) $ drop (n + 1) $ toList xs
+      throwIO $ AppException $ foldr (<>) e es
+    err x = catch (Nothing <$ x) $ \(AppException es) -> pure $ Just es
+
+collectErrorsIO :: (Traversable t, MonadUnliftIO m) => t (m a) -> m (t a)
 collectErrorsIO = mapErrorsIO id
 
-resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept Double
-resolveValue TxRecord {trOther, trAmount} s = case s of
-  (LookupN t) -> readDouble =<< lookupErr EntryValField t trOther
-  (ConstN c) -> return c
-  AmountN m -> return $ (* m) $ fromRational trAmount
-
-resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
-resolveAcnt = resolveEntryField AcntField
-
-resolveCurrency :: TxRecord -> EntryCur -> InsertExcept T.Text
-resolveCurrency = resolveEntryField CurField
-
-resolveEntryField :: EntryIDType -> TxRecord -> EntryAcnt -> InsertExcept T.Text
-resolveEntryField t TxRecord {trOther = o} s = case s of
-  ConstT p -> return p
-  LookupT f -> lookup_ f o
-  MapT (Field f m) -> do
-    k <- lookup_ f o
-    lookup_ k m
-  Map2T (Field (f1, f2) m) -> do
-    (k1, k2) <- combineError (lookup_ f1 o) (lookup_ f2 o) (,)
-    lookup_ (k1, k2) m
-  where
-    lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v
-    lookup_ = lookupErr (EntryIDField t)
-
-lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> InsertExcept v
+lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> AppExcept v
 lookupErr what k m = case M.lookup k m of
   Just x -> return x
-  _ -> throwError $ InsertException [LookupError what $ showT k]
-
-parseRational :: MonadFail m => (T.Text, Regex) -> T.Text -> m Rational
-parseRational (pat, re) s = case matchGroupsMaybe s re of
-  [sign, x, ""] -> uncurry (*) <$> readWhole sign x
-  [sign, x, y] -> do
-    d <- readT "decimal" y
-    let p = 10 ^ T.length y
-    (k, w) <- readWhole sign x
-    return $ k * (w + d % p)
-  _ -> 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 $
-        T.unpack $
-          T.unwords [m, "-", keyVals [("pattern", pat), ("query", s)]]
-    readSign x
-      | x == "-" = return (-1)
-      | x == "+" || x == "" = return 1
-      | otherwise = msg $ T.append "invalid sign: " x
-    readWhole sign x = do
-      w <- readT "whole number" x
-      k <- readSign sign
-      return (k, w)
-
-readDouble :: T.Text -> InsertExcept Double
-readDouble s = case readMaybe $ T.unpack s of
-  Just x -> return x
-  Nothing -> throwError $ InsertException [ConversionError s]
-
-readRational :: T.Text -> InsertExcept Rational
-readRational s = case T.split (== '.') s of
-  [x] -> maybe err (return . fromInteger) $ readT x
-  [x, y] -> case (readT x, readT y) of
-    (Just x', Just y') ->
-      let p = 10 ^ T.length y
-          k = if x' >= 0 then 1 else -1
-       in return $ fromInteger x' + k * y' % p
-    _ -> err
-  _ -> err
-  where
-    readT = readMaybe . T.unpack
-    err = throwError $ InsertException [ConversionError s]
-
--- TODO smells like a lens
--- mapTxSplits :: (a -> b) -> Tx a -> Tx b
--- mapTxSplits f t@Tx {txSplits = ss} = t {txSplits = fmap f ss}
-
-fmtRational :: Natural -> Rational -> T.Text
-fmtRational precision x = T.concat [s, txt n', ".", pad 2 "0" $ txt d']
-  where
-    s = if x >= 0 then "" else "-"
-    x'@(n :% d) = abs x
-    p = 10 ^ precision
-    n' = div n d
-    d' = (\(a :% b) -> div a b) ((x' - fromIntegral n') * p)
-    txt = T.pack . show
-    pad i c z = T.append (T.replicate (i - T.length z) c) z
-
-roundPrecision :: Natural -> Double -> Rational
-roundPrecision n = (% p) . round . (* fromIntegral p) . toRational
-  where
-    p = 10 ^ n
-
-roundPrecisionCur :: CurID -> CurrencyMap -> Double -> InsertExcept Rational
-roundPrecisionCur c m x =
-  case M.lookup c m of
-    Just (_, n) -> return $ roundPrecision n x
-    Nothing -> throwError $ InsertException [undefined]
-
-acntPath2Text :: AcntPath -> T.Text
-acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
+  _ -> throwAppError $ LookupError what $ tshow k
 
 --------------------------------------------------------------------------------
 -- error display
 
-showError :: InsertError -> [T.Text]
+showError :: AppError -> [T.Text]
 showError other = case other of
   (StatementError ts ms) -> (showTx <$> ts) ++ (showMatch <$> ms)
   (DaySpanError a b) ->
@@ -562,36 +393,43 @@ showError other = case other of
     where
       showGreg (Just g) = showGregorian_ g
       showGreg Nothing = "Inf"
-  (AccountError a ts) ->
+  (AccountTypeError a ts) ->
     [ T.unwords
         [ "account type of key"
-        , singleQuote a
+        , singleQuote $ unAcntID a
         , "is not one of:"
         , ts_
         ]
     ]
     where
       ts_ = T.intercalate ", " $ NE.toList $ fmap atName ts
-  (PatternError s b r p) -> [T.unwords [msg, "in pattern: ", pat]]
+  (DatePatternError s b r p) -> [T.unwords [msg, "in pattern: ", pat]]
     where
       pat =
         keyVals $
           [ (k, v)
           | (k, Just v) <-
-              [ ("start", Just $ showT s)
-              , ("by", Just $ showT b)
-              , ("repeats", showT <$> r)
+              [ ("start", Just $ tshow s)
+              , ("by", Just $ tshow b)
+              , ("repeats", tshow <$> r)
               ]
           ]
       msg = case p of
         ZeroLength -> "Zero repeat length"
         ZeroRepeats -> "Zero repeats"
   (RegexError re) -> [T.append "could not make regex from pattern: " re]
-  (ConversionError x) -> [T.append "Could not convert to rational number: " x]
-  (InsertIOError msg) -> [T.append "IO Error: " msg]
+  (ConversionError x isDouble) ->
+    [ T.unwords
+        [ "Could not convert to"
+        , if isDouble then "double" else "rational"
+        , "number: "
+        , x
+        ]
+    ]
+  (StatementIOError msg) -> [T.append "IO Error: " msg]
   (ParseError msg) -> [T.append "Parse Error: " msg]
   (MatchValPrecisionError d p) ->
-    [T.unwords ["Match denominator", showT d, "must be less than", showT p]]
+    [T.unwords ["Match denominator", tshow d, "must be less than", tshow p]]
   (LookupError t f) ->
     [T.unwords ["Could not find field", f, "when resolving", what]]
     where
@@ -606,41 +444,45 @@ showError other = case other of
       idName TagField = "tag"
       matchName MatchNumeric = "numeric"
       matchName MatchText = "text"
-  (IncomeError day name balance) ->
-    [ T.unwords
-        [ "Income allocations for budget"
-        , singleQuote name
-        , "exceed total on day"
-        , showT day
-        , "where balance is"
-        , showT (fromRational balance :: Double)
-        ]
-    ]
   (PeriodError start next) ->
     [ T.unwords
         [ "First pay period on "
-        , singleQuote $ showT start
+        , singleQuote $ tshow start
         , "must start before first income payment on "
-        , singleQuote $ showT next
+        , singleQuote $ tshow next
         ]
     ]
-  (BalanceError t cur rss) ->
+  (LinkError i m) ->
     [ T.unwords
-        [ msg
-        , "for currency"
-        , singleQuote cur
-        , "and for entries"
-        , entries
+        [ "entry index"
+        , singleQuote $ tshow i
+        , "out of range: max index is"
+        , singleQuote $ tshow m
         ]
     ]
-    where
-      msg = case t of
-        TooFewEntries -> "Need at least two entries to balance"
-        NotOneBlank -> "Exactly one entries must be blank"
-      entries = T.intercalate ", " $ fmap (singleQuote . showEntry) rss
+  (DBError d) -> case d of
+    DBShouldBeEmpty -> ["database has no rows in 'config_state' but has other data"]
+    DBMultiScope -> ["database has multiple rows in 'config_state'"]
+    DBUpdateUnbalanced -> ["update is missing debit or credit entries"]
+    DBLinkError k l ->
+      let k' = T.append "in entry key: " $ tshow $ E.fromSqlKey k
+       in case l of
+            DBLinkNoScale -> [T.append "no link scale" k']
+            DBLinkNoValue -> [T.append "no link value" k']
+            DBLinkInvalidValue v isfixed ->
+              [ T.unwords
+                  [ if isfixed
+                      then "fixed link should not have value"
+                      else "untyped value is ambiguous"
+                  , singleQuote $ tshow v
+                  , k'
+                  ]
+              ]
+            DBLinkInvalidBalance -> [T.append "no value given for balance link" k']
+            DBLinkInvalidPercent -> [T.append "no value given for percent link" k']
 
 showGregorian_ :: Gregorian -> T.Text
-showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay]
+showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ tshow <$> [gYear, gMonth, gDay]
 
 showTx :: TxRecord -> T.Text
 showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
@@ -648,8 +490,8 @@ showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
     keyVals
       [ ("path", T.pack f)
       , ("date", T.pack $ iso8601Show d)
-      , ("value", showT (fromRational v :: Float))
-      , ("description", doubleQuote e)
+      , ("value", tshow v)
+      , ("description", doubleQuote $ unTxDesc e)
       ]
 
 showMatch :: MatchRe -> T.Text
@@ -661,8 +503,8 @@ showMatch StatementParser {spDate, spVal, spDesc, spOther, spTimes, spPriority}
       , ("val", showValMatcher spVal)
       , ("desc", fst <$> spDesc)
       , ("other", others)
-      , ("counter", Just $ maybe "Inf" showT spTimes)
-      , ("priority", Just $ showT spPriority)
+      , ("counter", Just $ maybe "Inf" tshow spTimes)
+      , ("priority", Just $ tshow spPriority)
       ]
     others = case spOther of
       [] -> Nothing
@@ -695,7 +537,7 @@ showYMDMatcher = showYMD_ . fromYMDMatcher
 
 showYMD_ :: YMD_ -> T.Text
 showYMD_ md =
-  T.intercalate "-" $ L.take 3 (fmap showT digits ++ L.repeat "*")
+  T.intercalate "-" $ L.take 3 (fmap tshow digits ++ L.repeat "*")
   where
     digits = case md of
       Y_ y -> [fromIntegral y]
@@ -709,9 +551,9 @@ showValMatcher ValMatcher {vmNum, vmDen, vmSign, vmPrec} =
   where
     kvs =
       [ ("sign", (\s -> if s then "+" else "-") <$> vmSign)
-      , ("numerator", showT <$> vmNum)
-      , ("denominator", showT <$> vmDen)
-      , ("precision", Just $ showT vmPrec)
+      , ("numerator", tshow <$> vmNum)
+      , ("denominator", tshow <$> vmDen)
+      , ("precision", Just $ tshow vmPrec)
       ]
 
 showMatchOther :: FieldMatcherRe -> T.Text
@@ -725,14 +567,6 @@ showMatchOther (Val (Field f mv)) =
     , singleQuote $ fromMaybe "*" $ showValMatcher mv
     ]
 
-showEntry :: RawEntry -> T.Text
-showEntry Entry {eAcnt, eValue, eComment} =
-  keyVals
-    [ ("account", eAcnt)
-    , ("value", T.pack $ show ((fromRational <$> eValue) :: Maybe Float))
-    , ("comment", doubleQuote eComment)
-    ]
-
 singleQuote :: T.Text -> T.Text
 singleQuote t = T.concat ["'", t, "'"]
 
@@ -745,184 +579,474 @@ keyVal a b = T.concat [a, "=", b]
 keyVals :: [(T.Text, T.Text)] -> T.Text
 keyVals = T.intercalate "; " . fmap (uncurry keyVal)
 
-showT :: Show a => a -> T.Text
-showT = T.pack . show
-
---------------------------------------------------------------------------------
--- pure error processing
-
--- concatEither2 :: Either x a -> Either x b -> (a -> b -> c) -> Either [x] c
--- concatEither2 a b fun = case (a, b) of
---   (Right a_, Right b_) -> Right $ fun a_ b_
---   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
-
--- concatEither2M :: Monad m => Either x a -> Either x b -> (a -> b -> m c) -> m (Either [x] c)
--- concatEither2M a b fun = case (a, b) of
---   (Right a_, Right b_) -> Right <$> fun a_ b_
---   _ -> return $ Left $ catMaybes [leftToMaybe a, leftToMaybe b]
-
--- concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
--- concatEither3 a b c fun = case (a, b, c) of
---   (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
---   _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
-
--- concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
--- concatEithers2 a b = merge . concatEither2 a b
-
--- concatEithers2M
---   :: Monad m
---   => Either [x] a
---   -> Either [x] b
---   -> (a -> b -> m c)
---   -> m (Either [x] c)
--- concatEithers2M a b = fmap merge . concatEither2M a b
-
--- concatEithers3
---   :: Either [x] a
---   -> Either [x] b
---   -> Either [x] c
---   -> (a -> b -> c -> d)
---   -> Either [x] d
--- concatEithers3 a b c = merge . concatEither3 a b c
-
--- concatEitherL :: [Either x a] -> Either [x] [a]
--- concatEitherL as = case partitionEithers as of
---   ([], bs) -> Right bs
---   (es, _) -> Left es
-
--- concatEithersL :: [Either [x] a] -> Either [x] [a]
--- concatEithersL = merge . concatEitherL
-
--- leftToMaybe :: Either a b -> Maybe a
--- leftToMaybe (Left a) = Just a
--- leftToMaybe _ = Nothing
-
-unlessLeft :: (Monad m, MonadPlus n) => Either a b -> (b -> m (n a)) -> m (n a)
-unlessLeft (Left es) _ = return (return es)
-unlessLeft (Right rs) f = f rs
-
-unlessLefts :: (Monad m) => Either (n a) b -> (b -> m (n a)) -> m (n a)
-unlessLefts (Left es) _ = return es
-unlessLefts (Right rs) f = f rs
-
-unlessLeft_ :: (Monad m, MonadPlus n) => Either a b -> (b -> m ()) -> m (n a)
-unlessLeft_ e f = unlessLeft e (\x -> void (f x) >> return mzero)
-
-unlessLefts_ :: (Monad m, MonadPlus n) => Either (n a) b -> (b -> m ()) -> m (n a)
-unlessLefts_ e f = unlessLefts e (\x -> void (f x) >> return mzero)
-
--- plural :: Either a b -> Either [a] b
--- plural = first (: [])
-
--- merge :: Either [[a]] b -> Either [a] b
--- merge = first concat
-
 --------------------------------------------------------------------------------
 -- random functions
 
--- when bifunctor fails...
--- thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
--- thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
+groupKey :: Ord c => (a -> c) -> [(a, b)] -> [(a, NonEmpty b)]
+groupKey f = fmap go . NE.groupAllWith (f . fst)
+  where
+    go xs@((c, _) :| _) = (c, fmap snd xs)
+
+groupWith :: Ord b => (a -> b) -> [a] -> [(b, NonEmpty a)]
+groupWith f = fmap go . NE.groupAllWith fst . fmap (\x -> (f x, x))
+  where
+    go xs@((c, _) :| _) = (c, fmap snd xs)
+
+mapAdd_ :: (Ord k, Num v) => k -> v -> M.Map k v -> M.Map k v
+mapAdd_ k v = M.alter (maybe (Just v) (Just . (+ v))) k
 
 uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
 uncurry3 f (a, b, c) = f a b c
 
-fstOf3 :: (a, b, c) -> a
-fstOf3 (a, _, _) = a
+lookupAccount :: (MonadAppError m, MonadFinance m) => AcntID -> m (AccountRId, AcntType)
+lookupAccount = lookupFinance AcntField csAccountMap
 
-sndOf3 :: (a, b, c) -> b
-sndOf3 (_, b, _) = b
+lookupAccountKey :: (MonadAppError m, MonadFinance m) => AcntID -> m AccountRId
+lookupAccountKey = fmap fst . lookupAccount
 
-thdOf3 :: (a, b, c) -> c
-thdOf3 (_, _, c) = c
+lookupAccountType :: (MonadAppError m, MonadFinance m) => AcntID -> m AcntType
+lookupAccountType = fmap snd . lookupAccount
 
--- lpad :: a -> Int -> [a] -> [a]
--- lpad c n s = replicate (n - length s) c ++ s
+lookupCurrency :: (MonadAppError m, MonadFinance m) => CurID -> m CurrencyPrec
+lookupCurrency = lookupFinance CurField csCurrencyMap
 
--- rpad :: a -> Int -> [a] -> [a]
--- rpad c n s = s ++ replicate (n - length s) c
+lookupCurrencyKey :: (MonadAppError m, MonadFinance m) => CurID -> m CurrencyRId
+lookupCurrencyKey = fmap cpID . lookupCurrency
 
--- lpadT :: Char -> Int -> T.Text -> T.Text
--- lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
+lookupCurrencyPrec :: (MonadAppError m, MonadFinance m) => CurID -> m Precision
+lookupCurrencyPrec = fmap cpPrec . lookupCurrency
 
--- TODO this regular expression appears to be compiled each time, which is
--- super slow
--- NOTE: see https://github.com/haskell-hvr/regex-tdfa/issues/9 - performance
--- is likely not going to be optimal for text
--- matchMaybe :: T.Text -> T.Text -> EitherErr Bool
--- matchMaybe q pat = case compres of
---   Right re -> case execute re q of
---     Right res -> Right $ isJust res
---     Left _ -> Left $ RegexError "this should not happen"
---   Left _ -> Left $ RegexError pat
---   where
---     -- these options barely do anything in terms of performance
---     compres = compile (blankCompOpt {newSyntax = True}) (blankExecOpt {captureGroups = False}) pat
-
-compileOptions :: TxOpts T.Text -> InsertExcept TxOptsRe
-compileOptions o@TxOpts {toAmountFmt = pat} = do
-  re <- compileRegex True pat
-  return $ o {toAmountFmt = re}
-
-compileMatch :: StatementParser T.Text -> InsertExcept MatchRe
-compileMatch m@StatementParser {spDesc, spOther} = do
-  combineError dres ores $ \d os -> m {spDesc = d, spOther = os}
-  where
-    go = compileRegex False
-    dres = mapM go spDesc
-    ores = combineErrors $ fmap (mapM go) spOther
-
-compileRegex :: Bool -> T.Text -> InsertExcept (Text, Regex)
-compileRegex groups pat = case res of
-  Right re -> return (pat, re)
-  Left _ -> throwError $ InsertException [RegexError pat]
-  where
-    res =
-      compile
-        (blankCompOpt {newSyntax = True})
-        (blankExecOpt {captureGroups = groups})
-        pat
-
-matchMaybe :: T.Text -> Regex -> InsertExcept Bool
-matchMaybe q re = case execute re q of
-  Right res -> return $ isJust res
-  Left _ -> throwError $ InsertException [RegexError "this should not happen"]
-
-matchGroupsMaybe :: T.Text -> Regex -> [T.Text]
-matchGroupsMaybe q re = case regexec re q of
-  Right Nothing -> []
-  Right (Just (_, _, _, xs)) -> xs
-  -- this should never fail as regexec always returns Right
-  Left _ -> []
-
-lookupAccount :: (MonadInsertError m, MonadFinance m) => AcntID -> m (AccountRId, AcntSign, AcntType)
-lookupAccount = lookupFinance AcntField kmAccount
-
-lookupAccountKey :: (MonadInsertError m, MonadFinance m) => AcntID -> m AccountRId
-lookupAccountKey = fmap fstOf3 . lookupAccount
-
-lookupAccountSign :: (MonadInsertError m, MonadFinance m) => AcntID -> m AcntSign
-lookupAccountSign = fmap sndOf3 . lookupAccount
-
-lookupAccountType :: (MonadInsertError m, MonadFinance m) => AcntID -> m AcntType
-lookupAccountType = fmap thdOf3 . lookupAccount
-
-lookupCurrency :: (MonadInsertError m, MonadFinance m) => T.Text -> m (CurrencyRId, Natural)
-lookupCurrency = lookupFinance CurField kmCurrency
-
-lookupCurrencyKey :: (MonadInsertError m, MonadFinance m) => AcntID -> m CurrencyRId
-lookupCurrencyKey = fmap fst . lookupCurrency
-
-lookupCurrencyPrec :: (MonadInsertError m, MonadFinance m) => AcntID -> m Natural
-lookupCurrencyPrec = fmap snd . lookupCurrency
-
-lookupTag :: (MonadInsertError m, MonadFinance m) => TagID -> m TagRId
-lookupTag = lookupFinance TagField kmTag
+lookupTag :: (MonadAppError m, MonadFinance m) => TagID -> m TagRId
+lookupTag = lookupFinance TagField csTagMap
 
 lookupFinance
-  :: (MonadInsertError m, MonadFinance m)
+  :: (MonadAppError m, MonadFinance m, Ord k, Show k)
   => EntryIDType
-  -> (DBState -> M.Map T.Text a)
-  -> T.Text
+  -> (ConfigState -> M.Map k a)
+  -> k
   -> m a
-lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< askDBState f
+lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< asks f
+
+balanceTxs
+  :: (MonadAppError m, MonadFinance m)
+  => [EntryCRU]
+  -> m ([UEBalanced], [InsertTx])
+balanceTxs ebs =
+  first concat . partitionEithers . catMaybes
+    <$> evalStateT (mapErrors go $ L.sortOn binDate ebs) M.empty
+  where
+    go (ToUpdate utx) =
+      fmap (Just . Left) $
+        liftInnerS $
+          either rebalanceTotalEntrySet rebalanceFullEntrySet utx
+    go (ToRead ReadEntry {reCurrency, reAcnt, reValue, reBudget}) = do
+      modify $ mapAdd_ (reAcnt, (reCurrency, reBudget)) reValue
+      return Nothing
+    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 =
+            -- 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 txBudget)
+            (balancePrimaryEntrySet txBudget . fromShadow tot)
+        fromShadow tot e@EntrySet {esTotalValue} = e {esTotalValue = tot *. esTotalValue}
+
+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 {utDate, utPriority} = (utDate, utPriority)
+
+type BCKey = (CurrencyRId, BudgetName)
+
+type ABCKey = (AccountRId, BCKey)
+
+type EntryBals = M.Map ABCKey Decimal
+
+--------------------------------------------------------------------------------
+-- rebalancing
+
+-- TODO make sure new values are rounded properly here
+rebalanceTotalEntrySet :: TotalUpdateEntrySet -> State EntryBals [UEBalanced]
+rebalanceTotalEntrySet
+  UpdateEntrySet
+    { utFrom0 = (f0@UpdateEntry {ueAcnt = f0Acnt}, f0links)
+    , utTo0
+    , utFromUnk
+    , utToUnk
+    , utFromRO
+    , utToRO
+    , utCurrency
+    , utTotalValue
+    , utBudget
+    } =
+    do
+      (fval, fs, tpairs) <- rebalanceDebit bc utFromRO utFromUnk
+      let f0val = utTotalValue - fval
+      modify $ mapAdd_ (f0Acnt, bc) f0val
+      let tsLinked = tpairs ++ (unlink f0val <$> f0links)
+      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
+  UpdateEntrySet
+    { utFrom0
+    , utTo0
+    , utFromUnk
+    , utToUnk
+    , utFromRO
+    , utToRO
+    , utCurrency
+    , utBudget
+    } =
+    do
+      (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
+  -> [UE_RO]
+  -> [(UEUnk, [UELink])]
+  -> State EntryBals (Decimal, [UEBalanced], [UEBalanced])
+rebalanceDebit k ro linked = do
+  (tot, (tpairs, fs)) <-
+    fmap (second (partitionEithers . concat)) $
+      sumM goFrom $
+        L.sortOn idx $
+          (Left <$> ro) ++ (Right <$> linked)
+  return (tot, fs, tpairs)
+  where
+    idx = either ueIndex (ueIndex . fst)
+    goFrom (Left e) = (,[]) <$> updateFixed k e
+    goFrom (Right (e0, es)) = do
+      v <- updateUnknown k e0
+      let e0' = Right $ e0 {ueValue = StaticValue v}
+      let es' = Left . unlink v <$> es
+      return (v, e0' : es')
+
+unlink :: Decimal -> UELink -> UEBalanced
+unlink v e = e {ueValue = StaticValue $ (-v) *. unLinkScale (ueValue e)}
+
+rebalanceCredit
+  :: BCKey
+  -> Decimal
+  -> UEBlank
+  -> [UEUnk]
+  -> [UE_RO]
+  -> [UEBalanced]
+  -> State EntryBals [UEBalanced]
+rebalanceCredit k tot t0 us rs bs = do
+  (tval, ts) <-
+    fmap (second catMaybes) $
+      sumM goTo $
+        L.sortOn idx $
+          (UETLinked <$> bs)
+            ++ (UETUnk <$> us)
+            ++ (UETReadOnly <$> rs)
+  return (t0 {ueValue = StaticValue (-(tot + tval))} : ts)
+  where
+    idx = projectUET ueIndex ueIndex ueIndex
+    goTo (UETReadOnly e) = (,Nothing) <$> updateFixed k e
+    goTo (UETLinked e) = (,Just e) <$> updateFixed k e
+    goTo (UETUnk e) = do
+      v <- updateUnknown k e
+      return (v, Just $ e {ueValue = StaticValue v})
+
+data UpdateEntryType a b
+  = UETReadOnly UE_RO
+  | UETUnk a
+  | UETLinked b
+
+projectUET :: (UE_RO -> c) -> (a -> c) -> (b -> c) -> UpdateEntryType a b -> c
+projectUET f _ _ (UETReadOnly e) = f e
+projectUET _ f _ (UETUnk e) = f e
+projectUET _ _ f (UETLinked p) = f p
+
+updateFixed :: BCKey -> UpdateEntry i StaticValue -> State EntryBals Decimal
+updateFixed k e = do
+  let v = unStaticValue $ ueValue e
+  modify $ mapAdd_ (ueAcnt e, k) v
+  return v
+
+updateUnknown :: BCKey -> UpdateEntry i EntryValueUnk -> State EntryBals Decimal
+updateUnknown k e = do
+  let key = (ueAcnt e, k)
+  curBal <- gets (M.findWithDefault 0 key)
+  let v = case ueValue e of
+        EVPercent p -> curBal *. p
+        EVBalance p -> p - curBal
+  modify $ mapAdd_ key v
+  return v
+
+--------------------------------------------------------------------------------
+-- balancing
+
+balancePrimaryEntrySet
+  :: (MonadAppError m, MonadFinance m)
+  => BudgetName
+  -> PrimaryEntrySet
+  -> StateT EntryBals m InsertEntrySet
+balancePrimaryEntrySet
+  budgetName
+  EntrySet
+    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
+    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
+    , esCurrency
+    , esTotalValue
+    } =
+    do
+      let f0res = resolveAcntAndTags f0
+      let t0res = resolveAcntAndTags t0
+      let fsres = mapErrors resolveAcntAndTags fs
+      let tsres = mapErrors resolveAcntAndTags ts
+      let bc = (esCurrency, budgetName)
+      combineErrorM (combineError f0res fsres (,)) (combineError t0res tsres (,)) $
+        \(f0', fs') (t0', ts') -> do
+          let balFrom = fmap liftInnerS . balanceDeferred
+          fs'' <- balanceTotalEntrySet balFrom bc esTotalValue f0' fs'
+          balanceFinal bc (-esTotalValue) fs'' t0' ts'
+
+balanceSecondaryEntrySet
+  :: (MonadAppError m, MonadFinance m)
+  => BudgetName
+  -> SecondayEntrySet
+  -> StateT EntryBals m InsertEntrySet
+balanceSecondaryEntrySet
+  budgetName
+  EntrySet
+    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
+    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
+    , esCurrency
+    } =
+    do
+      let fsRes = mapErrors resolveAcntAndTags (f0 :| fs)
+      let t0Res = resolveAcntAndTags t0
+      let tsRes = mapErrors resolveAcntAndTags ts
+      combineErrorM fsRes (combineError t0Res tsRes (,)) $ \fs' (t0', ts') -> do
+        fs'' <- mapErrors balFrom fs'
+        let tot = entrySum (NE.toList fs'')
+        balanceFinal bc (-tot) fs'' t0' ts'
+    where
+      entrySum = sum . fmap (eValue . ieEntry)
+      balFrom = balanceEntry (fmap liftInnerS . balanceDeferred) bc
+      bc = (esCurrency, budgetName)
+
+balanceFinal
+  :: (MonadAppError m)
+  => BCKey
+  -> Decimal
+  -> NonEmpty InsertEntry
+  -> Entry AccountRId () TagRId
+  -> [Entry AccountRId EntryLink TagRId]
+  -> StateT EntryBals m InsertEntrySet
+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 k tot t0 ts
+  return $
+    InsertEntrySet
+      { iesCurrency = curID
+      , iesFromEntries = fs
+      , iesToEntries = ts'
+      }
+
+balanceTotalEntrySet
+  :: (MonadAppError m)
+  => (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe CachedEntry))
+  -> BCKey
+  -> Decimal
+  -> Entry AccountRId () TagRId
+  -> [Entry AccountRId v TagRId]
+  -> StateT EntryBals m (NonEmpty InsertEntry)
+balanceTotalEntrySet f k tot e@Entry {eAcnt = acntID} es = do
+  es' <- mapErrors (balanceEntry f k) es
+  let e0val = tot - entrySum es'
+  -- TODO not dry
+  modify (mapAdd_ (acntID, k) e0val)
+  let e' =
+        InsertEntry
+          { ieEntry = e {eValue = e0val, eAcnt = acntID}
+          , ieCached = Nothing
+          }
+  return $ e' :| es'
+  where
+    entrySum = sum . fmap (eValue . ieEntry)
+
+liftInnerS :: Monad m => StateT e Identity a -> StateT e m a
+liftInnerS = mapStateT (return . runIdentity)
+
+balanceLinked
+  :: MonadAppError m
+  => Vector Decimal
+  -> ABCKey
+  -> EntryLink
+  -> StateT EntryBals m (Decimal, Maybe CachedEntry)
+balanceLinked from k lg = case lg of
+  (LinkIndex LinkedNumGetter {lngIndex, lngScale}) -> do
+    let i = fromIntegral lngIndex
+        upper = EntryIndex $ V.length from
+        res = fmap (go lngScale) $ from V.!? i
+    case res of
+      Just v -> return (v, Just $ CachedLink (EntryIndex $ fromIntegral lngIndex) (LinkScale lngScale))
+      Nothing -> throwAppError $ LinkError (EntryIndex i) upper
+  (LinkValue d) -> liftInnerS $ balanceDeferred k d
+  where
+    go s = negate . (*. s)
+
+balanceDeferred :: ABCKey -> EntryValue -> State EntryBals (Decimal, Maybe CachedEntry)
+balanceDeferred k e = do
+  newval <- findBalance k e
+  let d = case e of
+        EntryFixed _ -> Nothing
+        EntryBalance v -> Just $ CachedBalance v
+        EntryPercent v -> Just $ CachedPercent v
+  return (newval, d)
+
+balanceEntry
+  :: (MonadAppError m)
+  => (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe CachedEntry))
+  -> BCKey
+  -> Entry AccountRId v TagRId
+  -> StateT EntryBals m InsertEntry
+balanceEntry f k e@Entry {eValue, eAcnt = acntID} = do
+  (newVal, cached) <- f (acntID, k) eValue
+  modify (mapAdd_ (acntID, k) newVal)
+  return $
+    InsertEntry
+      { ieEntry = e {eValue = newVal, eAcnt = acntID}
+      , ieCached = cached
+      }
+
+resolveAcntAndTags
+  :: (MonadAppError m, MonadFinance m)
+  => Entry AcntID v TagID
+  -> m (Entry AccountRId v TagRId)
+resolveAcntAndTags e@Entry {eAcnt, eTags} = do
+  let acntRes = lookupAccountKey eAcnt
+  let tagRes = mapErrors lookupTag eTags
+  combineError acntRes tagRes $ \a ts -> e {eAcnt = a, eTags = ts}
+
+findBalance :: ABCKey -> EntryValue -> State EntryBals Decimal
+findBalance k e = do
+  curBal <- gets (M.findWithDefault 0 k)
+  return $ case e of
+    EntryBalance b -> b - curBal
+    EntryPercent p -> curBal *. p
+    EntryFixed v -> v
+
+--------------------------------------------------------------------------------
+-- transfers
+
+expandTransfers
+  :: (MonadAppError m, MonadFinance m)
+  => CommitR
+  -> BudgetName
+  -> DaySpan
+  -> [PairedTransfer]
+  -> m [Tx CommitR]
+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 name bounds Transfer {transAmounts, transTo, transCurrency, transFrom} = do
+  txs <- mapErrors go transAmounts
+  return $ concat txs
+  where
+    go
+      Amount
+        { amtWhen = pat
+        , amtValue = TransferValue {tvVal = v, tvType = t}
+        , amtDesc = desc
+        , amtPriority = pri
+        } = do
+        cp <- lookupCurrency transCurrency
+        let v' = (-v)
+        let dec = realFracToDecimalP (cpPrec cp) v'
+        let v'' = case t of
+              TFixed -> EntryFixed dec
+              TPercent -> EntryPercent v'
+              TBalance -> EntryBalance dec
+        withDates bounds pat $ \day ->
+          return
+            Tx
+              { txCommit = tc
+              , txDate = day
+              , txPrimary = Right $ entryPair transFrom transTo (cpID cp) desc () v''
+              , txOther = []
+              , txDescr = TxDesc desc
+              , txBudget = name
+              , txPriority = fromIntegral pri
+              }
+
+entryPair
+  :: TaggedAcnt
+  -> TaggedAcnt
+  -> CurrencyRId
+  -> T.Text
+  -> v0
+  -> v1
+  -> EntrySet v0 v1 v2 v3
+entryPair (TaggedAcnt fa fts) (TaggedAcnt ta tts) curid com totval val1 =
+  EntrySet
+    { esCurrency = curid
+    , esTotalValue = totval
+    , esFrom = halfEntry (AcntID fa) (TagID <$> fts) val1
+    , esTo = halfEntry (AcntID ta) (TagID <$> tts) ()
+    }
+  where
+    halfEntry :: AcntID -> [TagID] -> v -> HalfEntrySet v v0
+    halfEntry a ts v =
+      HalfEntrySet
+        { hesPrimary = Entry {eAcnt = a, eValue = v, eComment = com, eTags = ts}
+        , hesOther = []
+        }
+
+withDates
+  :: (MonadFinance m, MonadAppError m)
+  => DaySpan
+  -> DatePat
+  -> (Day -> m a)
+  -> m [a]
+withDates bounds dp f = do
+  days <- liftExcept $ expandDatePat bounds dp
+  combineErrors $ fmap f days
+
+sumM :: (Monad m, Num s) => (a -> m (s, b)) -> [a] -> m (s, [b])
+sumM f = mapAccumM (\s -> fmap (first (+ s)) . f) 0
+
+mapAccumM :: (Monad m) => (s -> a -> m (s, b)) -> s -> [a] -> m (s, [b])
+mapAccumM f s = foldM (\(s', ys) -> fmap (second (: ys)) . f s') (s, [])
+
+realFracToDecimalP :: (Integral i, RealFrac r) => Precision -> r -> DecimalRaw i
+realFracToDecimalP p = realFracToDecimal (unPrecision p)
+
+roundToP :: Integral i => Precision -> DecimalRaw i -> DecimalRaw i
+roundToP p = roundTo (unPrecision p)
diff --git a/package.yaml b/package.yaml
index 93b2fc3..2801a9a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -87,6 +87,7 @@ dependencies:
 - filepath
 - mtl
 - persistent-mtl >= 0.3.0.0
+- Decimal >= 0.5.2
 
 library:
   source-dirs: lib/