REF use newtype for precision

This commit is contained in:
Nathan Dwarshuis 2023-07-16 00:20:01 -04:00
parent 81f09d1280
commit 642ebb4727
5 changed files with 20 additions and 11 deletions

View File

@ -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

View File

@ -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)

View File

@ -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}

View File

@ -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)

View File

@ -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)