lib: Make aprecision and DigitGroupStyle use Word8 instead of Int. exponentp now parses an Integer rather than an Int.

This commit is contained in:
Stephen Morgan 2020-08-09 22:31:16 +10:00
parent 371b349b2e
commit b5ed2067d9
3 changed files with 48 additions and 43 deletions

View File

@ -136,6 +136,7 @@ import qualified Data.Map as M
import Data.Map (findWithDefault) import Data.Map (findWithDefault)
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Word (Word8)
import Safe (lastDef, maximumMay) import Safe (lastDef, maximumMay)
import Text.Printf import Text.Printf
@ -263,7 +264,7 @@ isNegativeAmount Amount{aquantity=q} = q < 0
-- display precision ? -- display precision ?
amountLooksZero :: Amount -> Bool amountLooksZero :: Amount -> Bool
amountLooksZero Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = amountLooksZero Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} =
roundTo (fromIntegral p) q == 0 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
@ -271,15 +272,15 @@ 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 :: Int -> Amount -> String showAmountWithPrecision :: Word8 -> 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 -> Int -> Amount withPrecision :: Amount -> Word8 -> Amount
withPrecision = flip setAmountPrecision withPrecision = flip setAmountPrecision
-- | Set an amount's display precision. -- | Set an amount's display precision.
setAmountPrecision :: Int -> Amount -> Amount setAmountPrecision :: Word8 -> 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
@ -290,7 +291,7 @@ setFullPrecision a = setAmountPrecision p a
where where
p = max displayprecision naturalprecision p = max displayprecision naturalprecision
displayprecision = asprecision $ astyle a displayprecision = asprecision $ astyle a
naturalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a naturalprecision = decimalPlaces . normalizeDecimal $ aquantity a
-- | Set an amount's display precision to just enough decimal places -- | Set an amount's display precision to just enough decimal places
-- to show it exactly (possibly less than the number specified by -- to show it exactly (possibly less than the number specified by
@ -298,16 +299,16 @@ setFullPrecision a = setAmountPrecision p a
setNaturalPrecision :: Amount -> Amount setNaturalPrecision :: Amount -> Amount
setNaturalPrecision a = setAmountPrecision normalprecision a setNaturalPrecision a = setAmountPrecision normalprecision a
where where
normalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a normalprecision = decimalPlaces . normalizeDecimal $ aquantity a
-- | Set an amount's display precision to just enough decimal places -- | Set an amount's display precision to just enough decimal places
-- to show it exactly (possibly less than the number specified by the -- to show it exactly (possibly less than the number specified by the
-- amount's display style), but not more than the given maximum number -- amount's display style), but not more than the given maximum number
-- of decimal digits. -- of decimal digits.
setNaturalPrecisionUpTo :: Int -> Amount -> Amount setNaturalPrecisionUpTo :: Word8 -> Amount -> Amount
setNaturalPrecisionUpTo n a = setAmountPrecision (min n normalprecision) a setNaturalPrecisionUpTo n a = setAmountPrecision (min n normalprecision) a
where where
normalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a 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.
@ -328,15 +329,15 @@ showAmountWithoutPrice c a = showamt a{aprice=Nothing}
-- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)". -- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)".
-- Does not change the amount's display precision. -- Does not change the amount's display precision.
-- Intended only for internal use, eg when comparing amounts in tests. -- Intended only for internal use, eg when comparing amounts in tests.
setAmountInternalPrecision :: Int -> 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=p}
,aquantity=roundTo (fromIntegral p) q ,aquantity=roundTo p q
} }
-- | Set an amount's internal precision, flipped. -- | Set an amount's internal precision, flipped.
-- Intended only for internal use, eg when comparing amounts in tests. -- Intended only for internal use, eg when comparing amounts in tests.
withInternalPrecision :: Amount -> Int -> Amount withInternalPrecision :: Amount -> Word8 -> Amount
withInternalPrecision = flip setAmountInternalPrecision withInternalPrecision = flip setAmountInternalPrecision
-- | Set (or clear) an amount's display decimal point. -- | Set (or clear) an amount's display decimal point.
@ -414,7 +415,7 @@ showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecim
qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer) qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer)
| p == maxprecisionwithpoint = show q | p == maxprecisionwithpoint = show q
| p == maxprecision = chopdotzero $ show q | p == maxprecision = chopdotzero $ show q
| otherwise = show $ roundTo (fromIntegral p) 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
@ -434,9 +435,9 @@ applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s
where where
addseps [] s = s addseps [] s = s
addseps (g:gs) s addseps (g:gs) s
| length s <= g = s | genericLength s <= toInteger g = s
| otherwise = let (part,rest) = splitAt g s | otherwise = let (part,rest) = genericSplitAt g s
in part ++ [c] ++ addseps gs rest in part ++ c : addseps gs rest
repeatLast [] = [] repeatLast [] = []
repeatLast gs = init gs ++ repeat (last gs) repeatLast gs = init gs ++ repeat (last gs)
@ -445,12 +446,12 @@ chopdotzero str = reverse $ case reverse str of
s -> s s -> s
-- | For rendering: a special precision value which means show all available digits. -- | For rendering: a special precision value which means show all available digits.
maxprecision :: Int maxprecision :: Word8
maxprecision = 999998 maxprecision = 254
-- | For rendering: a special precision value which forces display of a decimal point. -- | For rendering: a special precision value which forces display of a decimal point.
maxprecisionwithpoint :: Int maxprecisionwithpoint :: Word8
maxprecisionwithpoint = 999999 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.
@ -601,7 +602,7 @@ multiplyMixedAmountAndPrice n = mapMixedAmount (multiplyAmountAndPrice n)
-- | Calculate the average of some mixed amounts. -- | Calculate the average of some mixed amounts.
averageMixedAmounts :: [MixedAmount] -> MixedAmount averageMixedAmounts :: [MixedAmount] -> MixedAmount
averageMixedAmounts [] = 0 averageMixedAmounts [] = 0
averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as averageMixedAmounts as = genericLength as `divideMixedAmount` sum as
-- | Is this mixed amount negative, if we can tell that unambiguously? -- | Is this mixed amount negative, if we can tell that unambiguously?
-- Ie when normalised, are all individual commodity amounts negative ? -- Ie when normalised, are all individual commodity amounts negative ?
@ -665,13 +666,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 :: Int -> MixedAmount -> MixedAmount setMixedAmountPrecision :: Word8 -> 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 :: Int -> MixedAmount -> String showMixedAmountWithPrecision :: Word8 -> MixedAmount -> String
showMixedAmountWithPrecision p m = showMixedAmountWithPrecision p m =
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m

