lib,cli: Get rid of magic values for asprecision, use a sum type instead.

This commit is contained in:
Stephen Morgan 2020-08-13 21:15:41 +10:00
parent ee1ef9606b
commit f6fa76bba7
10 changed files with 74 additions and 89 deletions

View File

@ -74,13 +74,9 @@ module Hledger.Data.Amount (
showAmountWithZeroCommodity, showAmountWithZeroCommodity,
showAmountDebug, showAmountDebug,
showAmountWithoutPrice, showAmountWithoutPrice,
maxprecision,
maxprecisionwithpoint,
setAmountPrecision, setAmountPrecision,
withPrecision, withPrecision,
setFullPrecision, setFullPrecision,
setNaturalPrecision,
setNaturalPrecisionUpTo,
setAmountInternalPrecision, setAmountInternalPrecision,
withInternalPrecision, withInternalPrecision,
setAmountDecimalPoint, setAmountDecimalPoint,
@ -129,7 +125,7 @@ module Hledger.Data.Amount (
import Control.Monad (foldM) import Control.Monad (foldM)
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal) import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo)
import Data.Function (on) import Data.Function (on)
import Data.List import Data.List
import qualified Data.Map as M import qualified Data.Map as M
@ -151,7 +147,7 @@ deriving instance Show MarketPrice
-- Amount styles -- Amount styles
-- | Default amount style -- | Default amount style
amountstyle = AmountStyle L False 0 (Just '.') Nothing amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -178,11 +174,11 @@ missingamt = amount{acommodity="AUTO"}
-- Handy amount constructors for tests. -- Handy amount constructors for tests.
-- usd/eur/gbp round their argument to a whole number of pennies/cents. -- usd/eur/gbp round their argument to a whole number of pennies/cents.
num n = amount{acommodity="", aquantity=n} num n = amount{acommodity="", aquantity=n}
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=2, ascommodityside=R}} hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=Precision 2, ascommodityside=R}}
usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
eur n = amount{acommodity="", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} eur n = amount{acommodity="", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}
per n = amount{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R, ascommodityspaced=True}} per n = amount{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}}
amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt}
amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt}
@ -228,8 +224,13 @@ amountCost a@Amount{aquantity=q, aprice=mp} =
-- Does Decimal division, might be some rounding/irrational number issues. -- Does Decimal division, might be some rounding/irrational number issues.
amountTotalPriceToUnitPrice :: Amount -> Amount amountTotalPriceToUnitPrice :: Amount -> Amount
amountTotalPriceToUnitPrice amountTotalPriceToUnitPrice
a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}})} a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps})}
= a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}} = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp}}}
where
-- Increase the precision by 1, capping at the max bound.
pp = case asprecision ps of
NaturalPrecision -> NaturalPrecision
Precision p -> Precision $ if p == maxBound then maxBound else p + 1
amountTotalPriceToUnitPrice a = a amountTotalPriceToUnitPrice a = a
-- | Divide an amount's quantity by a constant. -- | Divide an amount's quantity by a constant.
@ -260,11 +261,17 @@ multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, apric
isNegativeAmount :: Amount -> Bool isNegativeAmount :: Amount -> Bool
isNegativeAmount Amount{aquantity=q} = q < 0 isNegativeAmount Amount{aquantity=q} = q < 0
-- | Round an Amount to its specified display precision. If that is
-- NaturalPrecision, this does nothing.
amountRoundedQuantity :: Amount -> Quantity
amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = case p of
NaturalPrecision -> q
Precision p' -> roundTo p' q
-- | Does mixed amount appear to be zero when rendered with its -- | Does mixed amount appear to be zero when rendered with its
-- display precision ? -- display precision ?
amountLooksZero :: Amount -> Bool amountLooksZero :: Amount -> Bool
amountLooksZero Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = amountLooksZero = (0==) . amountRoundedQuantity
roundTo p q == 0
-- | Is this amount exactly zero, ignoring its display precision ? -- | Is this amount exactly zero, ignoring its display precision ?
amountIsZero :: Amount -> Bool amountIsZero :: Amount -> Bool
@ -272,43 +279,26 @@ amountIsZero Amount{aquantity=q} = q == 0
-- | Get the string representation of an amount, based on its commodity's -- | Get the string representation of an amount, based on its commodity's
-- display settings except using the specified precision. -- display settings except using the specified precision.
showAmountWithPrecision :: Word8 -> Amount -> String showAmountWithPrecision :: AmountPrecision -> Amount -> String
showAmountWithPrecision p = showAmount . setAmountPrecision p showAmountWithPrecision p = showAmount . setAmountPrecision p
-- | Set an amount's display precision, flipped. -- | Set an amount's display precision, flipped.
withPrecision :: Amount -> Word8 -> Amount withPrecision :: Amount -> AmountPrecision -> Amount
withPrecision = flip setAmountPrecision withPrecision = flip setAmountPrecision
-- | Set an amount's display precision. -- | Set an amount's display precision.
setAmountPrecision :: Word8 -> Amount -> Amount setAmountPrecision :: AmountPrecision -> Amount -> Amount
setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}} setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}
-- | Increase an amount's display precision, if needed, to enough -- | Increase an amount's display precision, if needed, to enough decimal places
-- decimal places to show it exactly (showing all significant decimal -- to show it exactly (showing all significant decimal digits, excluding trailing
-- digits, excluding trailing zeros). -- zeros).
setFullPrecision :: Amount -> Amount setFullPrecision :: Amount -> Amount
setFullPrecision a = setAmountPrecision p a setFullPrecision a = setAmountPrecision p a
where where
p = max displayprecision naturalprecision p = max displayprecision naturalprecision
displayprecision = asprecision $ astyle a displayprecision = asprecision $ astyle a
naturalprecision = decimalPlaces . normalizeDecimal $ aquantity a naturalprecision = Precision . decimalPlaces . normalizeDecimal $ aquantity a
-- | Set an amount's display precision to just enough decimal places
-- to show it exactly (possibly less than the number specified by
-- the amount's display style).
setNaturalPrecision :: Amount -> Amount
setNaturalPrecision a = setAmountPrecision normalprecision a
where
normalprecision = decimalPlaces . normalizeDecimal $ aquantity a
-- | Set an amount's display precision to just enough decimal places
-- to show it exactly (possibly less than the number specified by the
-- amount's display style), but not more than the given maximum number
-- of decimal digits.
setNaturalPrecisionUpTo :: Word8 -> Amount -> Amount
setNaturalPrecisionUpTo n a = setAmountPrecision (min n normalprecision) a
where
normalprecision = decimalPlaces . normalizeDecimal $ aquantity a
-- | Get a string representation of an amount for debugging, -- | Get a string representation of an amount for debugging,
-- appropriate to the current debug level. 9 shows maximum detail. -- appropriate to the current debug level. 9 shows maximum detail.
@ -331,7 +321,7 @@ showAmountWithoutPrice c a = showamt a{aprice=Nothing}
-- Intended only for internal use, eg when comparing amounts in tests. -- Intended only for internal use, eg when comparing amounts in tests.
setAmountInternalPrecision :: Word8 -> Amount -> Amount setAmountInternalPrecision :: Word8 -> Amount -> Amount
setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{
astyle=s{asprecision=p} astyle=s{asprecision=Precision p}
,aquantity=roundTo p q ,aquantity=roundTo p q
} }
@ -408,14 +398,8 @@ showAmountWithZeroCommodity = showAmountHelper True
-- | Get the string representation of the number part of of an amount, -- | Get the string representation of the number part of of an amount,
-- using the display settings from its commodity. -- using the display settings from its commodity.
showamountquantity :: Amount -> String showamountquantity :: Amount -> String
showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecimalpoint=mdec, asdigitgroups=mgrps}} = showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
punctuatenumber (fromMaybe '.' mdec) mgrps qstr punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt
where
-- isint n = round n == n
qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer)
| p == maxprecisionwithpoint = show q
| p == maxprecision = chopdotzero $ show q
| otherwise = show $ roundTo p q
-- | Replace a number string's decimal mark with the specified -- | Replace a number string's decimal mark with the specified
-- character, and add the specified digit group marks. The last digit -- character, and add the specified digit group marks. The last digit
@ -441,18 +425,6 @@ applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s
repeatLast [] = [] repeatLast [] = []
repeatLast gs = init gs ++ repeat (last gs) repeatLast gs = init gs ++ repeat (last gs)
chopdotzero str = reverse $ case reverse str of
'0':'.':s -> s
s -> s
-- | For rendering: a special precision value which means show all available digits.
maxprecision :: Word8
maxprecision = 254
-- | For rendering: a special precision value which forces display of a decimal point.
maxprecisionwithpoint :: Word8
maxprecisionwithpoint = 255
-- like journalCanonicaliseAmounts -- like journalCanonicaliseAmounts
-- | Canonicalise an amount's display style using the provided commodity style map. -- | Canonicalise an amount's display style using the provided commodity style map.
canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
@ -666,13 +638,13 @@ ltraceamount :: String -> MixedAmount -> MixedAmount
ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount) ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)
-- | Set the display precision in the amount's commodities. -- | Set the display precision in the amount's commodities.
setMixedAmountPrecision :: Word8 -> MixedAmount -> MixedAmount setMixedAmountPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as
-- | Get the string representation of a mixed amount, showing each of its -- | Get the string representation of a mixed amount, showing each of its
-- component amounts with the specified precision, ignoring their -- component amounts with the specified precision, ignoring their
-- commoditys' display precision settings. -- commoditys' display precision settings.
showMixedAmountWithPrecision :: Word8 -> MixedAmount -> String showMixedAmountWithPrecision :: AmountPrecision -> MixedAmount -> String
showMixedAmountWithPrecision p m = showMixedAmountWithPrecision p m =
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m
@ -764,8 +736,8 @@ tests_Amount = tests "Amount" [
(usd (-1.23) + usd (-1.23)) @?= usd (-2.46) (usd (-1.23) + usd (-1.23)) @?= usd (-2.46)
sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0 sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0
-- highest precision is preserved -- highest precision is preserved
asprecision (astyle $ sum [usd 1 `withPrecision` 1, usd 1 `withPrecision` 3]) @?= 3 asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Precision 3
asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) @?= 3 asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3
-- adding different commodities assumes conversion rate 1 -- adding different commodities assumes conversion rate 1
assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23)
@ -779,10 +751,10 @@ tests_Amount = tests "Amount" [
test "adding mixed amounts to zero, the commodity and amount style are preserved" $ test "adding mixed amounts to zero, the commodity and amount style are preserved" $
sum (map (Mixed . (:[])) sum (map (Mixed . (:[]))
[usd 1.25 [usd 1.25
,usd (-1) `withPrecision` 3 ,usd (-1) `withPrecision` Precision 3
,usd (-0.25) ,usd (-0.25)
]) ])
@?= Mixed [usd 0 `withPrecision` 3] @?= Mixed [usd 0 `withPrecision` Precision 3]
,test "adding mixed amounts with total prices" $ do ,test "adding mixed amounts with total prices" $ do
sum (map (Mixed . (:[])) sum (map (Mixed . (:[]))

View File

@ -1495,26 +1495,26 @@ tests_Journal = tests "Journal" [
-- --
test "1091a" $ do test "1091a" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
,nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
] ]
@?= @?=
-- The commodity style should have period as decimal mark -- The commodity style should have period as decimal mark
-- and comma as digit group mark. -- and comma as digit group mark.
Right (M.fromList [ Right (M.fromList [
("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3]))) ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))
]) ])
-- same journal, entries in reverse order -- same journal, entries in reverse order
,test "1091b" $ do ,test "1091b" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
,nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
] ]
@?= @?=
-- The commodity style should have period as decimal mark -- The commodity style should have period as decimal mark
-- and comma as digit group mark. -- and comma as digit group mark.
Right (M.fromList [ Right (M.fromList [
("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3]))) ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))
]) ])
] ]

