From 09e03ff67552180987bf272ad59d83429d6f0bc1 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Tue, 20 Jun 2023 22:52:52 -0400
Subject: [PATCH] ADD means to scale/flip the value of a transaction

---
 dhall/Types.dhall           |  2 ++
 lib/Internal/Types/Dhall.hs |  1 +
 lib/Internal/Utils.hs       | 12 +++++++++---
 3 files changed, 12 insertions(+), 3 deletions(-)

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