Avoid some uses of fromIntegral, parse numbers more robustly.
This is PR #1326, addressing #1325 (fromIntegral considered harmful). User-visible changes: - parsing numbers with more than 255 decimal places now gives an error instead of silently misparsing. - digit groups are now limited to at most 255 digits each. - exponents greater than 9223372036854775807 or less than -9223372036854775808 are now parsed correctly, in theory. (In practice, very large exponents will cause hledger to eat all your memory, so avoid them for now.) API/internal changes: - some fromIntegral calls have been replaced with safer code avoiding potential bugs due to numeric wrapping. - asprecision is now a sum type with Word8 instead of an Int with magic values. - DigitGroupStyle uses Word8 instead of Int. - exponents are parsed as Integer rather than Int. Merge branch 'precisionword' into master
This commit is contained in:
Simon Michael
commit
40ca6c62e7
@ -105,7 +105,7 @@ splitPosting acct dates p@Posting{paccount,pamount}
|
||||
[d] -> (d, [])
|
||||
[] -> error' "splitPosting ran out of dates, should not happen (maybe sort your transactions by date)"
|
||||
days = initSafe [start..end]
|
||||
amt = (fromIntegral $ length days) `divideMixedAmount` pamount
|
||||
amt = (genericLength days) `divideMixedAmount` pamount
|
||||
-- give one of the postings an exact balancing amount to ensure the transaction is balanced
|
||||
-- lastamt = pamount - ptrace (amt `multiplyMixedAmount` (fromIntegral $ length days))
|
||||
lastamt = missingmixedamt
|
||||
|
||||
@ -74,13 +74,9 @@ module Hledger.Data.Amount (
|
||||
showAmountWithZeroCommodity,
|
||||
showAmountDebug,
|
||||
showAmountWithoutPrice,
|
||||
maxprecision,
|
||||
maxprecisionwithpoint,
|
||||
setAmountPrecision,
|
||||
withPrecision,
|
||||
setFullPrecision,
|
||||
setNaturalPrecision,
|
||||
setNaturalPrecisionUpTo,
|
||||
setAmountInternalPrecision,
|
||||
withInternalPrecision,
|
||||
setAmountDecimalPoint,
|
||||
@ -129,13 +125,14 @@ module Hledger.Data.Amount (
|
||||
|
||||
import Control.Monad (foldM)
|
||||
import Data.Char (isDigit)
|
||||
import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal)
|
||||
import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo)
|
||||
import Data.Function (on)
|
||||
import Data.List
|
||||
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
|
||||
|
||||
@ -150,7 +147,7 @@ deriving instance Show MarketPrice
|
||||
-- Amount styles
|
||||
|
||||
-- | Default amount style
|
||||
amountstyle = AmountStyle L False 0 (Just '.') Nothing
|
||||
amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing
|
||||
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
@ -177,11 +174,11 @@ missingamt = amount{acommodity="AUTO"}
|
||||
-- Handy amount constructors for tests.
|
||||
-- usd/eur/gbp round their argument to a whole number of pennies/cents.
|
||||
num n = amount{acommodity="", aquantity=n}
|
||||
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=2, ascommodityside=R}}
|
||||
usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
|
||||
eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
|
||||
gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}
|
||||
per n = amount{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R, ascommodityspaced=True}}
|
||||
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=Precision 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=Precision 2}}
|
||||
per n = amount{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}}
|
||||
amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt}
|
||||
amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt}
|
||||
|
||||
@ -227,8 +224,13 @@ amountCost a@Amount{aquantity=q, aprice=mp} =
|
||||
-- Does Decimal division, might be some rounding/irrational number issues.
|
||||
amountTotalPriceToUnitPrice :: Amount -> Amount
|
||||
amountTotalPriceToUnitPrice
|
||||
a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}})}
|
||||
= a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}}
|
||||
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}}}
|
||||
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
|
||||
|
||||
-- | Divide an amount's quantity by a constant.
|
||||
@ -259,11 +261,17 @@ multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, apric
|
||||
isNegativeAmount :: Amount -> Bool
|
||||
isNegativeAmount Amount{aquantity=q} = q < 0
|
||||
|
||||
-- | Round an Amount's Quantity 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
|
||||
-- display precision ?
|
||||
amountLooksZero :: Amount -> Bool
|
||||
amountLooksZero Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} =
|
||||
roundTo (fromIntegral p) q == 0
|
||||
amountLooksZero = (0==) . amountRoundedQuantity
|
||||
|
||||
-- | Is this amount exactly zero, ignoring its display precision ?
|
||||
amountIsZero :: Amount -> Bool
|
||||
@ -271,43 +279,26 @@ 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 :: AmountPrecision -> Amount -> String
|
||||
showAmountWithPrecision p = showAmount . setAmountPrecision p
|
||||
|
||||
-- | Set an amount's display precision, flipped.
|
||||
withPrecision :: Amount -> Int -> Amount
|
||||
withPrecision :: Amount -> AmountPrecision -> Amount
|
||||
withPrecision = flip setAmountPrecision
|
||||
|
||||
-- | Set an amount's display precision.
|
||||
setAmountPrecision :: Int -> Amount -> Amount
|
||||
setAmountPrecision :: AmountPrecision -> Amount -> Amount
|
||||
setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}
|
||||
|
||||
-- | Increase an amount's display precision, if needed, to enough
|
||||
-- decimal places to show it exactly (showing all significant decimal
|
||||
-- digits, excluding trailing zeros).
|
||||
-- | Increase an amount's display precision, if needed, to enough decimal places
|
||||
-- to show it exactly (showing all significant decimal digits, excluding trailing
|
||||
-- zeros).
|
||||
setFullPrecision :: Amount -> Amount
|
||||
setFullPrecision a = setAmountPrecision p a
|
||||
where
|
||||
p = max displayprecision naturalprecision
|
||||
displayprecision = asprecision $ astyle a
|
||||
naturalprecision = fromIntegral $ 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 = fromIntegral $ 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 n a = setAmountPrecision (min n normalprecision) a
|
||||
where
|
||||
normalprecision = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a
|
||||
naturalprecision = Precision . 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 +319,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
|
||||
astyle=s{asprecision=Precision p}
|
||||
,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.
|
||||
@ -407,14 +398,8 @@ showAmountWithZeroCommodity = showAmountHelper True
|
||||
-- | Get the string representation of the number part of of an amount,
|
||||
-- using the display settings from its commodity.
|
||||
showamountquantity :: Amount -> String
|
||||
showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecimalpoint=mdec, asdigitgroups=mgrps}} =
|
||||
punctuatenumber (fromMaybe '.' mdec) mgrps qstr
|
||||
where
|
||||
-- isint n = fromIntegral (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 (fromIntegral p) q
|
||||
showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
|
||||
punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt
|
||||
|
||||
-- | Replace a number string's decimal mark with the specified
|
||||
-- character, and add the specified digit group marks. The last digit
|
||||
@ -434,24 +419,12 @@ 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
|
||||
| toInteger (length 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)
|
||||
|
||||
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 :: Int
|
||||
maxprecision = 999998
|
||||
|
||||
-- | For rendering: a special precision value which forces display of a decimal point.
|
||||
maxprecisionwithpoint :: Int
|
||||
maxprecisionwithpoint = 999999
|
||||
|
||||
-- like journalCanonicaliseAmounts
|
||||
-- | Canonicalise an amount's display style using the provided commodity style map.
|
||||
canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
|
||||
@ -665,13 +638,13 @@ ltraceamount :: String -> MixedAmount -> MixedAmount
|
||||
ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)
|
||||
|
||||
-- | Set the display precision in the amount's commodities.
|
||||
setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount
|
||||
setMixedAmountPrecision :: AmountPrecision -> 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 :: AmountPrecision -> MixedAmount -> String
|
||||
showMixedAmountWithPrecision p m =
|
||||
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m
|
||||
|
||||
@ -763,8 +736,8 @@ tests_Amount = tests "Amount" [
|
||||
(usd (-1.23) + usd (-1.23)) @?= usd (-2.46)
|
||||
sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0
|
||||
-- highest precision is preserved
|
||||
asprecision (astyle $ sum [usd 1 `withPrecision` 1, usd 1 `withPrecision` 3]) @?= 3
|
||||
asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) @?= 3
|
||||
asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Precision 3
|
||||
asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3
|
||||
-- adding different commodities assumes conversion rate 1
|
||||
assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23)
|
||||
|
||||
@ -778,10 +751,10 @@ tests_Amount = tests "Amount" [
|
||||
test "adding mixed amounts to zero, the commodity and amount style are preserved" $
|
||||
sum (map (Mixed . (:[]))
|
||||
[usd 1.25
|
||||
,usd (-1) `withPrecision` 3
|
||||
,usd (-1) `withPrecision` Precision 3
|
||||
,usd (-0.25)
|
||||
])
|
||||
@?= Mixed [usd 0 `withPrecision` 3]
|
||||
@?= Mixed [usd 0 `withPrecision` Precision 3]
|
||||
|
||||
,test "adding mixed amounts with total prices" $ do
|
||||
sum (map (Mixed . (:[]))
|
||||
|
||||
@ -560,8 +560,8 @@ nthdayofyearcontaining m md date
|
||||
| not (validDay md) = error' $ "nthdayofyearcontaining: invalid day " ++show md
|
||||
| mmddOfSameYear <= date = mmddOfSameYear
|
||||
| otherwise = mmddOfPrevYear
|
||||
where mmddOfSameYear = addDays (fromIntegral md-1) $ applyN (m-1) nextmonth s
|
||||
mmddOfPrevYear = addDays (fromIntegral md-1) $ applyN (m-1) nextmonth $ prevyear s
|
||||
where mmddOfSameYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth s
|
||||
mmddOfPrevYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth $ prevyear s
|
||||
s = startofyear date
|
||||
|
||||
-- | For given date d find month-long interval that starts on nth day of month
|
||||
@ -612,8 +612,8 @@ nthdayofmonthcontaining md date
|
||||
nthdayofweekcontaining :: WeekDay -> Day -> Day
|
||||
nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek
|
||||
| otherwise = nthOfPrevWeek
|
||||
where nthOfSameWeek = addDays (fromIntegral n-1) s
|
||||
nthOfPrevWeek = addDays (fromIntegral n-1) $ prevweek s
|
||||
where nthOfSameWeek = addDays (toInteger n-1) s
|
||||
nthOfPrevWeek = addDays (toInteger n-1) $ prevweek s
|
||||
s = startofweek d
|
||||
|
||||
-- | For given date d find month-long interval that starts on nth weekday of month
|
||||
@ -647,9 +647,9 @@ advancetonthweekday n wd s =
|
||||
maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s
|
||||
where
|
||||
err = error' "advancetonthweekday: should not happen"
|
||||
addWeeks k = addDays (7 * fromIntegral k)
|
||||
addWeeks k = addDays (7 * toInteger k)
|
||||
firstMatch p = headMay . dropWhile (not . p)
|
||||
firstweekday = addDays (fromIntegral wd-1) . startofweek
|
||||
firstweekday = addDays (toInteger wd-1) . startofweek
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- parsing
|
||||
|
||||
@ -716,7 +716,7 @@ journalBalanceTransactions assrt j' =
|
||||
runST $ do
|
||||
-- We'll update a mutable array of transactions as we balance them,
|
||||
-- not strictly necessary but avoids a sort at the end I think.
|
||||
balancedtxns <- newListArray (1, genericLength ts) ts
|
||||
balancedtxns <- newListArray (1, toInteger $ length ts) ts
|
||||
|
||||
-- Infer missing posting amounts, check transactions are balanced,
|
||||
-- and check balance assertions. This is done in two passes:
|
||||
@ -1495,26 +1495,26 @@ tests_Journal = tests "Journal" [
|
||||
--
|
||||
test "1091a" $ do
|
||||
commodityStylesFromAmounts [
|
||||
nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
]
|
||||
@?=
|
||||
-- The commodity style should have period as decimal mark
|
||||
-- and comma as digit group mark.
|
||||
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
|
||||
,test "1091b" $ do
|
||||
commodityStylesFromAmounts [
|
||||
nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing}
|
||||
nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
|
||||
]
|
||||
@?=
|
||||
-- The commodity style should have period as decimal mark
|
||||
-- and comma as digit group mark.
|
||||
Right (M.fromList [
|
||||
("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3])))
|
||||
("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))
|
||||
])
|
||||
|
||||
]
|
||||
|
||||
@ -89,6 +89,7 @@ instance ToJSON Decimal where
|
||||
|
||||
instance ToJSON Amount
|
||||
instance ToJSON AmountStyle
|
||||
instance ToJSON AmountPrecision
|
||||
instance ToJSON Side
|
||||
instance ToJSON DigitGroupStyle
|
||||
instance ToJSON MixedAmount
|
||||
@ -158,6 +159,7 @@ instance FromJSON Status
|
||||
instance FromJSON GenericSourcePos
|
||||
instance FromJSON Amount
|
||||
instance FromJSON AmountStyle
|
||||
instance FromJSON AmountPrecision
|
||||
instance FromJSON Side
|
||||
instance FromJSON DigitGroupStyle
|
||||
instance FromJSON MixedAmount
|
||||
|
||||
@ -295,7 +295,7 @@ periodShrink today (YearPeriod y)
|
||||
periodShrink today _ = YearPeriod y
|
||||
where (y,_,_) = toGregorian today
|
||||
|
||||
mondayBefore d = addDays (fromIntegral (1 - wd)) d
|
||||
mondayBefore d = addDays (1 - toInteger wd) d
|
||||
where
|
||||
(_,_,wd) = toWeekDate d
|
||||
|
||||
|
||||
@ -540,15 +540,20 @@ priceInferrerFor t pt = inferprice
|
||||
where
|
||||
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
|
||||
conversionprice
|
||||
| fromcount==1 = TotalPrice $ abs toamount `withPrecision` maxprecision
|
||||
| fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision
|
||||
| otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision
|
||||
where
|
||||
fromcount = length $ filter ((==fromcommodity).acommodity) pamounts
|
||||
fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts
|
||||
fromprecision = asprecision $ astyle fromamount
|
||||
tocommodity = head $ filter (/=fromcommodity) sumcommodities
|
||||
toamount = head $ filter ((==tocommodity).acommodity) sumamounts
|
||||
toprecision = asprecision $ astyle 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
|
||||
|
||||
-- Get a transaction's secondary date, defaulting to the primary date.
|
||||
@ -772,7 +777,7 @@ tests_Transaction =
|
||||
"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}
|
||||
])) @?=
|
||||
(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 = "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" $
|
||||
assertRight $
|
||||
balanceTransaction
|
||||
|
||||
@ -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 :: !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"
|
||||
asdigitgroups :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any
|
||||
} deriving (Eq,Ord,Read,Typeable,Data,Generic)
|
||||
@ -208,13 +209,17 @@ instance Show AmountStyle where
|
||||
(show asdecimalpoint)
|
||||
(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
|
||||
-- floating point number. It consists of the character used to
|
||||
-- separate groups (comma or period, whichever is not used as decimal
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
@ -240,13 +241,12 @@ runErroringJournalParser p t =
|
||||
rejp = runErroringJournalParser
|
||||
|
||||
genericSourcePos :: SourcePos -> GenericSourcePos
|
||||
genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
|
||||
genericSourcePos p = GenericSourcePos (sourceName p) (unPos $ sourceLine p) (unPos $ sourceColumn p)
|
||||
|
||||
-- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's.
|
||||
journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos
|
||||
journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p, fromIntegral $ line')
|
||||
where line'
|
||||
| (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1
|
||||
journalSourcePos p p' = JournalSourcePos (sourceName p) (unPos $ sourceLine p, line')
|
||||
where line' | (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1
|
||||
| otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line
|
||||
|
||||
-- | Given a parser to ParsedJournal, input options, file path and
|
||||
@ -706,14 +706,14 @@ 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, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
|
||||
interpretNumber posRegion suggestedStyle ambiguousNum mExp =
|
||||
let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousNum
|
||||
in case fromRawNumber rawNum mExp of
|
||||
Left errMsg -> customFailure $
|
||||
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.
|
||||
amountp' :: String -> Amount
|
||||
@ -816,7 +816,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 +830,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,50 +842,40 @@ 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)
|
||||
fromRawNumber raw mExp = case raw of
|
||||
|
||||
NoSeparators digitGrp mDecimals ->
|
||||
let mDecPt = fmap fst mDecimals
|
||||
decimalGrp = maybe mempty snd mDecimals
|
||||
|
||||
(quantity, precision) =
|
||||
maybe id applyExp mExp $ toQuantity digitGrp decimalGrp
|
||||
|
||||
in Right (quantity, precision, mDecPt, Nothing)
|
||||
|
||||
WithSeparators digitSep digitGrps mDecimals -> case mExp of
|
||||
Nothing ->
|
||||
let mDecPt = fmap fst mDecimals
|
||||
decimalGrp = maybe mempty snd mDecimals
|
||||
digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps)
|
||||
|
||||
(quantity, precision) = toQuantity (mconcat digitGrps) decimalGrp
|
||||
|
||||
in Right (quantity, precision, mDecPt, Just digitGroupStyle)
|
||||
Just _ -> Left
|
||||
"invalid number: mixing digit separators with exponents is not allowed"
|
||||
|
||||
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
|
||||
fromRawNumber (WithSeparators _ _ _) (Just _) =
|
||||
Left "invalid number: mixing digit separators with exponents is not allowed"
|
||||
fromRawNumber raw mExp = do
|
||||
(quantity, precision) <- toQuantity (fromMaybe 0 mExp) (digitGroup raw) (decimalGroup raw)
|
||||
return (quantity, precision, mDecPt raw, digitGroupStyle raw)
|
||||
where
|
||||
toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8)
|
||||
toQuantity e preDecimalGrp postDecimalGrp
|
||||
| precision < 0 = Right (Decimal 0 (digitGrpNum * 10^(-precision)), 0)
|
||||
| precision < 256 = Right (Decimal precision8 digitGrpNum, precision8)
|
||||
| otherwise = Left "invalid number: numbers with more than 255 decimal digits are not allowed at this time"
|
||||
where
|
||||
digitGrpNum = digitGroupNumber $ preDecimalGrp <> postDecimalGrp
|
||||
precision = toInteger (digitGroupLength postDecimalGrp) - e
|
||||
precision8 = fromIntegral precision :: Word8
|
||||
|
||||
mDecPt (NoSeparators _ mDecimals) = fst <$> mDecimals
|
||||
mDecPt (WithSeparators _ _ mDecimals) = fst <$> mDecimals
|
||||
decimalGroup (NoSeparators _ mDecimals) = maybe mempty snd mDecimals
|
||||
decimalGroup (WithSeparators _ _ mDecimals) = maybe mempty snd mDecimals
|
||||
digitGroup (NoSeparators digitGrp _) = digitGrp
|
||||
digitGroup (WithSeparators _ digitGrps _) = mconcat digitGrps
|
||||
digitGroupStyle (NoSeparators _ _) = Nothing
|
||||
digitGroupStyle (WithSeparators sep grps _) = Just . DigitGroups sep $ groupSizes grps
|
||||
|
||||
-- Outputs digit group sizes from least significant to most significant
|
||||
groupSizes :: [DigitGrp] -> [Int]
|
||||
groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of
|
||||
groupSizes :: [DigitGrp] -> [Word8]
|
||||
groupSizes digitGrps = reverse $ case map (fromIntegral . digitGroupLength) digitGrps of
|
||||
(a:b:cs) | a < b -> b:cs
|
||||
gs -> gs
|
||||
|
||||
toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int)
|
||||
toQuantity preDecimalGrp postDecimalGrp = (quantity, precision)
|
||||
where
|
||||
quantity = Decimal (fromIntegral precision)
|
||||
(digitGroupNumber $ preDecimalGrp <> postDecimalGrp)
|
||||
precision = digitGroupLength postDecimalGrp
|
||||
|
||||
applyExp :: Int -> (Decimal, Int) -> (Decimal, Int)
|
||||
applyExp exponent (quantity, precision) =
|
||||
(quantity * 10^^exponent, max 0 (precision - exponent))
|
||||
|
||||
|
||||
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
|
||||
disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) =
|
||||
@ -900,7 +890,7 @@ disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) =
|
||||
isValidDecimalBy c = \case
|
||||
AmountStyle{asdecimalpoint = Just d} -> d == c
|
||||
AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c
|
||||
AmountStyle{asprecision = 0} -> False
|
||||
AmountStyle{asprecision = Precision 0} -> False
|
||||
_ -> True
|
||||
|
||||
-- | Parse and interpret the structure of a number without external hints.
|
||||
@ -1011,17 +1001,17 @@ 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 :: !Word, -- ^ The number of digits in this group.
|
||||
-- This is Word to avoid the need to do overflow
|
||||
-- checking for the Semigroup instance of DigitGrp.
|
||||
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 - toInteger (length numStr)) '0'
|
||||
|
||||
instance Sem.Semigroup DigitGrp where
|
||||
DigitGrp l1 n1 <> DigitGrp l2 n2 = DigitGrp (l1 + l2) (n1 * 10^l2 + n2)
|
||||
@ -1350,38 +1340,38 @@ tests_Common = tests "Common" [
|
||||
|
||||
tests "amountp" [
|
||||
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"
|
||||
-- not precise enough:
|
||||
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
|
||||
amount{
|
||||
acommodity="$"
|
||||
,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 $
|
||||
amount{
|
||||
acommodity="€"
|
||||
,aquantity=0.5
|
||||
,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'}
|
||||
,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'}
|
||||
}
|
||||
}
|
||||
,test "total price" $ assertParseEq amountp "$10 @@ €5"
|
||||
amount{
|
||||
acommodity="$"
|
||||
,aquantity=10
|
||||
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}
|
||||
,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
|
||||
,aprice=Just $ TotalPrice $
|
||||
amount{
|
||||
acommodity="€"
|
||||
,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 "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)
|
||||
@ -1401,6 +1391,8 @@ tests_Common = tests "Common" [
|
||||
assertParseError p "1..1" ""
|
||||
assertParseError p ".1," ""
|
||||
assertParseError p ",1." ""
|
||||
assertParseEq p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Just '.', Nothing)
|
||||
assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""
|
||||
|
||||
,tests "spaceandamountormissingp" [
|
||||
test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])
|
||||
|
||||
@ -779,7 +779,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
bad "2011/1/1 00:00:60"
|
||||
bad "2011/1/1 3:5:7"
|
||||
-- timezone is parsed but ignored
|
||||
let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0))
|
||||
let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 0)
|
||||
assertParseEq datetimep "2018/1/1 00:00-0800" t
|
||||
assertParseEq datetimep "2018/1/1 00:00+1234" t
|
||||
|
||||
|
||||
@ -182,7 +182,7 @@ entryp = do
|
||||
tstatus = Cleared,
|
||||
tpostings = [
|
||||
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
|
||||
,ptransaction=Just t
|
||||
}
|
||||
@ -240,7 +240,7 @@ dotquantityp :: JournalParser m Quantity
|
||||
dotquantityp = do
|
||||
-- lift $ traceparse "dotquantityp"
|
||||
dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))
|
||||
return $ (/4) $ fromIntegral $ length dots
|
||||
return $ fromIntegral (length dots) / 4
|
||||
|
||||
-- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep
|
||||
-- Parse empty lines, all-blank lines, and lines beginning with any of the provided
|
||||
|
||||
@ -605,7 +605,7 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
|
||||
tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
|
||||
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
|
||||
let (eitems, etotal) = r
|
||||
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal
|
||||
|
||||
@ -404,9 +404,9 @@ textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s
|
||||
|
||||
-- | Read a decimal number from a Text. Assumes the input consists only of digit
|
||||
-- characters.
|
||||
readDecimal :: Integral a => Text -> a
|
||||
readDecimal :: Text -> Integer
|
||||
readDecimal = foldl' step 0 . T.unpack
|
||||
where step a c = a * 10 + fromIntegral (digitToInt c)
|
||||
where step a c = a * 10 + toInteger (digitToInt c)
|
||||
|
||||
|
||||
tests_Text = tests "Text" [
|
||||
|
||||
@ -360,7 +360,7 @@ rsHandle ui@UIState{
|
||||
let
|
||||
ts = map rsItemTransaction $ V.toList $ nonblanks
|
||||
numberedts = zip [1..] ts
|
||||
i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX
|
||||
i = maybe 0 (toInteger . (+1)) $ elemIndex t ts -- XXX
|
||||
in
|
||||
continue $ screenEnter d transactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=numberedts
|
||||
|
||||
@ -371,7 +371,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
|
||||
-- 4 maximum precision entered so far in this transaction ?
|
||||
-- 5 3 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
|
||||
-- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt
|
||||
|
||||
@ -50,7 +50,9 @@ divideAmount' n a = a' where
|
||||
a' = (n `divideAmount` a) { astyle = style' }
|
||||
style' = (astyle a) { asprecision = precision' }
|
||||
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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user