WIP add logic for updating entries and summing read only entries

lib/Internal/Database.hs

@@ -8,6 +8,7 @@ module Internal.Database
   , flattenAcntRoot
   , paths2IDs
   , mkPool
+  , whenHash0
   , whenHash
   , whenHash_
   , insertEntry
@@ -380,6 +381,18 @@ whenHash t o def f = do
   hs <- askDBState kmNewCommits
   if h `elem` hs then f =<< insert (CommitR h t) else return def
 
+whenHash0
+  :: (Hashable a, MonadFinance m)
+  => ConfigType
+  -> a
+  -> b
+  -> (CommitR -> m b)
+  -> m b
+whenHash0 t o def f = do
+  let h = hash o
+  hs <- askDBState kmNewCommits
+  if h `elem` hs then f (CommitR h t) else return def
+
 whenHash_
   :: (Hashable a, MonadFinance m)
   => ConfigType

lib/Internal/History.hs

@@ -38,21 +38,21 @@ import qualified RIO.Vector as V
 readHistTransfer
   :: (MonadInsertError m, MonadFinance m)
   => HistTransfer
-  -> m (Maybe (CommitR, [DeferredTx]))
+  -> m [DeferredTx CommitR]
 readHistTransfer
   m@Transfer
     { transFrom = from
     , transTo = to
     , transCurrency = u
     , transAmounts = amts
-    } = do
+    } =
-    whenHash_ CTManual m $ do
+    whenHash0 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
+            let tx day = txPair c day from to u (roundPrecision precision amtValue) amtDesc
             return $ fmap tx days
       concat <$> mapErrors go amts
 
@@ -61,15 +61,20 @@ groupKey f = fmap go . NE.groupAllWith (f . fst)
   where
     go xs@((c, _) :| _) = (c, NE.toList $ fmap snd xs)
 
+groupWith :: Ord b => (a -> b) -> [a] -> [(b, [a])]
+groupWith f = fmap go . NE.groupAllWith fst . fmap (\x -> (f x, x))
+  where
+    go xs@((c, _) :| _) = (c, NE.toList $ fmap snd xs)
+
 readHistStmt
   :: (MonadUnliftIO m, MonadFinance m)
   => FilePath
   -> Statement
-  -> m (Maybe (CommitR, [DeferredTx]))
+  -> m [DeferredTx CommitR]
-readHistStmt root i = whenHash_ CTImport i $ do
+readHistStmt root i = whenHash0 CTImport i [] $ \c -> do
   bs <- readImport root i
   bounds <- askDBState kmStatementInterval
-  return $ filter (inDaySpan bounds . txDate) bs
+  return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = c}) bs
 
 splitHistory :: [History] -> ([HistTransfer], [Statement])
 splitHistory = partitionEithers . fmap go
@@ -79,11 +84,11 @@ splitHistory = partitionEithers . fmap go
 
 insertHistory
   :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => [(CommitR, [DeferredTx])]
+  => [DeferredTx CommitR]
   -> m ()
 insertHistory hs = do
-  bs <- balanceTxs $ concatMap (\(c, xs) -> fmap (c,) xs) hs
+  bs <- balanceTxs hs
-  forM_ (groupKey (\(CommitR h _) -> h) bs) $ \(c, ts) -> do
+  forM_ (groupWith txCommit bs) $ \(c, ts) -> do
     ck <- insert c
     mapM_ (insertTx ck) ts
 
@@ -92,17 +97,19 @@ insertHistory hs = do
 
 -- TODO tags here?
 txPair
-  :: Day
+  :: CommitR
+  -> Day
   -> AcntID
   -> AcntID
   -> CurID
   -> Rational
   -> T.Text
