dhall/Types.dhall

@@ -411,35 +411,6 @@ 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.
@@ -502,100 +473,115 @@ let Entry =
 
 let EntryGetter =
     {-
-    Means for getting an entry from a given row in a statement (debit side)
+    Means for getting an entry from a given row in a statement
     -}
-      \(n : Type) ->
+      { Type = Entry EntryAcntGetter EntryNumGetter 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 =
-          { tsgValue : EntryNumGetter
+          { tsgFromAcnt : EntryAcntGetter
+          , tsgToAcnt : EntryAcntGetter
+          , tsgValue : EntryNumGetter
           , tsgCurrency : EntryCurGetter
-          , tsgFrom : (TxHalfGetter FromEntryGetter.Type).Type
+          , tsgFromEntries : List EntryGetter.Type
-          , tsgTo : (TxHalfGetter ToEntryGetter.Type).Type
+          , tsgFromComment : Text
+          , tsgToComment : Text
+          , tsgFromTags : List TagID
+          , tsgToTags : List TagID
+          , tsgToEntries : List EntryGetter.Type
+          }
+      , default =
+        { tsgFromTags = [] : List TagID
+        , tsgToTags = [] : List TagID
+        , tsgFromComment = ""
+        , tsgToComment = ""
+        , tsgFromEntries = [] : List EntryGetter.Type
+        , tsgToEntries = [] : List EntryGetter.Type
         }
-      , default = { tsgFrom = TxHalfGetter, tsgTo = TxHalfGetter }
       }
 
 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 =
-          { tgFrom : (TxHalfGetter FromEntryGetter.Type).Type
+          { tgFromAcnt :
-          , tgTo : (TxHalfGetter ToEntryGetter.Type).Type
+              {-
-          , tgCurrency : EntryCurGetter
+              Account from which this transaction will be balanced. The value of
-          , tgOtherEntries : List TxSubGetter.Type
+              the transaction will be assigned to this account unless other from
+              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
-        , tsgFrom = TxHalfGetter
+        , tgFromTags = [] : List TagID
-        , tsgTo = TxHalfGetter
+        , tgToTags = [] : List TagID
+        , tgFromEntries = [] : List EntryGetter.Type
+        , tgToEntries = [] : List EntryGetter.Type
+        , tgFromComment = ""
+        , tgToComment = ""
         }
       }
 
@@ -1142,13 +1128,10 @@ in  { CurID
     , FieldMatcher
     , FieldMatcher_
     , EntryNumGetter
-    , LinkedEntryNumGetter
-    , LinkedNumGetter
     , Field
     , FieldMap
     , Entry
-    , FromEntryGetter
+    , EntryGetter
-    , ToEntryGetter
     , EntryTextGetter
     , EntryCurGetter
     , EntryAcntGetter

dhall/common.dhall

@@ -7,7 +7,7 @@ let T = ./Types.dhall
 let nullEntry =
       \(a : T.EntryAcntGetter) ->
       \(v : T.EntryNumGetter) ->
-        T.FromEntryGetter::{ eAcnt = a, eValue = v }
+        T.EntryGetter::{ 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.FromEntryGetter.Type toEntry ss
+        in  List/map PartEntry T.EntryGetter.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 . txDate) bs
+  return $ filter (inDaySpan bounds . dtxDate) bs
 
 splitHistory :: [History] -> ([HistTransfer], [Statement])
 splitHistory = partitionEithers . fmap go
@@ -101,14 +101,16 @@ txPair
   -> DeferredTx
 txPair day from to cur val desc =
   Tx
-    { txDescr = desc
+    { dtxDescr = desc
-    , txDate = day
+    , dtxDate = day
-    , txEntries =
+    , dtxEntries =
         [ EntrySet
-            { esTotalValue = -val
+            { desTotalValue = -val
-            , esCurrency = cur
+            , desCurrency = cur
-            , esFrom = HalfEntrySet {hesPrimary = entry from, hesOther = []}
+            , desFromEntry0 = entry from
-            , esTo = HalfEntrySet {hesPrimary = entry to, hesOther = []}
+            , desToEntryBal = entry to
+            , desFromEntries = []
+            , desToEntries = []
             }
         ]
     }
@@ -122,11 +124,11 @@ txPair day from to cur val desc =
         }
 
 resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
-resolveTx t@Tx {txEntries = ss} =
+resolveTx t@Tx {dtxEntries = ss} =
-  (\kss -> t {txEntries = kss}) <$> mapErrors resolveEntry ss
+  (\kss -> t {dtxEntries = kss}) <$> mapErrors resolveEntry ss
 
 insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
-insertTx c Tx {txDate = d, txDescr = e, txEntries = ss} = do
+insertTx c Tx {dtxDate = d, dtxDescr = e, dtxEntries = ss} = do
   k <- insert $ TransactionR c d e
   mapM_ (insertEntry k) ss
 
@@ -335,78 +337,56 @@ balanceTxs
   => [(CommitR, DeferredTx)]
   -> m [(CommitR, KeyTx)]
 balanceTxs ts = do
-  keyts <- mapErrors resolveTx =<< evalStateT (mapM go ts') M.empty
+  keyts <- mapErrors resolveTx $ snd $ L.mapAccumL go M.empty ts'
   return $ zip cs keyts
   where
-    (cs, ts') = L.unzip $ L.sortOn (txDate . snd) ts
+    (cs, ts') = L.unzip $ L.sortOn (dtxDate . snd) ts
-    go t@Tx {txEntries, txDate} =
+    go bals t@Tx {dtxEntries} =
-      (\es -> t {txEntries = concat es}) <$> mapM (balanceEntrySet txDate) txEntries
+      second (\es -> t {dtxEntries = concat es}) $
+        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
-  :: (MonadInsertError m, MonadFinance m)
+  bals
-  => Day
-  -> DeferredEntrySet
-  -> StateT EntryBals m [BalEntry]
-balanceEntrySet
-  day
   EntrySet
-    { esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
+    { desFromEntry0
-    , esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
+    , desFromEntries
-    , esCurrency
+    , desToEntryBal
-    , esTotalValue
+    , desToEntries
-    } =
+    , desCurrency
-    do
+    , desTotalValue
-      let (lts, dts) = partitionEithers $ splitLinked <$> ts
+    } = flipTup $ runState doBalAll bals
-      fs' <- doEntries fs esTotalValue f0
-      let fv = V.fromList $ fmap eValue fs'
-      lts' <- lift $ mapErrors (resolveLinked fv esCurrency day) lts
-      ts' <- doEntries (dts ++ lts') (-esTotalValue) t0
-      return $ toFull <$> fs' ++ ts'
     where
+      flipTup (a, b) = (b, a)
       doEntries es tot e0 = do
-        es' <- liftInnerS $ mapM (balanceEntry esCurrency) es
+        es' <- state (\b -> flipTup $ L.mapAccumL (balanceEntry desCurrency) b es)
         let val0 = tot - entrySum es'
-        modify $ mapAdd_ (eAcnt e0, esCurrency) val0
+        modify $ mapAdd_ (eAcnt e0, desCurrency) val0
         return $ e0 {eValue = val0} : es'
-      toFull e = FullEntry {feEntry = e, feCurrency = esCurrency}
+      doBalAll = do
-      splitLinked e@Entry {eValue} = case eValue of
+        fes <- doEntries desFromEntries desTotalValue desFromEntry0
-        LinkIndex l -> Left e {eValue = l}
+        tes <- doEntries desToEntries (-desTotalValue) desToEntryBal
-        LinkDeferred d -> Right e {eValue = d}
+        return $ toFull <$> fes ++ tes
-      liftInnerS = mapStateT (return . runIdentity)
+      toFull e = FullEntry {feEntry = e, feCurrency = desCurrency}
-
-resolveLinked
-  :: (MonadInsertError m, MonadFinance m)
-  => Vector Rational
-  -> 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'}
 
 entrySum :: Num v => [Entry a v t] -> v
 entrySum = sum . fmap eValue
 
 balanceEntry
   :: CurID
+  -> EntryBals
   -> Entry AcntID (Deferred Rational) TagID
-  -> State EntryBals (Entry AcntID Rational TagID)
+  -> (EntryBals, Entry AcntID Rational TagID)
-balanceEntry curID e@Entry {eValue = Deferred toBal v, eAcnt} = do
+balanceEntry curID bals e@Entry {eValue = Deferred toBal v, eAcnt} =
-  curBal <- gets (M.findWithDefault 0 key)
+  (mapAdd_ key newVal bals, e {eValue = newVal})
-  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,12 +33,10 @@ 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"
@@ -100,8 +98,6 @@ deriveProduct
   , "BudgetCurrency"
   , "Exchange"
   , "EntryNumGetter"
-  , "LinkedNumGetter"
-  , "LinkedEntryNumGetter"
   , "TemporalScope"
   , "SqlConfig"
   , "PretaxValue"
@@ -344,10 +340,6 @@ 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
@@ -429,15 +421,9 @@ data History
   | HistStatement !Statement
   deriving (Eq, Generic, Hashable, FromDhall)
 
-type EntryGetter n = Entry EntryAcnt n TagID
+type EntryGetter = Entry EntryAcnt EntryNumGetter TagID
 
-type FromEntryGetter = EntryGetter EntryNumGetter
+instance FromDhall EntryGetter
-
-type ToEntryGetter = EntryGetter LinkedEntryNumGetter
-
-instance FromDhall FromEntryGetter
-
-instance FromDhall ToEntryGetter
 
 deriving instance (Show a, Show v, Show t) => Show (Entry a v t)
 
@@ -506,30 +492,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
-  { tsgFrom :: !(TxHalfGetter FromEntryGetter)
+  { tsgFromAcnt :: !EntryAcnt
-  , tsgTo :: !(TxHalfGetter ToEntryGetter)
+  , tsgToAcnt :: !EntryAcnt
+  , 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
-  { tgFrom :: !(TxHalfGetter FromEntryGetter)
+  { tgFromAcnt :: !EntryAcnt
-  , tgTo :: !(TxHalfGetter ToEntryGetter)
+  , tgToAcnt :: !EntryAcnt
+  , 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,26 +138,23 @@ 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
-  { esTotalValue :: !Rational
+  { desTotalValue :: !Rational
-  , esCurrency :: !c
+  , desCurrency :: !c
-  , esFrom :: !(HalfEntrySet a c t (Deferred v))
+  , desFromEntry0 :: !(Entry a () t)
-  , esTo :: !(HalfEntrySet a c t (LinkDeferred v))
+  , desFromEntries :: ![Entry a v t]
+  , desToEntries :: ![Entry a v t]
+  , desToEntryBal :: !(Entry a () t)
   }
 
 data Tx e = Tx
-  { txDescr :: !T.Text
+  { dtxDescr :: !T.Text
-  , txDate :: !Day
+  , dtxDate :: !Day
-  , txEntries :: !e
+  , dtxEntries :: !e
   }
   deriving (Generic)
 
-type DeferredEntrySet = EntrySet AcntID CurID TagID Rational
+type DeferredEntrySet = EntrySet AcntID CurID TagID (Deferred Rational)
 
 type BalEntrySet = EntrySet AcntID CurID TagID Rational
 
@@ -172,11 +169,6 @@ 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
@@ -221,10 +213,9 @@ data InsertError
   | InsertIOError !T.Text
   | ParseError !T.Text
   | ConversionError !T.Text
-  | IndexError !(Entry AcntID LinkedNumGetter TagID) !Day
-  | RoundError !CurID
   | LookupError !LookupSuberr !T.Text
-  | IncomeError !Day !T.Text !Rational
+  | -- | BalanceError !BalanceType !CurID ![Entry AcntID (Maybe Rational) CurID TagID]
+    IncomeError !Day !T.Text !Rational
   | PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
   | DaySpanError !Gregorian !(Maybe Gregorian)
   | StatementError ![TxRecord] ![MatchRe]

lib/Internal/Utils.hs

@@ -310,131 +310,105 @@ matches
 toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx
 toTx
   TxGetter
-    { tgFrom
+    { tgFromAcnt
-    , tgTo
+    , tgToAcnt
+    , tgFromComment
+    , tgToComment
+    , tgFromTags
+    , tgToTags
     , tgCurrency
+    , tgFromEntries
+    , tgToEntries
     , tgOtherEntries
     }
   r@TxRecord {trAmount, trDate, trDesc} = do
-    combineError curRes subRes $ \(cur, f, t) ss ->
+    combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss ->
       Tx
-        { txDate = trDate
+        { dtxDate = trDate
-        , txDescr = trDesc
+        , dtxDescr = trDesc
-        , txEntries =
+        , dtxEntries =
             EntrySet
-              { esTotalValue = trAmount
+              { desTotalValue = trAmount
-              , esCurrency = cur
+              , desCurrency = cur
-              , esFrom = f
+              , desFromEntry0 = entry0 fa tgFromComment tgFromTags
-              , esTo = t
+              , desFromEntries = fe
+              , 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 fromRes = resolveHalfEntry resolveFromValue cur r tgFrom
+        let feRes = mapErrors (resolveEntry cur r) tgFromEntries
-        let toRes = resolveHalfEntry resolveToValue cur r tgTo
+        let teRes = mapErrors (resolveEntry cur r) tgToEntries
-        combineError fromRes toRes (cur,,)
+        combineError feRes teRes (cur,,)
       subRes = mapErrors (resolveSubGetter r) tgOtherEntries
+      entry0 a c ts = Entry {eAcnt = a, eValue = (), eComment = c, eTags = ts}
 
 resolveSubGetter
   :: TxRecord
   -> TxSubGetter
-  -> InsertExceptT CurrencyM (EntrySet AcntID CurID TagID Rational)
+  -> InsertExceptT CurrencyM DeferredEntrySet
-resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
+resolveSubGetter
+  r
+  TxSubGetter
+    { tsgFromAcnt
+    , tsgToAcnt
+    , tsgFromTags
+    , tsgToTags
+    , tsgFromComment
+    , tsgToComment
+    , tsgValue
+    , tsgCurrency
+    , tsgFromEntries
+    , tsgToEntries
+    } = combineErrorM acntRes curRes $ \(fa, ta) (cur, fe, te) ->
+    do
       m <- ask
-  cur <- liftInner $ resolveCurrency r tsgCurrency
+      -- TODO laaaaame...
-  (_, val) <- liftInner $ mapM (roundPrecisionCur cur m) =<< resolveValue r tsgValue
+      (Deferred _ val) <- liftInner $ mapM (roundPrecisionCur cur m) =<< resolveValue r tsgValue
-  let fromRes = resolveHalfEntry resolveFromValue cur r tsgFrom
+      let fromEntry =
-  let toRes = resolveHalfEntry resolveToValue cur r tsgTo
-  combineError fromRes toRes $ \f t ->
-    EntrySet
-      { esTotalValue = val
-      , esCurrency = cur
-      , esFrom = f
-      , esTo = t
-      }
-
-resolveHalfEntry
-  :: Traversable f
-  => (TxRecord -> n -> InsertExcept (f Double))
-  -> CurID
-  -> TxRecord
-  -> TxHalfGetter (EntryGetter n)
-  -> InsertExceptT CurrencyM (HalfEntrySet AcntID CurID TagID (f Rational))
-resolveHalfEntry f cur r TxHalfGetter {thgAcnt, thgComment, thgTags, thgEntries} =
-  combineError acntRes esRes $ \a es ->
-    HalfEntrySet
-      { hesPrimary =
             Entry
-            { eAcnt = a
+              { eAcnt = fa
               , eValue = ()
-            , eComment = thgComment
+              , eComment = tsgFromComment
-            , eTags = thgTags
+              , eTags = tsgFromTags
               }
-      , hesOther = es
+      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
-    acntRes = liftInner $ resolveAcnt r thgAcnt
+      resolveAcnt_ = liftInner . resolveAcnt r
-    esRes = mapErrors (resolveEntry f cur r) thgEntries
+      acntRes =
-
+        combineError
--- resolveSubGetter
+          (resolveAcnt_ tsgFromAcnt)
---   :: TxRecord
+          (resolveAcnt_ tsgToAcnt)
---   -> TxSubGetter
+          (,)
---   -> InsertExceptT CurrencyM DeferredEntrySet
+      curRes = do
--- resolveSubGetter
+        cur <- liftInner $ resolveCurrency r tsgCurrency
---   r
+        let feRes = mapErrors (resolveEntry cur r) tsgFromEntries
---   TxSubGetter
+        let teRes = mapErrors (resolveEntry cur r) tsgToEntries
---     { tsgFromAcnt
+        combineError feRes teRes (cur,,)
---     , tsgToAcnt
---     , tsgFromTags
---     , tsgToTags
---     , tsgFromComment
---     , tsgToComment
---     , tsgValue
---     , tsgCurrency
---     , 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
@@ -460,35 +434,20 @@ otherMatches dict m = case m of
   where
     lookup_ t n = lookupErr (MatchField t) n dict
 
+-- TODO this should be more general?
 resolveEntry
-  :: Traversable f
+  :: CurID
-  => (TxRecord -> n -> InsertExcept (f Double))
-  -> CurID
   -> TxRecord
-  -> EntryGetter n
+  -> EntryGetter
-  -> InsertExceptT CurrencyM (Entry AcntID (f Rational) TagID)
+  -> InsertExceptT CurrencyM (Entry AcntID (Deferred Rational) TagID)
-resolveEntry f cur r s@Entry {eAcnt, eValue} = do
+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 = f r eValue
+    valRes = resolveValue 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
 
@@ -597,21 +556,19 @@ mapErrorsIO f xs = mapM go $ enumTraversable xs
 collectErrorsIO :: (Traversable t, MonadUnliftIO m) => t (m a) -> m (t a)
 collectErrorsIO = mapErrorsIO id
 
-resolveFromValue :: TxRecord -> EntryNumGetter -> InsertExcept (Deferred Double)
+resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (Deferred Double)
-resolveFromValue r = fmap (uncurry Deferred) . resolveValue r
-
-resolveToValue :: TxRecord -> LinkedEntryNumGetter -> InsertExcept (LinkDeferred Double)
-resolveToValue _ (Linked l) = return $ LinkIndex l
-resolveToValue r (Getter g) = do
-  (l, v) <- resolveValue r g
-  return $ LinkDeferred (Deferred l v)
-
-resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept (Bool, Double)
 resolveValue TxRecord {trOther, trAmount} s = case s of
-  (LookupN t) -> (False,) <$> (readDouble =<< lookupErr EntryValField t trOther)
+  (LookupN t) -> Deferred False <$> (readDouble =<< lookupErr EntryValField t trOther)
-  (ConstN c) -> return (False, c)
+  (ConstN c) -> return $ Deferred False c
-  AmountN m -> return $ (False,) <$> (* m) $ fromRational trAmount
+  AmountN m -> return $ Deferred False $ (* m) $ fromRational trAmount
-  BalanceN x -> return (True, x)
+  BalanceN x -> return $ Deferred True x
+
+-- -- TODO not DRY
+-- resolveToValue :: TxRecord -> ToEntryNumGetter -> InsertExcept Double
+-- resolveToValue TxRecord {trOther, trAmount} s = case s of
+--   (TLookupN t) -> readDouble =<< lookupErr EntryValField t trOther
+--   (TConstN c) -> return c
+--   TAmountN m -> return $ (* m) $ fromRational trAmount
 
 resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
 resolveAcnt = resolveEntryField AcntField
@@ -708,7 +665,7 @@ 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 [RoundError c]
+    Nothing -> throwError $ InsertException [undefined]
 
 acntPath2Text :: AcntPath -> T.Text
 acntPath2Text (AcntPath t cs) = T.intercalate "/" (atName t : cs)
@@ -786,22 +743,6 @@ showError other = case other of
         , singleQuote $ showT next
         ]
     ]
-  (IndexError Entry {eValue = LinkedNumGetter {lngIndex}, eAcnt} day) ->
-    [ T.unwords
-        [ "No credit entry for index"
-        , singleQuote $ showT lngIndex
-        , "for entry with account"
-        , singleQuote eAcnt
-        , "on"
-        , showT day
-        ]
-    ]
-  (RoundError cur) ->
-    [ T.unwords
-        [ "Could not look up precision for currency"
-        , singleQuote cur
-        ]
-    ]
 
 showGregorian_ :: Gregorian -> T.Text
 showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay]