ADD means to scale/flip the value of a transaction
This commit is contained in:
parent
4c88151610
commit
09e03ff675
|
@ -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
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue