ADD means to scale/flip the value of a transaction

This commit is contained in:
Nathan Dwarshuis 2023-06-20 22:52:52 -04:00
parent 4c88151610
commit 09e03ff675
3 changed files with 12 additions and 3 deletions

View File

@ -593,6 +593,7 @@ let TxGetter =
{ Type = { Type =
{ tgFrom : (TxHalfGetter FromEntryGetter.Type).Type { tgFrom : (TxHalfGetter FromEntryGetter.Type).Type
, tgTo : (TxHalfGetter ToEntryGetter.Type).Type , tgTo : (TxHalfGetter ToEntryGetter.Type).Type
, tgScale : Double
, tgCurrency : EntryCurGetter , tgCurrency : EntryCurGetter
, tgOtherEntries : List TxSubGetter.Type , tgOtherEntries : List TxSubGetter.Type
} }
@ -600,6 +601,7 @@ let TxGetter =
{ tgOtherEntries = [] : List TxSubGetter.Type { tgOtherEntries = [] : List TxSubGetter.Type
, tgFrom = TxHalfGetter , tgFrom = TxHalfGetter
, tgTo = TxHalfGetter , tgTo = TxHalfGetter
, tgScale = 1.0
} }
} }

View File

@ -531,6 +531,7 @@ data TxGetter = TxGetter
, tgTo :: !(TxHalfGetter ToEntryGetter) , tgTo :: !(TxHalfGetter ToEntryGetter)
, tgCurrency :: !EntryCur , tgCurrency :: !EntryCur
, tgOtherEntries :: ![TxSubGetter] , tgOtherEntries :: ![TxSubGetter]
, tgScale :: !Double
} }
deriving (Eq, Generic, Hashable, Show, FromDhall) deriving (Eq, Generic, Hashable, Show, FromDhall)

View File

@ -314,15 +314,16 @@ toTx
, tgTo , tgTo
, tgCurrency , tgCurrency
, tgOtherEntries , tgOtherEntries
, tgScale
} }
r@TxRecord {trAmount, trDate, trDesc} = do r@TxRecord {trAmount, trDate, trDesc} = do
combineError curRes subRes $ \(cur, f, t) ss -> combineError curRes subRes $ \(cur, f, t, v) ss ->
Tx Tx
{ txDate = trDate { txDate = trDate
, txDescr = trDesc , txDescr = trDesc
, txEntries = , txEntries =
EntrySet EntrySet
{ esTotalValue = trAmount { esTotalValue = v
, esCurrency = cur , esCurrency = cur
, esFrom = f , esFrom = f
, esTo = t , esTo = t
@ -331,10 +332,15 @@ toTx
} }
where where
curRes = do curRes = do
m <- ask
cur <- liftInner $ resolveCurrency r tgCurrency cur <- liftInner $ resolveCurrency r tgCurrency
let fromRes = resolveHalfEntry resolveFromValue cur r tgFrom let fromRes = resolveHalfEntry resolveFromValue cur r tgFrom
let toRes = resolveHalfEntry resolveToValue cur r tgTo let toRes = resolveHalfEntry resolveToValue cur r tgTo
combineError fromRes toRes (cur,,) let totRes =
liftExcept $
roundPrecisionCur cur m $
tgScale * fromRational trAmount
combineError3 fromRes toRes totRes (cur,,,)
subRes = mapErrors (resolveSubGetter r) tgOtherEntries subRes = mapErrors (resolveSubGetter r) tgOtherEntries
resolveSubGetter resolveSubGetter