lib: move handling of exponentials into fromRawNumber [API]

- Rationale:
  - The information necessary for applying exponents to a number is more
    explicitly represented in the inputs to `fromRawNumber` than in the outputs
  - This way, `exponentp` may simply return an `Int`

hledger-lib/Hledger/Read/Common.hs

@@ -98,7 +98,6 @@ import Prelude.Compat hiding (readFile)
 import Control.Monad.Compat
 import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError)
 import Control.Monad.State.Strict
-import Data.Bifunctor
 import Data.Char
 import Data.Data
 import Data.Decimal (DecimalRaw (Decimal), Decimal)
@@ -570,16 +569,19 @@ rightsymbolamountp = do
   m <- lift multiplierp
   sign <- lift signp
   ambiguousRawNum <- lift rawnumberp
-  expMod <- lift . option id $ try exponentp
+  mExponent <- lift $ optional $ try exponentp
   commodityspaced <- lift $ skipMany' spacenonewline
   c <- lift commoditysymbolp
   suggestedStyle <- getAmountStyle c
-  let (q0,prec0,mdec,mgrps) =
+
-        fromRawNumber $ either (disambiguateNumber suggestedStyle) id ambiguousRawNum
+  let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousRawNum
-      (q, prec) = expMod (sign q0, prec0)
+  (q, prec, mdec, mgrps) <- case fromRawNumber rawNum mExponent of
+    Left errMsg -> fail errMsg
+    Right res -> pure res
+
   p <- priceamountp
   let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
-  return $ Amount c q p s m
+  return $ Amount c (sign q) p s m
   <?> "right-symbol amount"
 
 nosymbolamountp :: Monad m => JournalParser m Amount
@@ -672,25 +674,21 @@ numberp suggestedStyle = do
     -- interspersed with periods, commas, or both
     -- ptrace "numberp"
     sign <- signp
-    raw <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp
+    rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp
-    dbg8 "numberp suggestedStyle" suggestedStyle `seq` return ()
-    let (q, prec, decSep, groups) =
-          dbg8 "numberp quantity,precision,mdecimalpoint,mgrps"
-            $ fromRawNumber raw
     mExp <- optional $ try $ exponentp
-    case mExp of
+    dbg8 "numberp suggestedStyle" suggestedStyle `seq` return ()
-      Just expFunc
+    case dbg8 "numberp quantity,precision,mdecimalpoint,mgrps"
-        | isJust groups -> fail "groups and exponent are not mixable"
+           $ fromRawNumber rawNum mExp of
-        | otherwise -> let (q', prec') = expFunc (q, prec)
+      Left errMsg -> fail errMsg
-                       in  pure (sign q', prec', decSep, groups)
+      Right (q, p, d, g) -> pure (sign q, p, d, g)
-      Nothing -> pure (sign q, prec, decSep, groups)
     <?> "numberp"
 
-exponentp :: TextParser m ((Quantity, Int) -> (Quantity, Int))
+exponentp :: TextParser m Int
 exponentp = do
   char' 'e'
-    exp <- ($) <$> signp <*> (read <$> some digitChar)
+  sign <- signp
-    return $ bimap (* 10^^exp) (max 0 . subtract exp)
+  d <- decimal
+  pure $ sign d
   <?> "exponentp"
 
 -- | Interpret a raw number as a decimal number.
@@ -700,19 +698,29 @@ exponentp = do
 -- - the precision (number of digits after the decimal point)  
 -- - the decimal point character, if any
 -- - the digit group style, if any (digit group character and sizes of digit groups)
-fromRawNumber :: RawNumber -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
+fromRawNumber
-fromRawNumber raw = case raw of
+  :: RawNumber
+  -> Maybe Int
+  -> Either String
+            (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
+fromRawNumber raw mExp = case raw of
 
   NoSeparators digitGrp mDecimals ->
     let decimalGrp = maybe mempty snd mDecimals
-        (quantity, precision) = toDecimal digitGrp decimalGrp
+        (quantity, precision) =
-    in  (quantity, precision, fmap fst mDecimals, Nothing)
+          maybe id applyExp mExp $ toQuantity digitGrp decimalGrp
 
-  WithSeparators digitSep digitGrps mDecimals ->
+    in  Right (quantity, precision, fmap fst mDecimals, Nothing)
+
+  WithSeparators digitSep digitGrps mDecimals -> do
     let decimalGrp = maybe mempty snd mDecimals
-        (quantity, precision) = toDecimal (mconcat digitGrps) decimalGrp
         digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps)
-    in  (quantity, precision, fmap fst mDecimals, Just digitGroupStyle)
+
+    let errMsg = "mixing digit separators with exponents is not allowed"
+    (quantity, precision) <- maybe Right (const $ const $ Left errMsg) mExp
+                           $ toQuantity (mconcat digitGrps) decimalGrp
+
+    Right (quantity, precision, fmap fst mDecimals, Just digitGroupStyle)
 
   where
     -- Outputs digit group sizes from least significant to most significant
@@ -721,13 +729,17 @@ fromRawNumber raw = case raw of
       (a:b:cs) | a < b -> b:cs
       gs               -> gs
 
-    toDecimal :: DigitGrp -> DigitGrp -> (Decimal, Int)
+    toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int)
-    toDecimal preDecimalGrp postDecimalGrp = (quantity, precision)
+    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) =
@@ -1105,19 +1117,19 @@ bracketedpostingdatesp mdefdate = do
 -- default date is provided. A missing year in DATE2 will be inferred
 -- from DATE.
 --
--- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
+-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
 -- Right [("date",2016-01-02),("date2",2016-03-04)]
 --
--- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1]"
+-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]"
 -- Left ...not a bracketed date...
 --
--- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"
+-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"
 -- Left ...1:11:...well-formed but invalid date: 2016/1/32...
 --
--- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1/31]"
+-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"
 -- Left ...1:6:...partial date 1/31 found, but the current year is unknown...
 --
--- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
+-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
 -- Left ...1:13:...expecting month or day...
 --
 bracketeddatetagsp :: Maybe Day -> SimpleTextParser [(TagName, Day)]