View File

@ -89,6 +89,7 @@ instance ToJSON Decimal where
instance ToJSON Amount instance ToJSON Amount
instance ToJSON AmountStyle instance ToJSON AmountStyle
instance ToJSON AmountPrecision
instance ToJSON Side instance ToJSON Side
instance ToJSON DigitGroupStyle instance ToJSON DigitGroupStyle
instance ToJSON MixedAmount instance ToJSON MixedAmount
@ -158,6 +159,7 @@ instance FromJSON Status
instance FromJSON GenericSourcePos instance FromJSON GenericSourcePos
instance FromJSON Amount instance FromJSON Amount
instance FromJSON AmountStyle instance FromJSON AmountStyle
instance FromJSON AmountPrecision
instance FromJSON Side instance FromJSON Side
instance FromJSON DigitGroupStyle instance FromJSON DigitGroupStyle
instance FromJSON MixedAmount instance FromJSON MixedAmount

View File

@ -540,15 +540,20 @@ priceInferrerFor t pt = inferprice
where where
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
conversionprice conversionprice
| fromcount==1 = TotalPrice $ abs toamount `withPrecision` maxprecision | fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision
| otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision | otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision
where where
fromcount = length $ filter ((==fromcommodity).acommodity) pamounts fromcount = length $ filter ((==fromcommodity).acommodity) pamounts
fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts
fromprecision = asprecision $ astyle fromamount
tocommodity = head $ filter (/=fromcommodity) sumcommodities tocommodity = head $ filter (/=fromcommodity) sumcommodities
toamount = head $ filter ((==tocommodity).acommodity) sumamounts toamount = head $ filter ((==tocommodity).acommodity) sumamounts
toprecision = asprecision $ astyle toamount
unitprice = (aquantity fromamount) `divideAmount` toamount unitprice = (aquantity fromamount) `divideAmount` toamount
unitprecision = max 2 (asprecision (astyle toamount) + asprecision (astyle fromamount)) -- Sum two display precisions, capping the result at the maximum bound
unitprecision = case (fromprecision, toprecision) of
(Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)
_ -> NaturalPrecision
inferprice p = p inferprice p = p
-- Get a transaction's secondary date, defaulting to the primary date. -- Get a transaction's secondary date, defaulting to the primary date.
@ -772,7 +777,7 @@ tests_Transaction =
"x" "x"
"" ""
[] []
[ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]}
, posting {paccount = "b", pamount = missingmixedamt} , posting {paccount = "b", pamount = missingmixedamt}
])) @?= ])) @?=
(unlines ["2010-01-01 x", " a 1 @ $2", " b", ""]) (unlines ["2010-01-01 x", " a 1 @ $2", " b", ""])
@ -847,7 +852,7 @@ tests_Transaction =
[ posting {paccount = "a", pamount = Mixed [usd 1.35]} [ posting {paccount = "a", pamount = Mixed [usd 1.35]}
, posting {paccount = "b", pamount = Mixed [eur (-1)]} , posting {paccount = "b", pamount = Mixed [eur (-1)]}
])) @?= ])) @?=
Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` NaturalPrecision)])
,test "balanceTransaction balances based on cost if there are unit prices" $ ,test "balanceTransaction balances based on cost if there are unit prices" $
assertRight $ assertRight $
balanceTransaction balanceTransaction

View File

@ -193,7 +193,7 @@ instance NFData AmountPrice
data AmountStyle = AmountStyle { data AmountStyle = AmountStyle {
ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ? ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ?
ascommodityspaced :: Bool, -- ^ space between symbol and quantity ? ascommodityspaced :: Bool, -- ^ space between symbol and quantity ?
asprecision :: !Word8, -- ^ number of digits displayed after the decimal point asprecision :: !AmountPrecision, -- ^ number of digits displayed after the decimal point
asdecimalpoint :: Maybe Char, -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default" asdecimalpoint :: Maybe Char, -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"
asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any
} deriving (Eq,Ord,Read,Typeable,Data,Generic) } deriving (Eq,Ord,Read,Typeable,Data,Generic)
@ -209,6 +209,10 @@ instance Show AmountStyle where
(show asdecimalpoint) (show asdecimalpoint)
(show asdigitgroups) (show asdigitgroups)
data AmountPrecision = Precision !Word8 | NaturalPrecision deriving (Eq,Ord,Read,Show,Typeable,Data,Generic)
instance NFData AmountPrecision
-- | A style for displaying digit groups in the integer part of a -- | A style for displaying digit groups in the integer part of a
-- floating point number. It consists of the character used to -- floating point number. It consists of the character used to
-- separate groups (comma or period, whichever is not used as decimal -- separate groups (comma or period, whichever is not used as decimal

View File

@ -707,13 +707,13 @@ amountwithoutpricep = do
-> Maybe AmountStyle -> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber -> Either AmbiguousNumber RawNumber
-> Maybe Integer -> Maybe Integer
-> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) -> TextParser m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber posRegion suggestedStyle ambiguousNum mExp = interpretNumber posRegion suggestedStyle ambiguousNum mExp =
let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum
in case fromRawNumber rawNum mExp of in case fromRawNumber rawNum mExp of
Left errMsg -> customFailure $ Left errMsg -> customFailure $
uncurry parseErrorAtRegion posRegion errMsg uncurry parseErrorAtRegion posRegion errMsg
Right res -> pure res Right (q,p,d,g) -> pure (q, Precision p, d, g)
-- | Parse an amount from a string, or get an error. -- | Parse an amount from a string, or get an error.
amountp' :: String -> Amount amountp' :: String -> Amount
@ -890,7 +890,7 @@ disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) =
isValidDecimalBy c = \case isValidDecimalBy c = \case
AmountStyle{asdecimalpoint = Just d} -> d == c AmountStyle{asdecimalpoint = Just d} -> d == c
AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c
AmountStyle{asprecision = 0} -> False AmountStyle{asprecision = Precision 0} -> False
_ -> True _ -> True
-- | Parse and interpret the structure of a number without external hints. -- | Parse and interpret the structure of a number without external hints.
@ -1340,31 +1340,31 @@ tests_Common = tests "Common" [
tests "amountp" [ tests "amountp" [
test "basic" $ assertParseEq amountp "$47.18" (usd 47.18) test "basic" $ assertParseEq amountp "$47.18" (usd 47.18)
,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` 0) ,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 0)
,test "unit price" $ assertParseEq amountp "$10 @ €0.5" ,test "unit price" $ assertParseEq amountp "$10 @ €0.5"
-- not precise enough: -- not precise enough:
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 -- need to test internal precision with roundTo ? I think not ,aquantity=10 -- need to test internal precision with roundTo ? I think not
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
,aprice=Just $ UnitPrice $ ,aprice=Just $ UnitPrice $
amount{ amount{
acommodity="" acommodity=""
,aquantity=0.5 ,aquantity=0.5
,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'} ,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'}
} }
} }
,test "total price" $ assertParseEq amountp "$10 @@ €5" ,test "total price" $ assertParseEq amountp "$10 @@ €5"
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 ,aquantity=10
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
,aprice=Just $ TotalPrice $ ,aprice=Just $ TotalPrice $
amount{ amount{
acommodity="" acommodity=""
,aquantity=5 ,aquantity=5
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
} }
} }
,test "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5" ,test "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"