-  -> DeferredTx
+  -> DeferredTx CommitR
-txPair day from to cur val desc =
+txPair commit day from to cur val desc =
   Tx
     { txDescr = desc
     , txDate = day
+    , txCommit = commit
     , txEntries =
         [ EntrySet
             { esTotalValue = -val
@@ -121,20 +128,21 @@ txPair day from to cur val desc =
         , eTags = []
         }
 
-resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
+-- resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx CommitR -> m (KeyTx CommitR)
-resolveTx t@Tx {txEntries = ss} =
+-- resolveTx t@Tx {txEntries = ss} =
-  (\kss -> t {txEntries = kss}) <$> mapErrors resolveEntry ss
+--   (\kss -> t {txEntries = kss}) <$> mapErrors resolveEntry ss
 
-insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
+insertTx :: MonadSqlQuery m => CommitRId -> (KeyTx CommitR) -> m ()
 insertTx c Tx {txDate = d, txDescr = e, txEntries = ss} = do
-  k <- insert $ TransactionR c d e
+  let anyDeferred = any (isJust . feDeferred) ss
+  k <- insert $ TransactionR c d e anyDeferred
   mapM_ (insertEntry k) ss
 
 --------------------------------------------------------------------------------
 -- Statements
 
 -- TODO this probably won't scale well (pipes?)
-readImport :: (MonadUnliftIO m, MonadFinance m) => FilePath -> Statement -> m [DeferredTx]
+readImport :: (MonadUnliftIO m, MonadFinance m) => FilePath -> Statement -> m [DeferredTx ()]
 readImport root Statement {stmtTxOpts, stmtParsers, stmtSkipLines, stmtDelim, stmtPaths} = do
   let ores = compileOptions stmtTxOpts
   let cres = combineErrors $ compileMatch <$> stmtParsers
@@ -182,7 +190,7 @@ parseTxRecord p TxOpts {toDate, toAmountFmt, toDesc, toAmount, toOther, toDateFm
 
 -- TODO need to somehow balance temporally here (like I do in the budget for
 -- directives that "pay off" a balance)
-matchRecords :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM [DeferredTx]
+matchRecords :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM [DeferredTx ()]
 matchRecords ms rs = do
   (matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
   case (matched, unmatched, notfound) of
@@ -243,7 +251,7 @@ zipperSlice f x = go
 zipperMatch
   :: Unzipped MatchRe
   -> TxRecord
-  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes DeferredTx)
+  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes (DeferredTx ()))
 zipperMatch (Unzipped bs cs as) x = go [] cs
   where
     go _ [] = return (Zipped bs $ cs ++ as, MatchFail)
@@ -259,7 +267,7 @@ zipperMatch (Unzipped bs cs as) x = go [] cs
 zipperMatch'
   :: Zipped MatchRe
   -> TxRecord
-  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes DeferredTx)
+  -> InsertExceptT CurrencyM (Zipped MatchRe, MatchRes (DeferredTx ()))
 zipperMatch' z x = go z
   where
     go (Zipped bs (a : as)) = do
@@ -276,7 +284,7 @@ matchDec m = case spTimes m of
   Just n -> Just $ m {spTimes = Just $ n - 1}
   Nothing -> Just m
 
-matchAll :: [MatchGroup] -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx], [TxRecord], [MatchRe])
+matchAll :: [MatchGroup] -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx ()], [TxRecord], [MatchRe])
 matchAll = go ([], [])
   where
     go (matched, unused) gs rs = case (gs, rs) of
@@ -286,13 +294,13 @@ matchAll = go ([], [])
         (ts, unmatched, us) <- matchGroup g rs
         go (ts ++ matched, us ++ unused) gs' unmatched
 
-matchGroup :: MatchGroup -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx], [TxRecord], [MatchRe])
+matchGroup :: MatchGroup -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx ()], [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 ([DeferredTx], [TxRecord], [MatchRe])
+matchDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx ()], [TxRecord], [MatchRe])
 matchDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
