diff --git a/dhall/Types.dhall b/dhall/Types.dhall index 3333671..c0856d4 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -593,6 +593,7 @@ let TxGetter = { Type = { tgFrom : (TxHalfGetter FromEntryGetter.Type).Type , tgTo : (TxHalfGetter ToEntryGetter.Type).Type + , tgScale : Double , tgCurrency : EntryCurGetter , tgOtherEntries : List TxSubGetter.Type } @@ -600,6 +601,7 @@ let TxGetter = { tgOtherEntries = [] : List TxSubGetter.Type , tgFrom = TxHalfGetter , tgTo = TxHalfGetter + , tgScale = 1.0 } } diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index 04b5f86..c677299 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -531,6 +531,7 @@ data TxGetter = TxGetter , tgTo :: !(TxHalfGetter ToEntryGetter) , tgCurrency :: !EntryCur , tgOtherEntries :: ![TxSubGetter] + , tgScale :: !Double } deriving (Eq, Generic, Hashable, Show, FromDhall) diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index ac3d062..0824b50 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -314,15 +314,16 @@ toTx , tgTo , tgCurrency , tgOtherEntries + , tgScale } r@TxRecord {trAmount, trDate, trDesc} = do - combineError curRes subRes $ \(cur, f, t) ss -> + combineError curRes subRes $ \(cur, f, t, v) ss -> Tx { txDate = trDate , txDescr = trDesc , txEntries = EntrySet - { esTotalValue = trAmount + { esTotalValue = v , esCurrency = cur , esFrom = f , esTo = t @@ -331,10 +332,15 @@ toTx } where curRes = do + m <- ask cur <- liftInner $ resolveCurrency r tgCurrency let fromRes = resolveHalfEntry resolveFromValue cur r tgFrom 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 resolveSubGetter