ENH allow multiple entries on credit side of transaction statement getter

This commit is contained in:
Nathan Dwarshuis 2023-06-10 21:30:30 -04:00
parent 53d77326f5
commit 776a10ba11
4 changed files with 98 additions and 43 deletions

View File

@ -472,9 +472,19 @@ let Entry =
List t 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 = { Type =
Entry EntryAcntGetter (Optional EntryNumGetter) EntryCurGetter TagID 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 Note that N-1 entries need to be specified to make a transaction, as the
Nth entry will be balanced with the others. 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) A means of getting entries for this transaction (minimum 1)
-} -}
List EntryGetter.Type List ToEntryGetter.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
} }
let StatementParser_ = let StatementParser_ =
@ -1051,7 +1077,8 @@ in { CurID
, Field , Field
, FieldMap , FieldMap
, Entry , Entry
, EntryGetter , FromEntryGetter
, ToEntryGetter
, EntryTextGetter , EntryTextGetter
, EntryCurGetter , EntryCurGetter
, EntryAcntGetter , EntryAcntGetter

View File

@ -421,9 +421,13 @@ data History
| HistStatement !Statement | HistStatement !Statement
deriving (Eq, Generic, Hashable, FromDhall) 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) 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) deriving (Generic)
type ExpTx = Tx EntryGetter
instance FromDhall ExpTx
data TxOpts re = TxOpts data TxOpts re = TxOpts
{ toDate :: !T.Text { toDate :: !T.Text
, toAmount :: !T.Text , toAmount :: !T.Text
@ -504,9 +504,10 @@ data FieldMatcher re
deriving instance Show (FieldMatcher T.Text) deriving instance Show (FieldMatcher T.Text)
data TxGetter = TxGetter data TxGetter = TxGetter
{ tgCurrency :: !EntryCur { tgFromAcnt :: !EntryAcnt
, tgAcnt :: !EntryAcnt , tgFromCurrency :: !EntryCur
, tgEntries :: ![EntryGetter] , tgFromEntries :: ![FromEntryGetter]
, tgToEntries :: ![ToEntryGetter]
} }
deriving (Eq, Generic, Hashable, Show, FromDhall) deriving (Eq, Generic, Hashable, Show, FromDhall)

View File

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

View File

@ -304,28 +304,41 @@ matches
date = maybe True (`dateMatches` trDate) spDate date = maybe True (`dateMatches` trDate) spDate
other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther other = foldM (\a o -> (a &&) <$> otherMatches trOther o) True spOther
desc = maybe (return True) (matchMaybe trDesc . snd) spDesc 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
toTx sc sa toEntries r@TxRecord {trAmount, trDate, trDesc} = do :: EntryCur
combineError3 acntRes curRes ssRes $ \a c es -> -> EntryAcnt
let fromEntry = -> [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 Entry
{ eAcnt = a { eAcnt = a
, eCurrency = c , eCurrency = c
, eValue = Just trAmount , eValue = Just fromValue
, eComment = "" , eComment = ""
, eTags = [] -- TODO what goes here? , eTags = [] -- TODO what goes here?
} }
in Tx in Tx
{ txDate = trDate { txDate = trDate
, txDescr = trDesc , txDescr = trDesc
, txEntries = fromEntry : es , txEntries = fromEntry : fmap liftEntry fs ++ ts
} }
where where
acntRes = liftInner $ resolveAcnt r sa acntRes = liftInner $ resolveAcnt r sa
curRes = liftInner $ resolveCurrency r sc 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 -> Rational -> InsertExcept Bool
valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
@ -351,8 +364,20 @@ otherMatches dict m = case m of
where where
lookup_ t n = lookupErr (MatchField t) n dict lookup_ t n = lookupErr (MatchField t) n dict
resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawEntry resolveFromEntry :: TxRecord -> FromEntryGetter -> InsertExceptT CurrencyM RawFromEntry
resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do 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 m <- ask
liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
v' <- mapM (roundPrecisionCur c m) v v' <- mapM (roundPrecisionCur c m) v