View File

@ -182,7 +182,7 @@ entryp = do
tstatus = Cleared, tstatus = Cleared,
tpostings = [ tpostings = [
nullposting{paccount=a nullposting{paccount=a
,pamount=Mixed [setAmountPrecision 2 $ num hours] -- don't assume hours; do set precision to 2 ,pamount=Mixed [setAmountPrecision (Precision 2) $ num hours] -- don't assume hours; do set precision to 2
,ptype=VirtualPosting ,ptype=VirtualPosting
,ptransaction=Just t ,ptransaction=Just t
} }

View File

@ -605,7 +605,7 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = tests "MultiBalanceReport" [
let let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
(opts,journal) `gives` r = do (opts,journal) `gives` r = do
let (eitems, etotal) = r let (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal (PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal

View File

@ -371,7 +371,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
-- 4 maximum precision entered so far in this transaction ? -- 4 maximum precision entered so far in this transaction ?
-- 5 3 or 4, whichever would show the most decimal places ? -- 5 3 or 4, whichever would show the most decimal places ?
-- I think 1 or 4, whichever would show the most decimal places -- I think 1 or 4, whichever would show the most decimal places
maxprecisionwithpoint NaturalPrecision
-- --
-- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt -- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
-- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt -- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt

View File

@ -50,7 +50,9 @@ divideAmount' n a = a' where
a' = (n `divideAmount` a) { astyle = style' } a' = (n `divideAmount` a) { astyle = style' }
style' = (astyle a) { asprecision = precision' } style' = (astyle a) { asprecision = precision' }
extPrecision = (1+) . floor . logBase 10 $ (realToFrac n :: Double) extPrecision = (1+) . floor . logBase 10 $ (realToFrac n :: Double)
precision' = extPrecision + asprecision (astyle a) precision' = case asprecision (astyle a) of
NaturalPrecision -> NaturalPrecision
Precision p -> Precision $ extPrecision + p
-- XXX -- XXX