ENH allow multiple entries on credit side of transaction statement getter

dhall/Types.dhall

@@ -472,9 +472,19 @@ let Entry =
             List t
         }
 
-let EntryGetter =
+let FromEntryGetter =
     {-
-    Means for getting an entry from a given row in a statement
+    Means for getting an entry from a given row in a statement to apply to the
+    credit side of the transaction.
+    -}
+      { Type = Entry EntryAcntGetter EntryNumGetter EntryCurGetter TagID
+      , default = { eValue = None EntryNumGetter, eComment = "" }
+      }
+
+let ToEntryGetter =
+    {-
+    Means for getting an entry from a given row in a statement to apply to the
+    debit side of the transaction.
     -}
       { Type =
           Entry EntryAcntGetter (Optional EntryNumGetter) EntryCurGetter TagID
@@ -488,21 +498,37 @@ let TxGetter =
     Note that N-1 entries need to be specified to make a transaction, as the
     Nth entry will be balanced with the others.
     -}
-      { tgEntries :
+      { tgFromAcnt :
+          {-
+          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
+      , tgFromCurrency :
+          {-
+          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 FromEntryGetter.Type
+      , tgToEntries :
           {-
           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
+          List ToEntryGetter.Type
       }
 
 let StatementParser_ =
@@ -1051,7 +1077,8 @@ in  { CurID
     , Field
     , FieldMap
     , Entry
-    , EntryGetter
+    , FromEntryGetter
+    , ToEntryGetter
     , EntryTextGetter
     , EntryCurGetter
     , EntryAcntGetter

lib/Internal/Types/Dhall.hs

@@ -421,9 +421,13 @@ data History
   | HistStatement !Statement
   deriving (Eq, Generic, Hashable, FromDhall)
 
-type EntryGetter = Entry EntryAcnt (Maybe EntryNumGetter) EntryCur TagID
+type ToEntryGetter = Entry EntryAcnt (Maybe EntryNumGetter) EntryCur TagID
 
-instance FromDhall EntryGetter
+type FromEntryGetter = Entry EntryAcnt EntryNumGetter EntryCur TagID
+
+instance FromDhall ToEntryGetter
+
+instance FromDhall FromEntryGetter
 
 deriving instance (Show a, Show c, Show v, Show t) => Show (Entry a v c t)
 
@@ -440,10 +444,6 @@ data Tx s = Tx
   }
   deriving (Generic)
 
-type ExpTx = Tx EntryGetter
-
-instance FromDhall ExpTx
-
 data TxOpts re = TxOpts
   { toDate :: !T.Text
   , toAmount :: !T.Text
@@ -504,9 +504,10 @@ data FieldMatcher re
 deriving instance Show (FieldMatcher T.Text)
 
 data TxGetter = TxGetter
-  { tgCurrency :: !EntryCur
-  , tgAcnt :: !EntryAcnt
-  , tgEntries :: ![EntryGetter]
+  { tgFromAcnt :: !EntryAcnt
+  , tgFromCurrency :: !EntryCur
+  , tgFromEntries :: ![FromEntryGetter]
+  , tgToEntries :: ![ToEntryGetter]
   }
   deriving (Eq, Generic, Hashable, Show, FromDhall)
 

lib/Internal/Types/Main.hs

@@ -129,6 +129,8 @@ accountSign EquityT = Credit
 
 type RawEntry = Entry AcntID (Maybe Rational) CurID TagID
 
+type RawFromEntry = Entry AcntID Rational CurID TagID
+
 type BalEntry = Entry AcntID Rational CurID TagID
 
 type RawTx = Tx RawEntry

lib/Internal/Utils.hs

@@ -304,28 +304,41 @@ matches
       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
+      convert TxGetter {tgFromAcnt, tgFromCurrency, tgFromEntries, tgToEntries} =
+        MatchPass <$> toTx tgFromCurrency tgFromAcnt tgFromEntries tgToEntries 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 =
+toTx
+  :: EntryCur
+  -> EntryAcnt
+  -> [FromEntryGetter]
+  -> [ToEntryGetter]
+  -> TxRecord
+  -> InsertExceptT CurrencyM RawTx
+toTx sc sa fromEntries toEntries r@TxRecord {trAmount, trDate, trDesc} = do
+  combineError
+    (combineError acntRes curRes (,))
+    (combineError fromRes toRes (,))
+    $ \(a, c) (fs, ts) ->
+      let fromValue = trAmount - sum (fmap eValue fs)
+          fromEntry =
             Entry
               { eAcnt = a
               , eCurrency = c
-            , eValue = Just trAmount
+              , eValue = Just fromValue
               , eComment = ""
               , eTags = [] -- TODO what goes here?
               }
        in Tx
             { txDate = trDate
             , txDescr = trDesc
-          , txEntries = fromEntry : es
+            , txEntries = fromEntry : fmap liftEntry fs ++ ts
             }
   where
     acntRes = liftInner $ resolveAcnt r sa
     curRes = liftInner $ resolveCurrency r sc
-    ssRes = combineErrors $ fmap (resolveEntry r) toEntries
+    fromRes = combineErrors $ fmap (resolveFromEntry r) fromEntries
+    toRes = combineErrors $ fmap (resolveToEntry r) toEntries
+    liftEntry e = e {eValue = Just $ eValue e}
 
 valMatches :: ValMatcher -> Rational -> InsertExcept Bool
 valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
@@ -351,8 +364,20 @@ otherMatches dict m = case m of
   where
     lookup_ t n = lookupErr (MatchField t) n dict
 
-resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawEntry
-resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do
+resolveFromEntry :: TxRecord -> FromEntryGetter -> InsertExceptT CurrencyM RawFromEntry
+resolveFromEntry r s@Entry {eAcnt, eValue, eCurrency} = do
+  m <- ask
+  liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
+    v' <- roundPrecisionCur c m v
+    return $ s {eAcnt = a, eValue = v', eCurrency = c}
+  where
+    acntRes = resolveAcnt r eAcnt
+    curRes = resolveCurrency r eCurrency
+    valRes = resolveValue r eValue
+
+-- TODO wet code (kinda, not sure if it's worth combining with above)
+resolveToEntry :: TxRecord -> ToEntryGetter -> InsertExceptT CurrencyM RawEntry
+resolveToEntry r s@Entry {eAcnt, eValue, eCurrency} = do
   m <- ask
   liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
     v' <- mapM (roundPrecisionCur c m) v