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.Maybe
import qualified Data.Text as T
import Data.Word (Word8)
import Safe (lastDef, maximumMay)
import Text.Printf
@ -263,7 +264,7 @@ isNegativeAmount Amount{aquantity=q} = q < 0
-- display precision ?
amountLooksZero :: Amount -> Bool
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 ?
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
-- display settings except using the specified precision.
showAmountWithPrecision :: Int -> Amount -> String
showAmountWithPrecision :: Word8 -> Amount -> String
showAmountWithPrecision p = showAmount . setAmountPrecision p
-- | Set an amount's display precision, flipped.
withPrecision :: Amount -> Int -> Amount
withPrecision :: Amount -> Word8 -> Amount
withPrecision = flip setAmountPrecision
-- | 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}}
-- | Increase an amount's display precision, if needed, to enough
@ -290,7 +291,7 @@ setFullPrecision a = setAmountPrecision p a
where
p = max displayprecision naturalprecision
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
-- to show it exactly (possibly less than the number specified by
@ -298,16 +299,16 @@ setFullPrecision a = setAmountPrecision p a
setNaturalPrecision :: Amount -> Amount
setNaturalPrecision a = setAmountPrecision normalprecision a
where
normalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a
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 :: Int -> Amount -> Amount
setNaturalPrecisionUpTo :: Word8 -> Amount -> Amount
setNaturalPrecisionUpTo n a = setAmountPrecision (min n normalprecision) a
where
normalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a
normalprecision = decimalPlaces . normalizeDecimal $ aquantity a
-- | Get a string representation of an amount for debugging,
-- 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)".
-- Does not change the amount's display precision.
-- 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{
astyle=s{asprecision=p}
,aquantity=roundTo (fromIntegral p) q
,aquantity=roundTo p q
}
-- | Set an amount's internal precision, flipped.
-- Intended only for internal use, eg when comparing amounts in tests.
withInternalPrecision :: Amount -> Int -> Amount
withInternalPrecision :: Amount -> Word8 -> Amount
withInternalPrecision = flip setAmountInternalPrecision
-- | 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)
| p == maxprecisionwithpoint = 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
-- 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
addseps [] s = s
addseps (g:gs) s
| length s <= g = s
| otherwise = let (part,rest) = splitAt g s
in part ++ [c] ++ addseps gs rest
| genericLength s <= toInteger g = s
| otherwise = let (part,rest) = genericSplitAt g s
in part ++ c : addseps gs rest
repeatLast [] = []
repeatLast gs = init gs ++ repeat (last gs)
@ -445,12 +446,12 @@ chopdotzero str = reverse $ case reverse str of
s -> s
-- | For rendering: a special precision value which means show all available digits.
maxprecision :: Int
maxprecision = 999998
maxprecision :: Word8
maxprecision = 254
-- | For rendering: a special precision value which forces display of a decimal point.
maxprecisionwithpoint :: Int
maxprecisionwithpoint = 999999
maxprecisionwithpoint :: Word8
maxprecisionwithpoint = 255
-- like journalCanonicaliseAmounts
-- | 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.
averageMixedAmounts :: [MixedAmount] -> MixedAmount
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?
-- Ie when normalised, are all individual commodity amounts negative ?
@ -665,13 +666,13 @@ ltraceamount :: String -> MixedAmount -> MixedAmount
ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)
-- | 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
-- | Get the string representation of a mixed amount, showing each of its
-- component amounts with the specified precision, ignoring their
-- commoditys' display precision settings.
showMixedAmountWithPrecision :: Int -> MixedAmount -> String
showMixedAmountWithPrecision :: Word8 -> MixedAmount -> String
showMixedAmountWithPrecision p 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 Data.Time.Calendar
import Data.Time.LocalTime
import Data.Word (Word8)
import System.Time (ClockTime(..))
import Text.Printf
@ -192,7 +193,7 @@ instance NFData AmountPrice
data AmountStyle = AmountStyle {
ascommodityside :: Side, -- ^ does the symbol appear on the left or the right ?
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"
asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any
} 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
-- the decimal point. The last group size is assumed to repeat. Eg,
-- comma between thousands is DigitGroups ',' [3].
data DigitGroupStyle = DigitGroups Char [Int]
data DigitGroupStyle = DigitGroups Char [Word8]
deriving (Eq,Ord,Read,Show,Typeable,Data,Generic)
instance NFData DigitGroupStyle

View File

@ -135,6 +135,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Word (Word8)
import System.Time (getClockTime)
import Text.Megaparsec
import Text.Megaparsec.Char
@ -706,8 +707,8 @@ amountwithoutpricep = do
:: (Int, Int) -- offsets
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
-> Maybe Integer
-> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
interpretNumber posRegion suggestedStyle ambiguousNum mExp =
let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum
in case fromRawNumber rawNum mExp of
@ -816,7 +817,7 @@ lotdatep = (do
-- seen following the decimal mark), the decimal mark character used 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
-- a number is an optional sign followed by a sequence of digits possibly
-- interspersed with periods, commas, or both
@ -830,7 +831,7 @@ numberp suggestedStyle = label "number" $ do
Left errMsg -> Fail.fail errMsg
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"
-- | 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)
fromRawNumber
:: RawNumber
-> Maybe Int
-> Maybe Integer
-> Either String
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber raw mExp = case raw of
NoSeparators digitGrp mDecimals ->
@ -870,21 +871,25 @@ fromRawNumber raw mExp = case raw of
where
-- Outputs digit group sizes from least significant to most significant
groupSizes :: [DigitGrp] -> [Int]
groupSizes :: [DigitGrp] -> [Word8]
groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of
(a:b:cs) | a < b -> b:cs
gs -> gs
toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int)
toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Word8)
toQuantity preDecimalGrp postDecimalGrp = (quantity, precision)
where
quantity = Decimal (fromIntegral precision)
quantity = Decimal precision
(digitGroupNumber $ preDecimalGrp <> postDecimalGrp)
precision = digitGroupLength postDecimalGrp
applyExp :: Int -> (Decimal, Int) -> (Decimal, Int)
applyExp exponent (quantity, precision) =
(quantity * 10^^exponent, max 0 (precision - exponent))
applyExp :: Integer -> (Decimal, Word8) -> (Decimal, Word8)
applyExp exponent (quantity, precision) = (quantity * 10^^exponent, newPrecision)
where
newPrecision | precisionDiff >= 255 = maxBound
| precisionDiff <= 0 = 0
| otherwise = fromInteger precisionDiff
precisionDiff = toInteger precision - exponent
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.
-- "Thousands" is one well known digit grouping, but there are others.
data DigitGrp = DigitGrp {
digitGroupLength :: !Int, -- ^ The number of digits in this group.
digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits.
digitGroupLength :: !Word8, -- ^ The number of digits in this group.
digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits. This should always be positive.
} deriving (Eq)
-- | A custom show instance, showing digit groups as the parser saw them.
instance Show DigitGrp where
show (DigitGrp len num)
| len > 0 = "\"" ++ padding ++ numStr ++ "\""
| otherwise = "\"\""
show (DigitGrp len num) = "\"" ++ padding ++ numStr ++ "\""
where numStr = show num
padding = replicate (len - length numStr) '0'
padding = genericReplicate (toInteger len - genericLength numStr) '0'
instance Sem.Semigroup DigitGrp where
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"
]
,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
assertParseEq p "0" (0, 0, Nothing, Nothing)
assertParseEq p "1" (1, 0, Nothing, Nothing)