From 642ebb472715773c5522323e3207c0d2f23b1dc7 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 16 Jul 2023 00:20:01 -0400
Subject: [PATCH] REF use newtype for precision

---
 lib/Internal/Budget.hs         | 10 +++++-----
 lib/Internal/History.hs        |  4 ++--
 lib/Internal/Types/Database.hs |  5 ++++-
 lib/Internal/Types/Main.hs     |  2 --
 lib/Internal/Utils.hs          | 10 +++++++++-
 5 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs
index 5f6a9dc..c962af3 100644
--- a/lib/Internal/Budget.hs
+++ b/lib/Internal/Budget.hs
@@ -104,7 +104,7 @@ readIncome
       (combineError incRes nonIncRes (,))
       (combineError cpRes dayRes (,))
       $ \_ (cp, days) -> do
-        let gross = realFracToDecimal (cpPrec cp) incGross
+        let gross = realFracToDecimal' (cpPrec cp) incGross
         foldDays (allocate cp gross) start days
     where
       srcAcnt' = AcntID srcAcnt
@@ -172,10 +172,10 @@ periodScaler pt prev cur = return scale
       Daily ds -> ds
     scale prec x = case pt of
       Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
-        realFracToDecimal prec (x / fromIntegral hpAnnualHours)
+        realFracToDecimal' prec (x / fromIntegral hpAnnualHours)
           * fromIntegral hpDailyHours
           * fromIntegral n
-      Daily _ -> realFracToDecimal prec (x * fromIntegral n / 365.25)
+      Daily _ -> realFracToDecimal' prec (x * fromIntegral n / 365.25)
 
 -- ASSUME start < end
 workingDays :: [Weekday] -> Day -> Day -> Natural
@@ -273,7 +273,7 @@ allocatePre precision gross = L.mapAccumR go M.empty
       let v =
             if prePercent
               then gross *. (preValue / 100)
-              else realFracToDecimal precision preValue
+              else realFracToDecimal' precision preValue
        in (mapAdd_ preCategory v m, f {faValue = v})
 
 allocateTax
@@ -322,7 +322,7 @@ allocatePost prec aftertax = fmap (fmap go)
   where
     go PosttaxValue {postValue, postPercent}
       | postPercent = aftertax *. (postValue / 100)
-      | otherwise = realFracToDecimal prec postValue
+      | otherwise = realFracToDecimal' prec postValue
 
 --------------------------------------------------------------------------------
 -- shadow transfers
diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs
index 4baf99b..94e0341 100644
--- a/lib/Internal/History.hs
+++ b/lib/Internal/History.hs
@@ -306,7 +306,7 @@ toTx
         , txPrimary =
             Left $
               EntrySet
-                { esTotalValue = roundTo (cpPrec cur) trAmount *. tgScale
+                { esTotalValue = roundToP (cpPrec cur) trAmount *. tgScale
                 , esCurrency = cpID cur
                 , esFrom = f
                 , esTo = t
@@ -403,7 +403,7 @@ resolveValue prec TxRecord {trOther, trAmount} s = case s of
   BalanceN x -> return $ EntryBalance $ go x
   PercentN x -> return $ EntryPercent x
   where
-    go = realFracToDecimal prec
+    go = realFracToDecimal' prec
 
 resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept AcntID
 resolveAcnt r e = AcntID <$> resolveEntryField AcntField r (unAcntID <$> e)
diff --git a/lib/Internal/Types/Database.hs b/lib/Internal/Types/Database.hs
index a6fbc2f..7d18dcb 100644
--- a/lib/Internal/Types/Database.hs
+++ b/lib/Internal/Types/Database.hs
@@ -30,7 +30,7 @@ ConfigStateR sql=config_state
 CurrencyR sql=currencies
     symbol CurID
     fullname T.Text
-    precision Int
+    precision Precision
     UniqueCurrencySymbol symbol
     UniqueCurrencyFullname fullname
     deriving Show Eq Ord
@@ -82,6 +82,9 @@ TagRelationR sql=tag_relations
     deriving Show Eq
 |]
 
+newtype Precision = Precision {unPrecision :: Word8}
+  deriving newtype (Eq, Ord, Num, Show, PersistField, PersistFieldSql)
+
 type DaySpan = (Day, Int)
 
 newtype CommitHash = CommitHash {unCommitHash :: Int}
diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs
index 2e14ab1..4245ece 100644
--- a/lib/Internal/Types/Main.hs
+++ b/lib/Internal/Types/Main.hs
@@ -109,8 +109,6 @@ data CurrencyRound = CurrencyRound CurID Natural
 
 deriving instance Functor (UpdateEntry i)
 
-type Precision = Word8
-
 newtype LinkScale = LinkScale {unLinkScale :: Decimal}
   deriving newtype (Num, Show)
 
diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs
index ba62619..da50816 100644
--- a/lib/Internal/Utils.hs
+++ b/lib/Internal/Utils.hs
@@ -52,6 +52,8 @@ module Internal.Utils
   , entryPair
   , singleQuote
   , keyVals
+  , realFracToDecimal'
+  , roundToP
   )
 where
 
@@ -1016,7 +1018,7 @@ expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, tr
         } = do
         cp <- lookupCurrency transCurrency
         let v' = (-v)
-        let dec = realFracToDecimal (cpPrec cp) v'
+        let dec = realFracToDecimal' (cpPrec cp) v'
         let v'' = case t of
               TFixed -> EntryFixed dec
               TPercent -> EntryPercent v'
@@ -1071,3 +1073,9 @@ sumM f = mapAccumM (\s -> fmap (first (+ s)) . f) 0
 
 mapAccumM :: (Monad m) => (s -> a -> m (s, b)) -> s -> [a] -> m (s, [b])
 mapAccumM f s = foldM (\(s', ys) -> fmap (second (: ys)) . f s') (s, [])
+
+realFracToDecimal' :: (Integral i, RealFrac r) => Precision -> r -> DecimalRaw i
+realFracToDecimal' p = realFracToDecimal (unPrecision p)
+
+roundToP :: Integral i => Precision -> DecimalRaw i -> DecimalRaw i
+roundToP p = roundTo (unPrecision p)