View File

@ -45,6 +45,7 @@ import Data.Text (Text)
-- import qualified Data.Text as T -- import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import Data.Word (Word8)
import System.Time (ClockTime(..)) import System.Time (ClockTime(..))
import Text.Printf import Text.Printf
@ -192,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 :: !Int, -- ^ number of digits displayed after the decimal point asprecision :: !Word8, -- ^ 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)
@ -214,7 +215,7 @@ instance Show AmountStyle where
-- point), and the size of each group, starting with the one nearest -- point), and the size of each group, starting with the one nearest
-- the decimal point. The last group size is assumed to repeat. Eg, -- the decimal point. The last group size is assumed to repeat. Eg,
-- comma between thousands is DigitGroups ',' [3]. -- comma between thousands is DigitGroups ',' [3].
data DigitGroupStyle = DigitGroups Char [Int] data DigitGroupStyle = DigitGroups Char [Word8]
deriving (Eq,Ord,Read,Show,Typeable,Data,Generic) deriving (Eq,Ord,Read,Show,Typeable,Data,Generic)
instance NFData DigitGroupStyle instance NFData DigitGroupStyle

View File

@ -135,6 +135,7 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.LocalTime import Data.Time.LocalTime
import Data.Word (Word8)
import System.Time (getClockTime) import System.Time (getClockTime)
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Char import Text.Megaparsec.Char
@ -706,8 +707,8 @@ amountwithoutpricep = do
:: (Int, Int) -- offsets :: (Int, Int) -- offsets
-> Maybe AmountStyle -> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber -> Either AmbiguousNumber RawNumber
-> Maybe Int -> Maybe Integer
-> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) -> TextParser m (Quantity, Word8, 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
@ -816,7 +817,7 @@ lotdatep = (do
-- seen following the decimal mark), the decimal mark character used if any, -- seen following the decimal mark), the decimal mark character used if any,
-- and the digit group style if any. -- and the digit group style if any.
-- --
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp suggestedStyle = label "number" $ do numberp suggestedStyle = label "number" $ do
-- a number is an optional sign followed by a sequence of digits possibly -- a number is an optional sign followed by a sequence of digits possibly
-- interspersed with periods, commas, or both -- interspersed with periods, commas, or both
@ -830,7 +831,7 @@ numberp suggestedStyle = label "number" $ do
Left errMsg -> Fail.fail errMsg Left errMsg -> Fail.fail errMsg
Right (q, p, d, g) -> pure (sign q, p, d, g) Right (q, p, d, g) -> pure (sign q, p, d, g)
exponentp :: TextParser m Int exponentp :: TextParser m Integer
exponentp = char' 'e' *> signp <*> decimal <?> "exponent" exponentp = char' 'e' *> signp <*> decimal <?> "exponent"
-- | Interpret a raw number as a decimal number. -- | Interpret a raw number as a decimal number.
@ -842,9 +843,9 @@ exponentp = char' 'e' *> signp <*> decimal <?> "exponent"
-- - the digit group style, if any (digit group character and sizes of digit groups) -- - the digit group style, if any (digit group character and sizes of digit groups)
fromRawNumber fromRawNumber
:: RawNumber :: RawNumber
-> Maybe Int -> Maybe Integer
-> Either String -> Either String
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle) (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber raw mExp = case raw of fromRawNumber raw mExp = case raw of
NoSeparators digitGrp mDecimals -> NoSeparators digitGrp mDecimals ->
@ -870,21 +871,25 @@ fromRawNumber raw mExp = case raw of
where where
-- Outputs digit group sizes from least significant to most significant -- Outputs digit group sizes from least significant to most significant
groupSizes :: [DigitGrp] -> [Int] groupSizes :: [DigitGrp] -> [Word8]
groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of
(a:b:cs) | a < b -> b:cs (a:b:cs) | a < b -> b:cs
gs -> gs gs -> gs
toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int) toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Word8)
toQuantity preDecimalGrp postDecimalGrp = (quantity, precision) toQuantity preDecimalGrp postDecimalGrp = (quantity, precision)
where where
quantity = Decimal (fromIntegral precision) quantity = Decimal precision
(digitGroupNumber $ preDecimalGrp <> postDecimalGrp) (digitGroupNumber $ preDecimalGrp <> postDecimalGrp)
precision = digitGroupLength postDecimalGrp precision = digitGroupLength postDecimalGrp
applyExp :: Int -> (Decimal, Int) -> (Decimal, Int) applyExp :: Integer -> (Decimal, Word8) -> (Decimal, Word8)
applyExp exponent (quantity, precision) = applyExp exponent (quantity, precision) = (quantity * 10^^exponent, newPrecision)
(quantity * 10^^exponent, max 0 (precision - exponent)) where
newPrecision | precisionDiff >= 255 = maxBound
| precisionDiff <= 0 = 0
| otherwise = fromInteger precisionDiff
precisionDiff = toInteger precision - exponent
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
@ -1011,17 +1016,15 @@ data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp
-- | Description of a single digit group in a number literal. -- | Description of a single digit group in a number literal.
-- "Thousands" is one well known digit grouping, but there are others. -- "Thousands" is one well known digit grouping, but there are others.
data DigitGrp = DigitGrp { data DigitGrp = DigitGrp {
digitGroupLength :: !Int, -- ^ The number of digits in this group. digitGroupLength :: !Word8, -- ^ The number of digits in this group.
digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits. digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits. This should always be positive.
} deriving (Eq) } deriving (Eq)
-- | A custom show instance, showing digit groups as the parser saw them. -- | A custom show instance, showing digit groups as the parser saw them.
instance Show DigitGrp where instance Show DigitGrp where
show (DigitGrp len num) show (DigitGrp len num) = "\"" ++ padding ++ numStr ++ "\""
| len > 0 = "\"" ++ padding ++ numStr ++ "\""
| otherwise = "\"\""
where numStr = show num where numStr = show num
padding = replicate (len - length numStr) '0' padding = genericReplicate (toInteger len - genericLength numStr) '0'
instance Sem.Semigroup DigitGrp where instance Sem.Semigroup DigitGrp where
DigitGrp l1 n1 <> DigitGrp l2 n2 = DigitGrp (l1 + l2) (n1 * 10^l2 + n2) DigitGrp l1 n1 <> DigitGrp l2 n2 = DigitGrp (l1 + l2) (n1 * 10^l2 + n2)
@ -1381,7 +1384,7 @@ tests_Common = tests "Common" [
,test "total price, parenthesised" $ assertParse amountp "$10 (@@) €0.5" ,test "total price, parenthesised" $ assertParse amountp "$10 (@@) €0.5"
] ]
,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
test "numberp" $ do test "numberp" $ do
assertParseEq p "0" (0, 0, Nothing, Nothing) assertParseEq p "0" (0, 0, Nothing, Nothing)
assertParseEq p "1" (1, 0, Nothing, Nothing) assertParseEq p "1" (1, 0, Nothing, Nothing)