@@ -313,7 +321,7 @@ 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 ([DeferredTx], [TxRecord], [MatchRe])
+matchNonDates :: [MatchRe] -> [TxRecord] -> InsertExceptT CurrencyM ([DeferredTx ()], [TxRecord], [MatchRe])
 matchNonDates ms = go ([], [], initZipper ms)
   where
     go (matched, unmatched, z) [] =
@@ -332,25 +340,96 @@ matchNonDates ms = go ([], [], initZipper ms)
 
 balanceTxs
   :: (MonadInsertError m, MonadFinance m)
-  => [(CommitR, DeferredTx)]
+  => [EntryBin]
-  -> m [(CommitR, KeyTx)]
+  -> m ([UpdateEntry EntryRId Rational], [KeyTx CommitR])
-balanceTxs ts = do
+balanceTxs es =
-  keyts <- mapErrors resolveTx =<< evalStateT (mapM go ts') M.empty
+  (first concat . partitionEithers . catMaybes)
-  return $ zip cs keyts
+    <$> evalStateT (mapM go $ L.sortOn binDate es) M.empty
   where
-    (cs, ts') = L.unzip $ L.sortOn (txDate . snd) ts
+    go (ToUpdate utx) = (Just . Left) <$> rebalanceEntrySet utx
-    go t@Tx {txEntries, txDate} =
+    go (ToRead ReadEntry {reCurrency, reAcnt, reValue}) = do
-      (\es -> t {txEntries = concat es}) <$> mapM (balanceEntrySet txDate) txEntries
+      modify $ mapAdd_ (reAcnt, reCurrency) reValue
+      return Nothing
+    go (ToInsert (t@Tx {txEntries, txDate})) =
+      (\es -> Just $ Right $ t {txEntries = concat es})
+        <$> mapM (balanceEntrySet txDate) txEntries
 
-type EntryBals = M.Map (AcntID, CurID) Rational
+binDate :: EntryBin -> Day
+binDate (ToUpdate (UpdateEntrySet {utDate})) = utDate
+binDate (ToRead ReadEntry {reDate}) = reDate
+binDate (ToInsert (Tx {txDate})) = txDate
+
+type EntryBals = M.Map (AccountRId, CurrencyRId) Rational
+
+data UpdateEntryType a
+  = UEReadOnly (UpdateEntry () Rational)
+  | UEBlank (UpdateEntry EntryRId Rational)
+  | UEPaired (UpdateEntry EntryRId Rational, UpdateEntry EntryRId a)
+
+rebalanceEntrySet :: UpdateEntrySet -> State EntryBals [UpdateEntry EntryRId Rational]
+rebalanceEntrySet
+  UpdateEntrySet
+    { utFrom0
+    , utTo0
+    , utPairs
+    , utFromUnk
+    , utToUnk
+    , utFromRO
+    , utToRO
+    , utCurrency
+    , utTotalValue
+    } =
+    do
+      let fs =
+            L.sortOn index $
+              (UEReadOnly <$> utFromRO)
+                ++ (UEBlank <$> utFromUnk)
+                ++ (UEPaired <$> utPairs)
+      fs' <- mapM goFrom fs
+      let f0 = utFrom0 {ueValue = utTotalValue - (sum $ fmap value fs')}
+      let (fs'', tpairs) = partitionEithers $ concatMap flatten fs'
+      let ts = (Right <$> tpairs) ++ (Right <$> utToUnk) ++ (Left <$> utToRO)
+      (tsRO, tsUnk) <- partitionEithers <$> mapM goTo ts
+      let t0 = utTo0 {ueValue = utTotalValue - (sum $ (fmap ueValue tsRO) ++ (fmap ueValue tsUnk))}
+      return $ f0 : fs'' ++ t0 : tsUnk
+    where
+      project f _ _ (UEReadOnly e) = f e
+      project _ f _ (UEBlank e) = f e
+      project _ _ f (UEPaired p) = f p
+      index = project ueIndex ueIndex (ueIndex . fst)
+      value = project ueValue ueValue (ueValue . fst)
+      flatten = project (const []) ((: []) . Right) (\(a, b) -> [Right a, Left b])
+      -- TODO the following is wetter than the average groupie
+      goFrom (UEReadOnly e) = do
+        modify $ mapAdd_ (ueAcnt e, utCurrency) (ueValue e)
+        return $ UEReadOnly e
+      goFrom (UEBlank e) = do
+        let key = (ueAcnt e, utCurrency)
+        curBal <- gets (M.findWithDefault 0 key)
+        let newVal = ueValue e - curBal
+        modify $ mapAdd_ key newVal
+        return $ UEBlank $ e {ueValue = newVal}
+      goFrom (UEPaired (e0, e1)) = do
+        let key = (ueAcnt e0, utCurrency)
+        curBal <- gets (M.findWithDefault 0 key)
+        let newVal = ueValue e0 - curBal
+        modify $ mapAdd_ key newVal
+        return $ UEPaired $ (e0 {ueValue = newVal}, e1 {ueValue = -newVal})
+      goTo (Left e) = do
+        modify $ mapAdd_ (ueAcnt e, utCurrency) (ueValue e)
+        return $ Left e
+      goTo (Right e) = do
+        let key = (ueAcnt e, utCurrency)
+        curBal <- gets (M.findWithDefault 0 key)
+        let newVal = ueValue e - curBal
+        modify $ mapAdd_ key newVal
+        return $ Right $ e {ueValue = newVal}
 
--- TODO might be faster to also do all the key stuff here since currency
--- will be looked up for every entry rather then the entire entry set
 balanceEntrySet
   :: (MonadInsertError m, MonadFinance m)
   => Day
   -> DeferredEntrySet
-  -> StateT EntryBals m [BalEntry]
+  -> StateT EntryBals m [KeyEntry]
 balanceEntrySet
   day
   EntrySet
@@ -360,123 +439,82 @@ balanceEntrySet
     , esTotalValue
     } =
     do
-      fs' <- doEntries fs esTotalValue f0
+      -- get currency first and quit immediately on exception since everything
-      -- let fs'' = fmap (\(i, e@Entry {eValue}) -> toFull) $ zip [0 ..] fs'
+      -- downstream depends on this
-      let fv = V.fromList $ fmap eValue fs'
+      (curID, precision) <- lookupCurrency esCurrency
-      let (lts, dts) = partitionEithers $ splitLinked <$> ts
-      lts' <- lift $ mapErrors (resolveLinked fv esCurrency day) lts
-      ts' <- doEntries (dts ++ lts') (-esTotalValue) t0
-      -- let ts'' = fmap (uncurry toFull) $ zip [0 ..] ts'
-      return $ fs' -- ++ ts''
-    where
-      doEntries es tot e0 = do
-        es' <- liftInnerS $ mapM (uncurry (balanceEntry esCurrency)) $ zip [1 ..] es
-        let val0 = tot - entrySum es'
-        modify $ mapAdd_ (eAcnt e0, esCurrency) val0
-        return $ e0 {eValue = val0} : es'
-      doEntriesTo es tot e0 = do
-        es' <- liftInnerS $ mapM (balanceEntry esCurrency) es
-        let val0 = tot - entrySum es'
-        modify $ mapAdd_ (eAcnt e0, esCurrency) val0
-        return $ e0 {eValue = val0} : es'
-      toFullDebit i e target =
-        FullEntry
-          { feEntry = e
-          , feCurrency = esCurrency
-          , feIndex = i
-          , feDeferred = EntryBalance target
-          }
-      splitLinked e@Entry {eValue} = case eValue of
-        LinkIndex l -> Left e {eValue = l}
-        LinkDeferred d -> Right e {eValue = d}
-      entrySum = sum . fmap (eValue . feEntry)
 
+      -- resolve accounts and balance debit entries since we need an array
+      -- of debit entries for linked credit entries later
+      let balFromEntry = balanceEntry (balanceDeferred curID) curID
+      fs' <- doEntries balFromEntry curID esTotalValue f0 fs (NE.iterate (-1) (-1))
+      let fv = V.fromList $ fmap (eValue . feEntry) fs'
+
+      -- finally resolve credit entries
+      let balToEntry = balanceEntry (balanceLinked fv curID precision) curID
+      ts' <- doEntries balToEntry curID (-esTotalValue) t0 ts (NE.iterate (+ 1) 0)
+      return $ fs' ++ ts'
+
+doEntries
+  :: (MonadInsertError m, MonadFinance m)
+  => (Int -> Entry AcntID v TagID -> State EntryBals (FullEntry AccountRId CurrencyRId TagID))
+  -> CurrencyRId
+  -> Rational
+  -> Entry AcntID () TagID
+  -> [Entry AcntID v TagID]
+  -> NonEmpty Int
+  -> StateT EntryBals m [FullEntry AccountRId CurrencyRId TagID]
+doEntries f curID tot e es (i0 :| iN) = do
+  es' <- liftInnerS $ mapM (uncurry f) $ zip iN es
+  let val0 = tot - entrySum es'
+  e' <- balanceEntry (\_ _ -> return (val0, Nothing)) curID i0 e
+  return $ e' : es'
+  where
+    entrySum = sum . fmap (eValue . feEntry)
+
+liftInnerS :: Monad m => StateT e Identity a -> StateT e m a
 liftInnerS = mapStateT (return . runIdentity)
 
-resolveCreditEntry
+balanceLinked
-  :: (MonadInsertError m, MonadFinance m)
+  :: Vector Rational
-  => Vector Rational
+  -> CurrencyRId
-  -> CurID
+  -> Natural
-  -> Day
+  -> AccountRId
-  -> Int
+  -> LinkDeferred Rational
-  -> Entry AcntID LinkedNumGetter TagID
+  -> StateT EntryBals Identity (Rational, Maybe DBDeferred)
-  -> m (FullEntry AcntID CurID TagID)
+balanceLinked from curID precision acntID lg = case lg of
-resolveCreditEntry from cur day index e@Entry {eValue} = do
+  (LinkIndex g@LinkedNumGetter {lngIndex, lngScale}) -> do
-  undefined
+    let res = fmap (go lngScale) $ from V.!? fromIntegral lngIndex
-
+    case res of
-resolveLinked
+      Just v -> return $ (v, Just $ EntryLinked lngIndex $ toRational lngScale)
-  :: (MonadInsertError m, MonadFinance m)
+      Nothing -> throwError undefined
-  => Vector Rational
+  (LinkDeferred d) -> balanceDeferred curID acntID d
-  -> CurID
-  -> Day
-  -> Entry AcntID LinkedNumGetter TagID
-  -> m (Entry AcntID (Deferred Rational) TagID)
-resolveLinked from cur day e@Entry {eValue = LinkedNumGetter {lngIndex, lngScale}} = do
-  curMap <- askDBState kmCurrency
-  case from V.!? fromIntegral lngIndex of
-    Nothing -> throwError $ InsertException [IndexError e day]
-    Just v -> do
-      v' <- liftExcept $ roundPrecisionCur cur curMap $ lngScale * fromRational v
-      return $ e {eValue = Deferred False v'}
-
-unlinkGetter
-  :: (MonadInsertError m, MonadFinance m)
-  => Vector Rational
-  -> CurID
-  -> LinkedNumGetter
-  -> m (Maybe Rational)
-unlinkGetter from cur LinkedNumGetter {lngIndex, lngScale} = do
-  curMap <- askDBState kmCurrency
-  maybe (return Nothing) (go curMap) $ from V.!? fromIntegral lngIndex
   where
-    go m = fmap Just . liftExcept . roundPrecisionCur cur m . (* lngScale) . fromRational
+    go s = roundPrecision precision . (* s) . fromRational
 
-balanceFromEntry
+balanceDeferred
-  :: (MonadInsertError m, MonadFinance m)
+  :: CurrencyRId
-  => CurID
+  -> AccountRId
-  -> Int
-  -> Entry AcntID v TagID
-  -> StateT EntryBals m (FullEntry AcntID CurID TagID)
-balanceFromEntry = balanceEntry (\a c -> liftInnerS . balanceDeferrred a c)
-
-balanceDeferrred
-  :: AcntID
-  -> CurID
   -> Deferred Rational
   -> State EntryBals (Rational, Maybe DBDeferred)
-balanceDeferrred acntID curID (Deferred toBal v) = do
+balanceDeferred curID acntID (Deferred toBal v) = do
   newval <- findBalance acntID curID toBal v
   return $ (newval, if toBal then Just (EntryBalance v) else Nothing)
 
-balanceToEntry
-  :: (MonadInsertError m, MonadFinance m)
-  => Vector Rational
-  -> Day
-  -> CurID
-  -> Int
-  -> Entry AcntID v TagID
-  -> StateT EntryBals m (FullEntry AcntID CurID TagID)
-balanceToEntry from day = balanceEntry go
-  where
-    go _ curID (LinkIndex g@LinkedNumGetter {lngIndex, lngScale}) = do
-      res <- unlinkGetter from curID g
-      case res of
-        Just v -> return $ (v, Just $ EntryLinked lngIndex lngScale)
-        Nothing -> throwError undefined
-    go acntID curID (LinkDeferred d) = balanceDeferrred acntID curID d
-
 balanceEntry
   :: (MonadInsertError m, MonadFinance m)
-  => (AcntID -> CurID -> v -> m (Rational, Maybe DBDeferred))
+  => (AccountRId -> v -> StateT EntryBals m (Rational, Maybe DBDeferred))
-  -> CurID
+  -> CurrencyRId
   -> Int
   -> Entry AcntID v TagID
-  -> StateT EntryBals m (FullEntry AcntID CurID TagID)
+  -> StateT EntryBals m (FullEntry AccountRId CurrencyRId TagID)
 balanceEntry f curID index e@Entry {eValue, eAcnt} = do
-  (newVal, deferred) <- lift $ f eAcnt curID eValue
+  (acntID, sign, _) <- lookupAccount eAcnt
+  let s = fromIntegral $ sign2Int sign
+  (newVal, deferred) <- f acntID eValue
+  modify (mapAdd_ (acntID, curID) newVal)
   return $
     FullEntry
-      { feEntry = e {eValue = newVal}
+      { feEntry = e {eValue = s * newVal, eAcnt = acntID}
       , feCurrency = curID
       , feDeferred = deferred
       , feIndex = index
@@ -484,14 +522,10 @@ balanceEntry f curID index e@Entry {eValue, eAcnt} = do
   where
     key = (eAcnt, curID)
 
-findBalance :: AcntID -> CurID -> Bool -> Rational -> State EntryBals Rational
+findBalance :: AccountRId -> CurrencyRId -> Bool -> Rational -> State EntryBals Rational
 findBalance acnt cur toBal v = do
-  curBal <- gets (M.findWithDefault 0 key)
+  curBal <- gets (M.findWithDefault 0 (acnt, cur))
-  let newVal = if toBal then v - curBal else v
+  return $ if toBal then v - curBal else v
-  modify (mapAdd_ key newVal)
-  return newVal
-  where
-    key = (acnt, cur)
 
 -- -- reimplementation from future version :/
 -- mapAccumM

lib/Internal/Types/Main.hs

@@ -63,6 +63,40 @@ type CurrencyM = Reader CurrencyMap
 
 data DBDeferred = EntryLinked Natural Rational | EntryBalance Rational
 
+data ReadEntry = ReadEntry
+  { reCurrency :: !CurrencyRId
+  , reAcnt :: !AccountRId
+  , reValue :: !Rational
+  , reDate :: !Day
+  }
+
+data UpdateEntry i v = UpdateEntry
+  { ueID :: !i
+  , ueAcnt :: !AccountRId
+  , ueValue :: !v
+  , ueIndex :: !Int -- TODO this isn't needed for primary entries
+  }
+
+data UpdateEntrySet = UpdateEntrySet
+  { utFrom0 :: !(UpdateEntry EntryRId ())
+  , utTo0 :: !(UpdateEntry EntryRId ())
+  , utPairs :: ![(UpdateEntry EntryRId Rational, UpdateEntry EntryRId ())]
+  , -- for these two, the Rational number is the balance target (not the
+    -- value of the account)
+    utFromUnk :: ![UpdateEntry EntryRId Rational]
+  , utToUnk :: ![UpdateEntry EntryRId Rational]
+  , utFromRO :: ![UpdateEntry () Rational]
+  , utToRO :: ![UpdateEntry () Rational]
+  , utCurrency :: !CurrencyRId
+  , utDate :: !Day
+  , utTotalValue :: !Rational
+  }
+
+data EntryBin
+  = ToUpdate UpdateEntrySet
+  | ToRead ReadEntry
+  | ToInsert (DeferredTx CommitR)
+
 data FullEntry a c t = FullEntry
   { feCurrency :: !c
   , feIndex :: !Int
@@ -131,6 +165,7 @@ data Tree a = Branch !a ![Tree a] | Leaf !a deriving (Show)
 data AcntSign = Credit | Debit
   deriving (Show)
 
+-- TODO debit should be negative
 sign2Int :: AcntSign -> Int
 sign2Int Debit = 1
 sign2Int Credit = 1
@@ -154,10 +189,11 @@ data EntrySet a c t v = EntrySet
   , esTo :: !(HalfEntrySet a c t (LinkDeferred v))
   }
 
-data Tx e = Tx
+data Tx e c = Tx
   { txDescr :: !T.Text
   , txDate :: !Day
   , txEntries :: !e
+  , txCommit :: !c
   }
   deriving (Generic)
 

lib/Internal/Utils.hs

@@ -49,9 +49,11 @@ module Internal.Utils
   , valMatches
   , roundPrecision
   , roundPrecisionCur
+  , lookupAccount
   , lookupAccountKey
   , lookupAccountSign
   , lookupAccountType
+  , lookupCurrency
   , lookupCurrencyKey
   , lookupCurrencyPrec
   , lookupTag
@@ -290,7 +292,7 @@ toDaySpan (a, b) = (a, fromIntegral $ diffDays b a - 1)
 --------------------------------------------------------------------------------
 -- matching
 
-matches :: MatchRe -> TxRecord -> InsertExceptT CurrencyM (MatchRes DeferredTx)
+matches :: MatchRe -> TxRecord -> InsertExceptT CurrencyM (MatchRes (DeferredTx ()))
 matches
   StatementParser {spTx, spOther, spVal, spDate, spDesc}
   r@TxRecord {trDate, trAmount, trDesc, trOther} = do
@@ -307,7 +309,7 @@ matches
       desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
       convert tg = MatchPass <$> toTx tg r
 
-toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx
+toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM (DeferredTx ())
 toTx
   TxGetter
     { tgFrom
@@ -322,6 +324,7 @@ toTx
       Tx
         { txDate = trDate
         , txDescr = trDesc
+        , txCommit = ()
         , txEntries =
             EntrySet
               { esTotalValue = v
@@ -1090,7 +1093,7 @@ 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 :: (MonadInsertError m, MonadFinance m) => CurID -> m (CurrencyRId, Natural)
 lookupCurrency = lookupFinance CurField kmCurrency
 
 lookupCurrencyKey :: (MonadInsertError m, MonadFinance m) => AcntID -> m CurrencyRId