REF use newtype for precision
This commit is contained in:
parent
81f09d1280
commit
642ebb4727
|
@ -104,7 +104,7 @@ readIncome
|
||||||
(combineError incRes nonIncRes (,))
|
(combineError incRes nonIncRes (,))
|
||||||
(combineError cpRes dayRes (,))
|
(combineError cpRes dayRes (,))
|
||||||
$ \_ (cp, days) -> do
|
$ \_ (cp, days) -> do
|
||||||
let gross = realFracToDecimal (cpPrec cp) incGross
|
let gross = realFracToDecimal' (cpPrec cp) incGross
|
||||||
foldDays (allocate cp gross) start days
|
foldDays (allocate cp gross) start days
|
||||||
where
|
where
|
||||||
srcAcnt' = AcntID srcAcnt
|
srcAcnt' = AcntID srcAcnt
|
||||||
|
@ -172,10 +172,10 @@ periodScaler pt prev cur = return scale
|
||||||
Daily ds -> ds
|
Daily ds -> ds
|
||||||
scale prec x = case pt of
|
scale prec x = case pt of
|
||||||
Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
|
Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
|
||||||
realFracToDecimal prec (x / fromIntegral hpAnnualHours)
|
realFracToDecimal' prec (x / fromIntegral hpAnnualHours)
|
||||||
* fromIntegral hpDailyHours
|
* fromIntegral hpDailyHours
|
||||||
* fromIntegral n
|
* fromIntegral n
|
||||||
Daily _ -> realFracToDecimal prec (x * fromIntegral n / 365.25)
|
Daily _ -> realFracToDecimal' prec (x * fromIntegral n / 365.25)
|
||||||
|
|
||||||
-- ASSUME start < end
|
-- ASSUME start < end
|
||||||
workingDays :: [Weekday] -> Day -> Day -> Natural
|
workingDays :: [Weekday] -> Day -> Day -> Natural
|
||||||
|
@ -273,7 +273,7 @@ allocatePre precision gross = L.mapAccumR go M.empty
|
||||||
let v =
|
let v =
|
||||||
if prePercent
|
if prePercent
|
||||||
then gross *. (preValue / 100)
|
then gross *. (preValue / 100)
|
||||||
else realFracToDecimal precision preValue
|
else realFracToDecimal' precision preValue
|
||||||
in (mapAdd_ preCategory v m, f {faValue = v})
|
in (mapAdd_ preCategory v m, f {faValue = v})
|
||||||
|
|
||||||
allocateTax
|
allocateTax
|
||||||
|
@ -322,7 +322,7 @@ allocatePost prec aftertax = fmap (fmap go)
|
||||||
where
|
where
|
||||||
go PosttaxValue {postValue, postPercent}
|
go PosttaxValue {postValue, postPercent}
|
||||||
| postPercent = aftertax *. (postValue / 100)
|
| postPercent = aftertax *. (postValue / 100)
|
||||||
| otherwise = realFracToDecimal prec postValue
|
| otherwise = realFracToDecimal' prec postValue
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- shadow transfers
|
-- shadow transfers
|
||||||
|
|
|
@ -306,7 +306,7 @@ toTx
|
||||||
, txPrimary =
|
, txPrimary =
|
||||||
Left $
|
Left $
|
||||||
EntrySet
|
EntrySet
|
||||||
{ esTotalValue = roundTo (cpPrec cur) trAmount *. tgScale
|
{ esTotalValue = roundToP (cpPrec cur) trAmount *. tgScale
|
||||||
, esCurrency = cpID cur
|
, esCurrency = cpID cur
|
||||||
, esFrom = f
|
, esFrom = f
|
||||||
, esTo = t
|
, esTo = t
|
||||||
|
@ -403,7 +403,7 @@ resolveValue prec TxRecord {trOther, trAmount} s = case s of
|
||||||
BalanceN x -> return $ EntryBalance $ go x
|
BalanceN x -> return $ EntryBalance $ go x
|
||||||
PercentN x -> return $ EntryPercent x
|
PercentN x -> return $ EntryPercent x
|
||||||
where
|
where
|
||||||
go = realFracToDecimal prec
|
go = realFracToDecimal' prec
|
||||||
|
|
||||||
resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept AcntID
|
resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept AcntID
|
||||||
resolveAcnt r e = AcntID <$> resolveEntryField AcntField r (unAcntID <$> e)
|
resolveAcnt r e = AcntID <$> resolveEntryField AcntField r (unAcntID <$> e)
|
||||||
|
|
|
@ -30,7 +30,7 @@ ConfigStateR sql=config_state
|
||||||
CurrencyR sql=currencies
|
CurrencyR sql=currencies
|
||||||
symbol CurID
|
symbol CurID
|
||||||
fullname T.Text
|
fullname T.Text
|
||||||
precision Int
|
precision Precision
|
||||||
UniqueCurrencySymbol symbol
|
UniqueCurrencySymbol symbol
|
||||||
UniqueCurrencyFullname fullname
|
UniqueCurrencyFullname fullname
|
||||||
deriving Show Eq Ord
|
deriving Show Eq Ord
|
||||||
|
@ -82,6 +82,9 @@ TagRelationR sql=tag_relations
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
newtype Precision = Precision {unPrecision :: Word8}
|
||||||
|
deriving newtype (Eq, Ord, Num, Show, PersistField, PersistFieldSql)
|
||||||
|
|
||||||
type DaySpan = (Day, Int)
|
type DaySpan = (Day, Int)
|
||||||
|
|
||||||
newtype CommitHash = CommitHash {unCommitHash :: Int}
|
newtype CommitHash = CommitHash {unCommitHash :: Int}
|
||||||
|
|
|
@ -109,8 +109,6 @@ data CurrencyRound = CurrencyRound CurID Natural
|
||||||
|
|
||||||
deriving instance Functor (UpdateEntry i)
|
deriving instance Functor (UpdateEntry i)
|
||||||
|
|
||||||
type Precision = Word8
|
|
||||||
|
|
||||||
newtype LinkScale = LinkScale {unLinkScale :: Decimal}
|
newtype LinkScale = LinkScale {unLinkScale :: Decimal}
|
||||||
deriving newtype (Num, Show)
|
deriving newtype (Num, Show)
|
||||||
|
|
||||||
|
|
|
@ -52,6 +52,8 @@ module Internal.Utils
|
||||||
, entryPair
|
, entryPair
|
||||||
, singleQuote
|
, singleQuote
|
||||||
, keyVals
|
, keyVals
|
||||||
|
, realFracToDecimal'
|
||||||
|
, roundToP
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -1016,7 +1018,7 @@ expandTransfer tc name bounds Transfer {transAmounts, transTo, transCurrency, tr
|
||||||
} = do
|
} = do
|
||||||
cp <- lookupCurrency transCurrency
|
cp <- lookupCurrency transCurrency
|
||||||
let v' = (-v)
|
let v' = (-v)
|
||||||
let dec = realFracToDecimal (cpPrec cp) v'
|
let dec = realFracToDecimal' (cpPrec cp) v'
|
||||||
let v'' = case t of
|
let v'' = case t of
|
||||||
TFixed -> EntryFixed dec
|
TFixed -> EntryFixed dec
|
||||||
TPercent -> EntryPercent v'
|
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 :: (Monad m) => (s -> a -> m (s, b)) -> s -> [a] -> m (s, [b])
|
||||||
mapAccumM f s = foldM (\(s', ys) -> fmap (second (: ys)) . f s') (s, [])
|
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)
|
||||||
|
|
Loading…
Reference in New Issue