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
|
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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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]
|
||||||
Entry
|
-> [ToEntryGetter]
|
||||||
{ eAcnt = a
|
-> TxRecord
|
||||||
, eCurrency = c
|
-> InsertExceptT CurrencyM RawTx
|
||||||
, eValue = Just trAmount
|
toTx sc sa fromEntries toEntries r@TxRecord {trAmount, trDate, trDesc} = do
|
||||||
, eComment = ""
|
combineError
|
||||||
, eTags = [] -- TODO what goes here?
|
(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
|
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
|
||||||
|
|
Loading…
Reference in New Issue