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

bin/hledger-smooth.hs

@@ -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

hledger-lib/Hledger/Data/Amount.hs

@@ -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}}
+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 @@ 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@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
 
 -- | 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}} =
+amountLooksZero = (0==) . amountRoundedQuantity
-    roundTo (fromIntegral p) q == 0
 
 -- | 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
+-- | 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 a = setAmountPrecision p a
   where
     p                = max displayprecision naturalprecision
     displayprecision = asprecision $ astyle a
-    naturalprecision = fromIntegral $ 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  = 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
 
 -- | 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}
+   astyle=s{asprecision=Precision 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.
@@ -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}} =
+showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
-    punctuatenumber (fromMaybe '.' mdec) mgrps qstr
+    punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt
-    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
 
 -- | 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
+      | toInteger (length 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 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` 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
        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 . (:[]))

hledger-lib/Hledger/Data/Dates.hs

@@ -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
+  where mmddOfSameYear = addDays (toInteger md-1) $ applyN (m-1) nextmonth s
-        mmddOfPrevYear = addDays (fromIntegral md-1) $ applyN (m-1) nextmonth $ prevyear 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
+    where nthOfSameWeek = addDays (toInteger n-1) s
-          nthOfPrevWeek = addDays (fromIntegral n-1) $ prevweek 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

hledger-lib/Hledger/Data/Journal.hs

@@ -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 (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
           -- 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 (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
           -- 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])))
           ])
 
      ]

hledger-lib/Hledger/Data/Json.hs

@@ -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

hledger-lib/Hledger/Data/Period.hs

@@ -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
 

hledger-lib/Hledger/Data/Transaction.hs

@@ -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

hledger-lib/Hledger/Data/Types.hs

@@ -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

hledger-lib/Hledger/Read/Common.hs

@@ -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')
+journalSourcePos p p' = JournalSourcePos (sourceName p) (unPos $ sourceLine p, line')
-    where line'
+    where line' | (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1
-            | (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
+    -> Maybe Integer
-    -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
+    -> 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)
+            (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-fromRawNumber raw mExp = case raw of
+fromRawNumber (WithSeparators _ _ _) (Just _) =
-
+    Left "invalid number: mixing digit separators with exponents is not allowed"
-  NoSeparators digitGrp mDecimals ->
+fromRawNumber raw mExp = do
-    let mDecPt = fmap fst mDecimals
+    (quantity, precision) <- toQuantity (fromMaybe 0 mExp) (digitGroup raw) (decimalGroup raw)
-        decimalGrp = maybe mempty snd mDecimals
+    return (quantity, precision, mDecPt raw, digitGroupStyle raw)
-
-        (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"
-
   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 :: [DigitGrp] -> [Word8]
-    groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of
+    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.
+  digitGroupLength :: !Word,    -- ^ The number of digits in this group.
-  digitGroupNumber :: !Integer -- ^ The natural number formed by this group's digits.
+                                -- 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)
+  show (DigitGrp len num) = "\"" ++ padding ++ numStr ++ "\""
-    | len > 0 = "\"" ++ padding ++ numStr ++ "\""
-    | otherwise = "\"\""
     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])

hledger-lib/Hledger/Read/JournalReader.hs

@@ -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
 

hledger-lib/Hledger/Read/TimedotReader.hs

@@ -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

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -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

hledger-lib/Hledger/Utils/Text.hs

@@ -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" [

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -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

hledger/Hledger/Cli/Commands/Add.hs

@@ -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

hledger/Hledger/Cli/Commands/Prices.hs

@@ -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