ADD linked credit entries

dhall/Types.dhall

@@ -411,6 +411,35 @@ let EntryNumGetter =
       | BalanceN : 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, 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 =
     {-
     Means to get a textual value from a statement row.
@@ -473,115 +502,100 @@ 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)
     -}
-      { Type = Entry EntryAcntGetter EntryNumGetter TagID
+      \(n : Type) ->
-      , default = { eComment = "", eTags = [] : List TagID }
+        { 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 TxSubGetter =
     {-
     A means for transforming one row in a statement to a transaction
     -}
       { Type =
-          { tsgFromAcnt : EntryAcntGetter
+          { tsgValue : EntryNumGetter
-          , tsgToAcnt : EntryAcntGetter
-          , tsgValue : EntryNumGetter
           , tsgCurrency : EntryCurGetter
-          , tsgFromEntries : List EntryGetter.Type
+          , tsgFrom : (TxHalfGetter FromEntryGetter.Type).Type
-          , tsgFromComment : Text
+          , tsgTo : (TxHalfGetter ToEntryGetter.Type).Type
-          , tsgToComment : Text
-          , tsgFromTags : List TagID
-          , tsgToTags : List TagID
-          , tsgToEntries : List EntryGetter.Type
           }
-      , default =
+      , default = { tsgFrom = TxHalfGetter, tsgTo = TxHalfGetter }
-        { tsgFromTags = [] : List TagID
-        , tsgToTags = [] : List TagID
-        , tsgFromComment = ""
-        , tsgToComment = ""
-        , tsgFromEntries = [] : List EntryGetter.Type
-        , tsgToEntries = [] : List EntryGetter.Type
-        }
       }
 
 let TxGetter =
     {-
     A means for transforming one row in a statement to a transaction
-
-    At least two entries must be made for any given transaction. Below these
-    correspond to the 'from' and 'to' accounts, which will share a single value
-    (whose positive is added to 'to' and negative is added to 'from' accounts)
-    given by the record (ie one row in a statement) denominated in the given
-    currency.
-
-    Optionally, both sides of the from/to flow of value can be split with other
-    accounts (given by 'tgFromEntries' and 'tgToEntries'). In either case, the
-    amount actually transferred between the 'from' and 'to' accounts above
-    will be the difference after considering these additional account entries.
-
-    Furthermore, additionally entries denominated in different currencies
-    may be specified via 'tgOtherEntries'. Each member in this list corresponds
-    to a different currency (and associated entries) governed by most of the
-    rules for this type regarding balancing and splitting value.
-
     -}
       { Type =
-          { tgFromAcnt :
+          { tgFrom : (TxHalfGetter FromEntryGetter.Type).Type
-              {-
+          , tgTo : (TxHalfGetter ToEntryGetter.Type).Type
-              Account from which this transaction will be balanced. The value of
+          , tgCurrency : EntryCurGetter
-              the transaction will be assigned to this account unless other from
+          , tgOtherEntries : List TxSubGetter.Type
-              entries are specified (see below).
-              -}
-              EntryAcntGetter
-          , tgToAcnt :
-              {-
-              Account from which this transaction will be balanced. The value of
-              the transaction will be assigned to this account unless other from
-              entries are specified (see below).
-              -}
-              EntryAcntGetter
-          , tgFromComment : Text
-          , tgToComment : Text
-          , tgFromTags : List TagID
-          , tgToTags : List TagID
-          , tgCurrency :
-              {-
-              Currency to assign to the account/value denoted by 'tgFromAcnt'
-              above.
-              -}
-              EntryCurGetter
-          , tgFromEntries :
-              {-
-              Means of getting additional entries from which this transaction will
-              be balanced (minimum 0). If this list is empty, the total value of the
-              transaction will be assigned to the value defined by 'tgFromAcnt'.
-              Otherwise, the entries specified here will be added to the credit side
-              of this transaction, and their sum value will be subtracted from the
-              total value of the transaction and assigned to 'tgFromAcnt'.
-
-              This is useful for situations where a particular transaction denotes
-              values that come from multiple subaccounts.
-              -}
-              List EntryGetter.Type
-          , tgToEntries :
-              {-
-              A means of getting entries for this transaction
-              -}
-              List EntryGetter.Type
-          , tgOtherEntries :
-              {-
-              -}
-              List TxSubGetter.Type
           }
       , default =
         { tgOtherEntries = [] : List TxSubGetter.Type
-        , tgFromTags = [] : List TagID
+        , tsgFrom = TxHalfGetter
-        , tgToTags = [] : List TagID
+        , tsgTo = TxHalfGetter
-        , tgFromEntries = [] : List EntryGetter.Type
-        , tgToEntries = [] : List EntryGetter.Type
-        , tgFromComment = ""
-        , tgToComment = ""
         }
       }
 
@@ -1128,10 +1142,13 @@ in  { CurID
     , FieldMatcher
     , FieldMatcher_
     , EntryNumGetter
+    , LinkedEntryNumGetter
+    , LinkedNumGetter
     , Field
     , FieldMap
     , Entry
-    , EntryGetter
+    , FromEntryGetter
+    , ToEntryGetter
     , EntryTextGetter
     , EntryCurGetter
     , EntryAcntGetter

dhall/common.dhall

@@ -7,7 +7,7 @@ let T = ./Types.dhall
 let nullEntry =
       \(a : T.EntryAcntGetter) ->
       \(v : T.EntryNumGetter) ->
-        T.EntryGetter::{ eAcnt = a, eValue = v }
+        T.FromEntryGetter::{ eAcnt = a, eValue = v }
 
 let nullOpts = T.TxOpts::{=}
 
@@ -99,7 +99,7 @@ let partN =
                       (T.EntryNumGetter.ConstN x._2)
                 //  { eComment = x._3 }
 
-        in  List/map PartEntry T.EntryGetter.Type toEntry ss
+        in  List/map PartEntry T.FromEntryGetter.Type toEntry ss
 
 let addDay =
       \(x : T.GregorianM) ->

lib/Internal/History.hs

@@ -69,7 +69,7 @@ readHistStmt
 readHistStmt root i = whenHash_ CTImport i $ do
   bs <- readImport root i
   bounds <- askDBState kmStatementInterval
-  return $ filter (inDaySpan bounds . dtxDate) bs
+  return $ filter (inDaySpan bounds . txDate) bs
 
 splitHistory :: [History] -> ([HistTransfer], [Statement])
 splitHistory = partitionEithers . fmap go
@@ -101,16 +101,14 @@ txPair
   -> DeferredTx
 txPair day from to cur val desc =
   Tx
-    { dtxDescr = desc
+    { txDescr = desc
-    , dtxDate = day
+    , txDate = day
-    , dtxEntries =
+    , txEntries =
         [ EntrySet
-            { desTotalValue = -val
+            { esTotalValue = -val
-            , desCurrency = cur
+            , esCurrency = cur
-            , desFromEntry0 = entry from
+            , esFrom = HalfEntrySet {hesPrimary = entry from, hesOther = []}
-            , desToEntryBal = entry to
+            , esTo = HalfEntrySet {hesPrimary = entry to, hesOther = []}
-            , desFromEntries = []
-            , desToEntries = []
             }
         ]
     }
@@ -124,11 +122,11 @@ txPair day from to cur val desc =
         }
 
 resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
-resolveTx t@Tx {dtxEntries = ss} =
+resolveTx t@Tx {txEntries = ss} =
-  (\kss -> t {dtxEntries = kss}) <$> mapErrors resolveEntry ss
+  (\kss -> t {txEntries = kss}) <$> mapErrors resolveEntry ss
 
 insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
-insertTx c Tx {dtxDate = d, dtxDescr = e, dtxEntries = ss} = do
+insertTx c Tx {txDate = d, txDescr = e, txEntries = ss} = do
   k <- insert $ TransactionR c d e
   mapM_ (insertEntry k) ss
 
@@ -337,56 +335,75 @@ balanceTxs
   => [(CommitR, DeferredTx)]
   -> m [(CommitR, KeyTx)]
 balanceTxs ts = do
-  keyts <- mapErrors resolveTx $ snd $ L.mapAccumL go M.empty ts'
+  keyts <- mapErrors resolveTx =<< evalStateT (mapM go ts') M.empty
   return $ zip cs keyts
   where
-    (cs, ts') = L.unzip $ L.sortOn (dtxDate . snd) ts
+    (cs, ts') = L.unzip $ L.sortOn (txDate . snd) ts
-    go bals t@Tx {dtxEntries} =
+    go t@Tx {txEntries} =
-      second (\es -> t {dtxEntries = concat es}) $
+      (\es -> t {txEntries = concat es}) <$> mapM balanceEntrySet txEntries
-        L.mapAccumL balanceEntrySet bals dtxEntries
 
 type EntryBals = M.Map (AcntID, CurID) Rational
 
 -- 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 :: EntryBals -> DeferredEntrySet -> (EntryBals, [BalEntry])
 balanceEntrySet
-  bals
+  :: (MonadInsertError m, MonadFinance m)
+  => DeferredEntrySet
+  -> StateT EntryBals m [BalEntry]
+balanceEntrySet
   EntrySet
-    { desFromEntry0
+    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
-    , desFromEntries
+    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
-    , desToEntryBal
+    , esCurrency
-    , desToEntries
+    , esTotalValue
-    , desCurrency
+    } =
-    , desTotalValue
+    do
-    } = flipTup $ runState doBalAll bals
+      let (lts, dts) = partitionEithers $ splitLinked <$> ts
+      fs' <- doEntries fs esTotalValue f0
+      let fv = V.fromList $ fmap eValue fs'
+      lts' <- lift $ mapErrors (resolveLinked fv esCurrency) lts
+      ts' <- doEntries (dts ++ lts') (-esTotalValue) t0
+      return $ toFull <$> fs' ++ ts'
     where
-      flipTup (a, b) = (b, a)
       doEntries es tot e0 = do
-        es' <- state (\b -> flipTup $ L.mapAccumL (balanceEntry desCurrency) b es)
+        es' <- liftInnerS $ mapM (balanceEntry esCurrency) es
         let val0 = tot - entrySum es'
-        modify $ mapAdd_ (eAcnt e0, desCurrency) val0
+        modify $ mapAdd_ (eAcnt e0, esCurrency) val0
         return $ e0 {eValue = val0} : es'
-      doBalAll = do
+      toFull e = FullEntry {feEntry = e, feCurrency = esCurrency}
-        fes <- doEntries desFromEntries desTotalValue desFromEntry0
+      splitLinked e@Entry {eValue} = case eValue of
-        tes <- doEntries desToEntries (-desTotalValue) desToEntryBal
+        LinkIndex l -> Left e {eValue = l}
-        return $ toFull <$> fes ++ tes
+        LinkDeferred d -> Right e {eValue = d}
-      toFull e = FullEntry {feEntry = e, feCurrency = desCurrency}
+      liftInnerS = mapStateT (return . runIdentity)
+
+resolveLinked
+  :: (MonadInsertError m, MonadFinance m)
+  => Vector Rational
+  -> CurID
+  -> Entry a LinkedNumGetter t
+  -> m (Entry a (Deferred Rational) t)
+resolveLinked from cur e@Entry {eValue = LinkedNumGetter {lngIndex, lngScale}} = do
+  curMap <- askDBState kmCurrency
+  case from V.!? fromIntegral lngIndex of
+    Nothing -> throwError undefined
+    Just v -> do
+      v' <- liftExcept $ roundPrecisionCur cur curMap $ lngScale * fromRational v
+      return $ e {eValue = Deferred False v'}
 
 entrySum :: Num v => [Entry a v t] -> v
 entrySum = sum . fmap eValue
 
 balanceEntry
   :: CurID
-  -> EntryBals
   -> Entry AcntID (Deferred Rational) TagID
-  -> (EntryBals, Entry AcntID Rational TagID)
+  -> State EntryBals (Entry AcntID Rational TagID)
-balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt} =
+balanceEntry curID e@Entry {eValue = Deferred toBal v, eAcnt} = do
-  (mapAdd_ key newVal bals, e {eValue = newVal})
+  curBal <- gets (M.findWithDefault 0 key)
+  let newVal = if toBal then v - curBal else v
+  modify (mapAdd_ key newVal)
+  return $ e {eValue = newVal}
   where
     key = (eAcnt, curID)
-    curBal = M.findWithDefault 0 key bals
-    newVal = if toBal then v - curBal else v
 
 -- -- reimplementation from future version :/
 -- mapAccumM

lib/Internal/Types/Dhall.hs

@@ -33,10 +33,12 @@ makeHaskellTypesWith
   , MultipleConstructors "YMDMatcher" "(./dhall/Types.dhall).YMDMatcher"
   , MultipleConstructors "DateMatcher" "(./dhall/Types.dhall).DateMatcher"
   , MultipleConstructors "EntryNumGetter" "(./dhall/Types.dhall).EntryNumGetter"
+  , MultipleConstructors "LinkedEntryNumGetter" "(./dhall/Types.dhall).LinkedEntryNumGetter"
   , MultipleConstructors "BudgetCurrency" "(./dhall/Types.dhall).BudgetCurrency"
   , MultipleConstructors "BudgetTransferType" "(./dhall/Types.dhall).BudgetTransferType"
   , 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"
@@ -98,6 +100,8 @@ deriveProduct
   , "BudgetCurrency"
   , "Exchange"
   , "EntryNumGetter"
+  , "LinkedNumGetter"
+  , "LinkedEntryNumGetter"
   , "TemporalScope"
   , "SqlConfig"
   , "PretaxValue"
@@ -340,6 +344,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
@@ -421,9 +429,15 @@ data History
   | HistStatement !Statement
   deriving (Eq, Generic, Hashable, FromDhall)
 
-type EntryGetter = Entry EntryAcnt EntryNumGetter TagID
+type EntryGetter n = Entry EntryAcnt n TagID
 
-instance FromDhall EntryGetter
+type FromEntryGetter = EntryGetter EntryNumGetter
+
+type ToEntryGetter = EntryGetter LinkedEntryNumGetter
+
+instance FromDhall FromEntryGetter
+
+instance FromDhall ToEntryGetter
 
 deriving instance (Show a, Show v, Show t) => Show (Entry a v t)
 
@@ -492,30 +506,30 @@ 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
-  { tsgFromAcnt :: !EntryAcnt
+  { tsgFrom :: !(TxHalfGetter FromEntryGetter)
-  , tsgToAcnt :: !EntryAcnt
+  , tsgTo :: !(TxHalfGetter ToEntryGetter)
-  , tsgFromComment :: !T.Text
-  , tsgToComment :: !T.Text
-  , tsgFromTags :: ![TagID]
-  , tsgToTags :: ![TagID]
   , tsgValue :: !EntryNumGetter
   , tsgCurrency :: !EntryCur
-  , tsgFromEntries :: ![EntryGetter]
-  , tsgToEntries :: ![EntryGetter]
   }
   deriving (Eq, Generic, Hashable, Show, FromDhall)
 
 data TxGetter = TxGetter
-  { tgFromAcnt :: !EntryAcnt
+  { tgFrom :: !(TxHalfGetter FromEntryGetter)
-  , tgToAcnt :: !EntryAcnt
+  , tgTo :: !(TxHalfGetter ToEntryGetter)
-  , tgFromComment :: !T.Text
-  , tgToComment :: !T.Text
-  , tgFromTags :: ![TagID]
-  , tgToTags :: ![TagID]
   , tgCurrency :: !EntryCur
-  , tgFromEntries :: ![EntryGetter]
-  , tgToEntries :: ![EntryGetter]
   , tgOtherEntries :: ![TxSubGetter]
   }
   deriving (Eq, Generic, Hashable, Show, FromDhall)

lib/Internal/Types/Main.hs

@@ -138,23 +138,26 @@ accountSign IncomeT = Credit
 accountSign LiabilityT = Credit
 accountSign EquityT = Credit
 
+data HalfEntrySet a c t v = HalfEntrySet
+  { hesPrimary :: !(Entry a () t)
+  , hesOther :: ![Entry a v t]
+  }
+
 data EntrySet a c t v = EntrySet
-  { desTotalValue :: !Rational
+  { esTotalValue :: !Rational
-  , desCurrency :: !c
+  , esCurrency :: !c
-  , desFromEntry0 :: !(Entry a () t)
+  , esFrom :: !(HalfEntrySet a c t (Deferred v))
-  , desFromEntries :: ![Entry a v t]
+  , esTo :: !(HalfEntrySet a c t (LinkDeferred v))
-  , desToEntries :: ![Entry a v t]
-  , desToEntryBal :: !(Entry a () t)
   }
 
 data Tx e = Tx
-  { dtxDescr :: !T.Text
+  { txDescr :: !T.Text
-  , dtxDate :: !Day
+  , txDate :: !Day
-  , dtxEntries :: !e
+  , txEntries :: !e
   }
   deriving (Generic)
 
-type DeferredEntrySet = EntrySet AcntID CurID TagID (Deferred Rational)
+type DeferredEntrySet = EntrySet AcntID CurID TagID Rational
 
 type BalEntrySet = EntrySet AcntID CurID TagID Rational
 
@@ -169,6 +172,11 @@ type KeyTx = Tx [KeyEntry]
 data Deferred a = Deferred Bool a
   deriving (Show, Functor, Foldable, Traversable)
 
+data LinkDeferred a
+  = LinkDeferred (Deferred a)
+  | LinkIndex LinkedNumGetter
+  deriving (Show, Functor, Foldable, Traversable)
+
 -- type RawEntry = Entry AcntID (Deferred Rational) CurID TagID
 
 -- type RawFromEntry = Entry AcntID (Deferred Rational) CurID TagID

lib/Internal/Utils.hs

@@ -310,105 +310,131 @@ matches
 toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx
 toTx
   TxGetter
-    { tgFromAcnt
+    { tgFrom
-    , tgToAcnt
+    , tgTo
-    , tgFromComment
-    , tgToComment
-    , tgFromTags
-    , tgToTags
     , tgCurrency
-    , tgFromEntries
-    , tgToEntries
     , tgOtherEntries
     }
   r@TxRecord {trAmount, trDate, trDesc} = do
-    combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss ->
+    combineError curRes subRes $ \(cur, f, t) ss ->
       Tx
-        { dtxDate = trDate
+        { txDate = trDate
-        , dtxDescr = trDesc
+        , txDescr = trDesc
-        , dtxEntries =
+        , txEntries =
             EntrySet
-              { desTotalValue = trAmount
+              { esTotalValue = trAmount
-              , desCurrency = cur
+              , esCurrency = cur
-              , desFromEntry0 = entry0 fa tgFromComment tgFromTags
+              , esFrom = f
-              , desFromEntries = fe
+              , esTo = t
-              , desToEntries = te
-              , desToEntryBal = entry0 ta tgToComment tgToTags
               }
               : ss
         }
     where
-      resolveAcnt_ = liftInner . resolveAcnt r
-      acntRes =
-        combineError
-          (resolveAcnt_ tgFromAcnt)
-          (resolveAcnt_ tgToAcnt)
-          (,)
       curRes = do
         cur <- liftInner $ resolveCurrency r tgCurrency
-        let feRes = mapErrors (resolveEntry cur r) tgFromEntries
+        let fromRes = resolveHalfEntry resolveFromValue cur r tgFrom
-        let teRes = mapErrors (resolveEntry cur r) tgToEntries
+        let toRes = resolveHalfEntry resolveToValue cur r tgTo
-        combineError feRes teRes (cur,,)
+        combineError fromRes toRes (cur,,)
       subRes = mapErrors (resolveSubGetter r) tgOtherEntries
-      entry0 a c ts = Entry {eAcnt = a, eValue = (), eComment = c, eTags = ts}
 
 resolveSubGetter
   :: TxRecord
   -> TxSubGetter
-  -> InsertExceptT CurrencyM DeferredEntrySet
+  -> InsertExceptT CurrencyM (EntrySet AcntID CurID TagID Rational)
-resolveSubGetter
+resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
-  r
+  m <- ask
-  TxSubGetter
+  cur <- liftInner $ resolveCurrency r tsgCurrency
-    { tsgFromAcnt
+  (_, val) <- liftInner $ mapM (roundPrecisionCur cur m) =<< resolveValue r tsgValue
-    , tsgToAcnt
+  let fromRes = resolveHalfEntry resolveFromValue cur r tsgFrom
-    , tsgFromTags
+  let toRes = resolveHalfEntry resolveToValue cur r tsgTo
-    , tsgToTags
+  combineError fromRes toRes $ \f t ->
-    , tsgFromComment
+    EntrySet
-    , tsgToComment
+      { esTotalValue = val
-    , tsgValue
+      , esCurrency = cur
-    , tsgCurrency
+      , esFrom = f
-    , tsgFromEntries
+      , esTo = t
-    , tsgToEntries
+      }
-    } = combineErrorM acntRes curRes $ \(fa, ta) (cur, fe, te) ->
+
-    do
+resolveHalfEntry
-      m <- ask
+  :: Traversable f
-      -- TODO laaaaame...
+  => (TxRecord -> n -> InsertExcept (f Double))
-      (Deferred _ val) <- liftInner $ mapM (roundPrecisionCur cur m) =<< resolveValue r tsgValue
+  -> CurID
-      let fromEntry =
+  -> TxRecord
-            Entry
+  -> TxHalfGetter (EntryGetter n)
-              { eAcnt = fa
+  -> InsertExceptT CurrencyM (HalfEntrySet AcntID CurID TagID (f Rational))
-              , eValue = ()
+resolveHalfEntry f cur r TxHalfGetter {thgAcnt, thgComment, thgTags, thgEntries} =
-              , eComment = tsgFromComment
+  combineError acntRes esRes $ \a es ->
-              , eTags = tsgFromTags
+    HalfEntrySet
-              }
+      { hesPrimary =
-      let toEntry =
+          Entry
-            Entry
+            { eAcnt = a
-              { eAcnt = ta
+            , eValue = ()
-              , eValue = ()
+            , eComment = thgComment
-              , eComment = tsgToComment
+            , eTags = thgTags
-              , eTags = tsgToTags
+            }
-              }
+      , hesOther = es
-      return
+      }
-        EntrySet
+  where
-          { desTotalValue = val
+    acntRes = liftInner $ resolveAcnt r thgAcnt
-          , desCurrency = cur
+    esRes = mapErrors (resolveEntry f cur r) thgEntries
-          , desFromEntry0 = fromEntry
+
-          , desFromEntries = fe
+-- resolveSubGetter
-          , desToEntries = te
+--   :: TxRecord
-          , desToEntryBal = toEntry
+--   -> TxSubGetter
-          }
+--   -> InsertExceptT CurrencyM DeferredEntrySet
-    where
+-- resolveSubGetter
-      resolveAcnt_ = liftInner . resolveAcnt r
+--   r
-      acntRes =
+--   TxSubGetter
-        combineError
+--     { tsgFromAcnt
-          (resolveAcnt_ tsgFromAcnt)
+--     , tsgToAcnt
-          (resolveAcnt_ tsgToAcnt)
+--     , tsgFromTags
-          (,)
+--     , tsgToTags
-      curRes = do
+--     , tsgFromComment
-        cur <- liftInner $ resolveCurrency r tsgCurrency
+--     , tsgToComment
-        let feRes = mapErrors (resolveEntry cur r) tsgFromEntries
+--     , tsgValue
-        let teRes = mapErrors (resolveEntry cur r) tsgToEntries
+--     , tsgCurrency
-        combineError feRes teRes (cur,,)
+--     , tsgFromEntries
+--     , tsgToEntries
+--     } = combineErrorM acntRes curRes $ \(fa, ta) (cur, fe, te) ->
+--     do
+--       m <- ask
+--       -- TODO laaaaame...
+--       (Deferred _ val) <- liftInner $ mapM (roundPrecisionCur cur m) =<< resolveValue r tsgValue
+--       let fromEntry =
+--             Entry
+--               { eAcnt = fa
+--               , eValue = ()
+--               , eComment = tsgFromComment
+--               , eTags = tsgFromTags
+--               }
+--       let toEntry =
+--             Entry
+--               { eAcnt = ta
+--               , eValue = ()
+--               , eComment = tsgToComment
+--               , eTags = tsgToTags
+--               }
+--       return
+--         EntrySet
+--           { desTotalValue = val
+--           , desCurrency = cur
+--           , desFromEntry0 = fromEntry
+--           , desFromEntries = fe
+--           , desToEntries = te
+--           , desToEntryBal = toEntry
+--           }
+--     where
+--       resolveAcnt_ = liftInner . resolveAcnt r
+--       acntRes =
+--         combineError
+--           (resolveAcnt_ tsgFromAcnt)
+--           (resolveAcnt_ tsgToAcnt)
+--           (,)
+--       curRes = do
+--         cur <- liftInner $ resolveCurrency r tsgCurrency
+--         let feRes = mapErrors (resolveEntry cur r) tsgFromEntries
+--         let teRes = mapErrors (resolveEntry cur r) tsgToEntries
+--         combineError feRes teRes (cur,,)
 
 valMatches :: ValMatcher -> Rational -> InsertExcept Bool
 valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
@@ -434,20 +460,35 @@ otherMatches dict m = case m of
   where
     lookup_ t n = lookupErr (MatchField t) n dict
 
--- TODO this should be more general?
 resolveEntry
-  :: CurID
+  :: Traversable f
+  => (TxRecord -> n -> InsertExcept (f Double))
+  -> CurID
   -> TxRecord
-  -> EntryGetter
+  -> EntryGetter n
-  -> InsertExceptT CurrencyM (Entry AcntID (Deferred Rational) TagID)
+  -> InsertExceptT CurrencyM (Entry AcntID (f Rational) TagID)
-resolveEntry cur r s@Entry {eAcnt, eValue} = do
+resolveEntry f cur r s@Entry {eAcnt, eValue} = do
   m <- ask
   liftInner $ combineErrorM acntRes valRes $ \a v -> do
     v' <- mapM (roundPrecisionCur cur m) v
     return $ s {eAcnt = a, eValue = v'}
   where
     acntRes = resolveAcnt r eAcnt
-    valRes = resolveValue r eValue
+    valRes = f r eValue
+
+-- resolveEntry
+--   :: CurID
+--   -> TxRecord
+--   -> EntryGetter n
+--   -> InsertExceptT CurrencyM (Entry AcntID (Deferred Rational) TagID)
+-- resolveEntry cur r s@Entry {eAcnt, eValue} = do
+--   m <- ask
+--   liftInner $ combineErrorM acntRes valRes $ \a v -> do
+--     v' <- mapM (roundPrecisionCur cur m) v
+--     return $ s {eAcnt = a, eValue = v'}
+--   where
+--     acntRes = resolveAcnt r eAcnt
+--     valRes = resolveValue r eValue
 
 -- curRes = resolveCurrency r eCurrency
 
@@ -556,19 +597,21 @@ mapErrorsIO f xs = mapM go $ enumTraversable xs
 collectErrorsIO :: (Traversable t, MonadUnliftIO m) => t (m a) -> m (t a)
 collectErrorsIO = mapErrorsIO id
 
-resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (Deferred Double)
+resolveFromValue :: TxRecord -> EntryNumGetter -> InsertExcept (Deferred Double)
-resolveValue TxRecord {trOther, trAmount} s = case s of
+resolveFromValue r = fmap (uncurry Deferred) . resolveValue r
-  (LookupN t) -> Deferred False <$> (readDouble =<< lookupErr EntryValField t trOther)
-  (ConstN c) -> return $ Deferred False c
-  AmountN m -> return $ Deferred False $ (* m) $ fromRational trAmount
-  BalanceN x -> return $ Deferred True x
 
--- -- TODO not DRY
+resolveToValue :: TxRecord -> LinkedEntryNumGetter -> InsertExcept (LinkDeferred Double)
--- resolveToValue :: TxRecord -> ToEntryNumGetter -> InsertExcept Double
+resolveToValue _ (Linked l) = return $ LinkIndex l
--- resolveToValue TxRecord {trOther, trAmount} s = case s of
+resolveToValue r (Getter g) = do
---   (TLookupN t) -> readDouble =<< lookupErr EntryValField t trOther
+  (l, v) <- resolveValue r g
---   (TConstN c) -> return c
+  return $ LinkDeferred (Deferred l v)
---   TAmountN m -> return $ (* m) $ fromRational trAmount
+
+resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (Bool, Double)
+resolveValue TxRecord {trOther, trAmount} s = case s of
+  (LookupN t) -> (False,) <$> (readDouble =<< lookupErr EntryValField t trOther)
+  (ConstN c) -> return (False, c)
+  AmountN m -> return $ (False,) <$> (* m) $ fromRational trAmount
+  BalanceN x -> return (True, x)
 
 resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
 resolveAcnt = resolveEntryField AcntField