ENH allow multiple entries on credit side of transaction statement getter
This commit is contained in:
parent
53d77326f5
commit
776a10ba11
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
Entry
|
||||
{ eAcnt = a
|
||||
, eCurrency = c
|
||||
, eValue = Just trAmount
|
||||
, eComment = ""
|
||||
, eTags = [] -- TODO what goes here?
|
||||
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 fromValue
|
||||
, eComment = ""
|
||||
, eTags = [] -- TODO what goes here?
|
||||
}
|
||||
in Tx
|
||||
{ txDate = trDate
|
||||
, txDescr = trDesc
|
||||
, txEntries = fromEntry : fmap liftEntry fs ++ ts
|
||||
}
|
||||
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
|
||||
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
|
||||
|
|
Loading…
Reference in New Issue