{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Data.ByteString.Lex.Fractional
-- Copyright   :  Copyright (c) 2015--2021 wren gayle romano
-- License     :  BSD2
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  BangPatterns + ScopedTypeVariables
--
-- Functions for parsing and producing 'Fractional' values from\/to
-- 'ByteString's based on the \"Char8\" encoding. That is, we assume
-- an ASCII-compatible encoding of alphanumeric characters.
--
-- /Since: 0.5.0/
----------------------------------------------------------------
module Data.ByteString.Lex.Fractional
    (
    -- * General combinators
      readSigned
    -- packSigned
    -- * Decimal conversions
    , readDecimal
    -- packDecimal
    -- TODO: asDecimal -- this will be really hard to make efficient...
    -- * Hexadecimal conversions
    , readHexadecimal
    -- packHexadecimal
    -- asHexadecimal
    -- * Octal conversions
    , readOctal
    -- packOctal
    -- asOctal -- this will be really hard to make efficient...
    -- * Exponential conversions
    , readExponential
    -- packExponential
    -- asExponential
    -- * Precision-limited conversions
    , decimalPrecision
    , readDecimalLimited
    , readExponentialLimited
    ) where

import           Data.ByteString              (ByteString)
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Unsafe       as BSU
import           Data.Word                     (Word8)
import qualified Data.ByteString.Lex.Integral as I
import           Data.ByteString.Lex.Integral (readSigned)
import           Data.ByteString.Lex.Internal

----------------------------------------------------------------
----------------------------------------------------------------

-- | A helper function to ensure consistent strictness.
-- TODO: should we really be this strict?
justPair :: a -> b -> Maybe (a,b)
{-# INLINE justPair #-}
justPair :: a -> b -> Maybe (a, b)
justPair !a
x !b
y = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
x,b
y)

pair :: a -> b -> (a,b)
{-# INLINE pair #-}
pair :: a -> b -> (a, b)
pair !a
x !b
y = (a
x,b
y)


-- NOTE: We use 'fromInteger' everywhere instead of 'fromIntegral'
-- in order to fix the types of the calls to 'I.readDecimal', etc.
-- This is always correct, but for some result types there are other
-- intermediate types which may be faster.


----------------------------------------------------------------
----- Decimal

-- | Read an unsigned\/non-negative fractional value in ASCII decimal
-- format; that is, anything matching the regex @\\d+(\\.\\d+)?@.
-- Returns @Nothing@ if there is no such number at the beginning
-- of the string, otherwise returns @Just@ the number read and the
-- remainder of the string.
--
-- N.B., see 'readDecimalLimited' if your fractional type has limited
-- precision and you expect your inputs to have greater precision
-- than can be represented. Even for types with unlimited precision
-- (e.g., 'Rational'), you may want to check out 'readDecimalLimited'.
readDecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readDecimal ::
    ByteString -> Maybe (Float,    ByteString),
    ByteString -> Maybe (Double,   ByteString),
    ByteString -> Maybe (Rational, ByteString) #-}
readDecimal :: ByteString -> Maybe (a, ByteString)
readDecimal ByteString
xs =
    case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
xs of
    Maybe (Integer, ByteString)
Nothing          -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
    Just (Integer
whole, ByteString
ys) ->
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ys of
        Maybe (Word8, ByteString)
Nothing              -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
whole) ByteString
BS.empty
        Just (Word8
y0,ByteString
ys0)
            | Word8 -> Bool
isNotPeriod Word8
y0 -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
whole) ByteString
ys
            | Bool
otherwise      ->
                case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
ys0 of
                Maybe (Integer, ByteString)
Nothing         -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
whole) ByteString
ys
                Just (Integer
part, ByteString
zs) ->
                    let base :: a
base = a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (ByteString -> Int
BS.length ByteString
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
zs)
                        frac :: a
frac = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
whole a -> a -> a
forall a. Num a => a -> a -> a
+ (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
part a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
base)
                    in a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair a
frac ByteString
zs


----------------------------------------------------------------
-- If and only if(!) we have Real, then we can use 'toRational'...
-- Similarly, only if we have RealFloat can we use 'decodeFloat'...

-- TODO:
-- Convert a non-negative fractional number into an (unsigned)
-- ASCII decimal string. Returns @Nothing@ on negative inputs.
-- packDecimal :: (Fractional a) => a -> Maybe ByteString


----------------------------------------------------------------
----------------------------------------------------------------
----- Hexadecimal

-- | Read a non-negative integral value in ASCII hexadecimal format.
-- Returns @Nothing@ if there is no integer at the beginning of the
-- string, otherwise returns @Just@ the integer read and the remainder
-- of the string.
--
-- This function does not recognize the various hexadecimal sigils
-- like \"0x\", but because there are so many different variants,
-- those are best handled by helper functions which then use this
-- function for the actual numerical parsing. This function recognizes
-- both upper-case, lower-case, and mixed-case hexadecimal.
--
-- This is just a thin wrapper around 'I.readHexadecimal'.
readHexadecimal :: (Fractional a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readHexadecimal ::
    ByteString -> Maybe (Float,    ByteString),
    ByteString -> Maybe (Double,   ByteString),
    ByteString -> Maybe (Rational, ByteString) #-}
readHexadecimal :: ByteString -> Maybe (a, ByteString)
readHexadecimal ByteString
xs =
    case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readHexadecimal ByteString
xs of
    Maybe (Integer, ByteString)
Nothing       -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
    Just (Integer
n, ByteString
xs') -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n) ByteString
xs'


-- TODO:
-- Convert a non-negative integer into a lower-case ASCII hexadecimal
-- string. Returns @Nothing@ on negative inputs.
-- packHexadecimal :: (Fractional a) => a -> Maybe ByteString


----------------------------------------------------------------
----------------------------------------------------------------
----- Octal

-- | Read a non-negative integral value in ASCII octal format.
-- Returns @Nothing@ if there is no integer at the beginning of the
-- string, otherwise returns @Just@ the integer read and the remainder
-- of the string.
--
-- This function does not recognize the various octal sigils like
-- \"0o\", but because there are different variants, those are best
-- handled by helper functions which then use this function for the
-- actual numerical parsing.
--
-- This is just a thin wrapper around 'I.readOctal'.
readOctal :: (Fractional a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readOctal ::
    ByteString -> Maybe (Float,    ByteString),
    ByteString -> Maybe (Double,   ByteString),
    ByteString -> Maybe (Rational, ByteString) #-}
readOctal :: ByteString -> Maybe (a, ByteString)
readOctal ByteString
xs =
    case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readOctal ByteString
xs of
    Maybe (Integer, ByteString)
Nothing       -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
    Just (Integer
n, ByteString
xs') -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n) ByteString
xs'

-- TODO:
-- Convert a non-negative integer into an ASCII octal string.
-- Returns @Nothing@ on negative inputs.
-- packOctal :: (Fractional a) => a -> Maybe ByteString


----------------------------------------------------------------
----------------------------------------------------------------
----- Exponential

-- | Read an unsigned\/non-negative fractional value in ASCII
-- exponential format; that is, anything matching the regex
-- @\\d+(\\.\\d+)?([eE][\\+\\-]?\\d+)?@. Returns @Nothing@ if there
-- is no such number at the beginning of the string, otherwise
-- returns @Just@ the number read and the remainder of the string.
--
-- N.B., the current implementation assumes the exponent is small
-- enough to fit into an 'Int'. This gives a significant performance
-- increase for @a ~ Float@ and @a ~ Double@ and agrees with the
-- 'RealFloat' class which has 'exponent' returning an 'Int'. If
-- you need a larger exponent, contact the maintainer.
--
-- N.B., see 'readExponentialLimited' if your fractional type has
-- limited precision and you expect your inputs to have greater
-- precision than can be represented. Even for types with unlimited
-- precision, you may want to check out 'readExponentialLimited'.
readExponential :: (Fractional a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readExponential ::
    ByteString -> Maybe (Float,    ByteString),
    ByteString -> Maybe (Double,   ByteString),
    ByteString -> Maybe (Rational, ByteString) #-}
readExponential :: ByteString -> Maybe (a, ByteString)
readExponential ByteString
xs =
    case ByteString -> Maybe (a, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
readDecimal ByteString
xs of
    Maybe (a, ByteString)
Nothing         -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
    Just (a
frac, ByteString
ys) ->
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ys of
        Maybe (Word8, ByteString)
Nothing         -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair a
frac ByteString
BS.empty
        Just (Word8
y0,ByteString
ys0)
            | Word8 -> Bool
isNotE Word8
y0 -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair a
frac ByteString
ys
            | Bool
otherwise ->
                -- HACK: monomorphizing @e::Int@ for performance!
                case (ByteString -> Maybe (Int, ByteString))
-> ByteString -> Maybe (Int, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
ys0 of
                Maybe (Int, ByteString)
Nothing      -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair a
frac ByteString
ys
                Just (Int
ex,ByteString
zs) -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (a
frac a -> a -> a
forall a. Num a => a -> a -> a
* (a
10 a -> Int -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (Int
ex::Int))) ByteString
zs


----------------------------------------------------------------
----------------------------------------------------------------
----- Limited


-- | A representation of unsigned fractional numbers decomposed
-- into a significand\/mantissa and a decimal exponent. This allows
-- efficient scaling by decimal exponents (cf., 'scaleDF').
--
-- TODO: the first component should be some @a@-specific intermediate
-- representation, as defined by a fundep or typefamily! We use
-- 'Integer' which is sufficient for all cases, but it'd be better
-- to use @Word24@ for 'Float', @Word53@ for 'Double', and @a@ for
-- @'Data.Ratio.Ratio' a@.
data DecimalFraction a = DF !Integer {-# UNPACK #-}!Int
-- BUG: Can't unpack integers...


-- | A helpful smart constructor.
fractionDF :: Integer -> Int -> Integer -> DecimalFraction a
{-# INLINE fractionDF #-}
fractionDF :: Integer -> Int -> Integer -> DecimalFraction a
fractionDF Integer
whole Int
scale Integer
part =
    Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF (Integer
whole Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
scale) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
part) (Int -> Int
forall a. Num a => a -> a
negate Int
scale)
    -- TODO: use an unsafe variant of (^) which has an assertion instead of a runtime check?


-- | Extract the fractional number encoded in the record.
--
-- > fromDF (DF frac scale) = fromIntegral frac * (10 ^^ scale)
fromDF :: Fractional a => DecimalFraction a -> a
{-# INLINE fromDF #-}
fromDF :: DecimalFraction a -> a
fromDF (DF Integer
frac Int
scale)
    -- Avoid possibility of returning NaN
    -- TODO: really, ought to check @fromInteger frac == 0@...
    | Integer
frac  Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0        = a
0
    -- Avoid throwing an error due to @negate minBound == minBound@
    | Int
scale Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
frac a -> a -> a
forall a. Num a => a -> a -> a
* (a
10 a -> Integer -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
scale)
    -- Now we're safe for the default implementation
    | Bool
otherwise         = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
frac a -> a -> a
forall a. Num a => a -> a -> a
* (a
10 a -> Int -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Int
scale)
    -- TODO: manually implement (^^) so that we get @_ / (10^ _)@
    -- instead of @_ * recip (10^ _)@ for negative exponents?


-- | Scale a decimal fraction by some power of 10.
scaleDF :: DecimalFraction a -> Int -> DecimalFraction a
{-# INLINE scaleDF #-}
scaleDF :: DecimalFraction a -> Int -> DecimalFraction a
scaleDF (DF Integer
frac Int
scale) Int
scale' = Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
frac (Int
scale Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scale')


-- TODO: is there a way to avoid ScopedTypeVariables without losing
-- the fact that this is a constant function?
--
-- TODO: try looking at core again to see if @n@ gets completely
-- optimized away or not. If not, is there a way to help make that
-- happen without using TH?
--
-- | Return the 'RealFloat' type's inherent decimal precision
-- limitation. This is the number of decimal digits in @floatRadix
-- proxy ^ floatDigits proxy@.
decimalPrecision :: forall proxy a. RealFloat a => proxy a -> Int
{-# INLINE decimalPrecision #-}
decimalPrecision :: proxy a -> Int
decimalPrecision =
    let proxy :: a
proxy = a
forall a. HasCallStack => a
undefined :: a
        n :: Int
n = Integer -> Int
forall a. Integral a => a -> Int
numDecimalDigits (a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
proxy Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
proxy)
    in Int
n Int -> (proxy a -> Int) -> proxy a -> Int
`seq` \proxy a
_ -> Int
n


-- TODO: for the isDecimalZero instance, use 'BS.breakByte' where
-- possible; or design our own similar...
--
-- | Drop while the predicate is true, and return the number of
-- bytes dropped.
lengthDropWhile :: (Word8 -> Bool) -> ByteString -> (Int, ByteString)
{-# INLINE lengthDropWhile #-}
lengthDropWhile :: (Word8 -> Bool) -> ByteString -> (Int, ByteString)
lengthDropWhile Word8 -> Bool
p ByteString
xs =
    let ys :: ByteString
ys = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
p ByteString
xs
    in (ByteString -> Int
BS.length ByteString
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
ys, ByteString
ys)
    {-
    -- TODO: benchmark
    let len = BS.length (BS.takeWhile p xs)
    in (len, BS.drop len xs)

    case BS.break (not . p) xs of
    (ys,zs) -> (BS.length ys, zs)
    -}


-- | A variant of 'readDecimal' which only reads up to some limited
-- precision. The first argument gives the number of decimal digits
-- at which to limit the precision.
--
-- For types with inherently limited precision (e.g., 'Float' and
-- 'Double'), when you pass in the precision limit (cf.,
-- 'decimalPrecision') this is far more efficient than 'readDecimal'.
-- However, passing in a precision limit which is greater than the
-- type's inherent limitation will degrate performance compared to
-- 'readDecimal'.
--
-- For types with unlimited precision (e.g., 'Rational') this may
-- still be far more efficient than 'readDecimal' (it is for
-- 'Rational', in fact). The reason being that it delays the scaling
-- the significand\/mantissa by the exponent, thus allowing you to
-- further adjust the exponent before computing the final value
-- (e.g., as in 'readExponentialLimited'). This avoids the need to
-- renormalize intermediate results, and allows faster computation
-- of the scaling factor by doing it all at once.
readDecimalLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString)
{-# INLINE readDecimalLimited #-}
readDecimalLimited :: Int -> ByteString -> Maybe (a, ByteString)
readDecimalLimited Int
p ByteString
xs =
    case Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Fractional a =>
Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readDecimalLimited_ Int
p ByteString
xs of
    Maybe (DecimalFraction a, ByteString)
Nothing      -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
    Just (DecimalFraction a
df,ByteString
ys) -> a -> ByteString -> Maybe (a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (DecimalFraction a -> a
forall a. Fractional a => DecimalFraction a -> a
fromDF DecimalFraction a
df) ByteString
ys


readDecimalLimited_ :: (Fractional a) => Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
{-# SPECIALIZE readDecimalLimited_ ::
    Int -> ByteString -> Maybe (DecimalFraction Float,    ByteString),
    Int -> ByteString -> Maybe (DecimalFraction Double,   ByteString),
    Int -> ByteString -> Maybe (DecimalFraction Rational, ByteString) #-}
readDecimalLimited_ :: Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readDecimalLimited_ = Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
start
    where
    -- All calls to 'I.readDecimal' are monomorphized at 'Integer',
    -- as specified by what 'DF' needs.
    start :: Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
start !Int
p !ByteString
xs =
        case (Word8 -> Bool) -> ByteString -> (Int, ByteString)
lengthDropWhile Word8 -> Bool
isDecimalZero ByteString
xs of
        (Int
0, ByteString
_)  -> Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readWholePart Int
p ByteString
xs
        (Int
_, ByteString
ys) ->
            case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ys of
            Maybe (Word8, ByteString)
Nothing              -> DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
0 Int
0) ByteString
BS.empty
            Just (Word8
y0,ByteString
ys0)
                | Word8 -> Bool
isDecimal   Word8
y0 -> Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readWholePart Int
p ByteString
ys
                | Word8 -> Bool
isNotPeriod Word8
y0 -> DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
0 Int
0) ByteString
ys
                | Bool
otherwise      ->
                    case (Word8 -> Bool) -> ByteString -> (Int, ByteString)
lengthDropWhile Word8 -> Bool
isDecimalZero ByteString
ys0 of
                    (Int
0,     ByteString
_)   -> Int
-> Integer -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int
-> Integer -> ByteString -> Maybe (DecimalFraction a, ByteString)
readFractionPart Int
p Integer
0 ByteString
ys
                    (Int
scale, ByteString
zs)  -> Int -> Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int -> Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
afterDroppingZeroes Int
p Int
scale ByteString
zs

    afterDroppingZeroes :: Int -> Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
afterDroppingZeroes !Int
p !Int
scale !ByteString
xs =
        let ys :: ByteString
ys = Int -> ByteString -> ByteString
BS.take Int
p ByteString
xs in
        case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
ys of
        Maybe (Integer, ByteString)
Nothing          -> DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
0 Int
0) ByteString
xs
        Just (Integer
part, ByteString
ys') ->
            let scale' :: Int
scale' = Int
scale Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
ys'
            in  DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
part (Int -> Int
forall a. Num a => a -> a
negate Int
scale'))
                    ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isDecimal ByteString
ys')

    readWholePart :: Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readWholePart !Int
p !ByteString
xs =
        let ys :: ByteString
ys = Int -> ByteString -> ByteString
BS.take Int
p ByteString
xs in
        case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
ys of
        Maybe (Integer, ByteString)
Nothing           -> Maybe (DecimalFraction a, ByteString)
forall a. Maybe a
Nothing
        Just (Integer
whole, ByteString
ys')
            | ByteString -> Bool
BS.null ByteString
ys' ->
                case (Word8 -> Bool) -> ByteString -> (Int, ByteString)
lengthDropWhile Word8 -> Bool
isDecimal (Int -> ByteString -> ByteString
BS.drop Int
p ByteString
xs) of
                (Int
scale, ByteString
zs) ->
                    DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
whole Int
scale) (ByteString -> ByteString
dropFractionPart ByteString
zs)
            | Bool
otherwise  ->
                let len :: Int
len = ByteString -> Int
BS.length ByteString
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
ys'
                    -- N.B., @xs' == ys' `BS.append` BS.drop p xs@
                    xs' :: ByteString
xs' = Int -> ByteString -> ByteString
BS.drop Int
len ByteString
xs
                in
                -- N.B., @BS.null xs'@ is impossible. Were it to
                -- happen then returning @pair (DF whole 0) BS.empty@
                -- is consistent with the branch where we drop the
                -- fraction part (the original input is less than
                -- the original @p@ long); however, reaching this
                -- branch ia that input would be a control-flow
                -- error.
                if Word8 -> Bool
isNotPeriod (ByteString -> Word8
BSU.unsafeHead ByteString
xs')
                then DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
whole Int
0) ByteString
xs'
                else Int
-> Integer -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Int
-> Integer -> ByteString -> Maybe (DecimalFraction a, ByteString)
readFractionPart (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len) Integer
whole ByteString
xs'

    dropFractionPart :: ByteString -> ByteString
dropFractionPart !ByteString
xs =
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs of
        Maybe (Word8, ByteString)
Nothing                    -> ByteString
BS.empty -- == xs
        Just (Word8
x0,ByteString
xs0)
            | Word8 -> Bool
isNotPeriod Word8
x0       -> ByteString
xs
            | Bool
otherwise            ->
                case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs0 of
                Maybe (Word8, ByteString)
Nothing            -> Word8 -> ByteString
BS.singleton Word8
0x2E -- == xs
                Just (Word8
x1,ByteString
xs1)
                    | Word8 -> Bool
isDecimal Word8
x1 -> (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isDecimal ByteString
xs1
                    | Bool
otherwise    -> ByteString
xs

    -- NOTES: @BS.null xs@ is impossible as it begins with a period;
    -- see the call sites. If @not (BS.null ys')@ then the @BS.dropWhile
    -- isDecimal@ is a noop; but there's no reason to branch on
    -- testing for that. The @+1@ in @BS.drop (1+scale)@ is for the
    -- 'BSU.unsafeTail' in @ys@.
    readFractionPart :: Int
-> Integer -> ByteString -> Maybe (DecimalFraction a, ByteString)
readFractionPart !Int
p !Integer
whole !ByteString
xs =
        let ys :: ByteString
ys = Int -> ByteString -> ByteString
BS.take Int
p (ByteString -> ByteString
BSU.unsafeTail ByteString
xs) in
        case ByteString -> Maybe (Integer, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal ByteString
ys of
        Maybe (Integer, ByteString)
Nothing          -> DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> DecimalFraction a
forall a. Integer -> Int -> DecimalFraction a
DF Integer
whole Int
0) ByteString
xs
        Just (Integer
part, ByteString
ys') ->
            let scale :: Int
scale = ByteString -> Int
BS.length ByteString
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
ys'
            in  DecimalFraction a
-> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a b. a -> b -> Maybe (a, b)
justPair (Integer -> Int -> Integer -> DecimalFraction a
forall a. Integer -> Int -> Integer -> DecimalFraction a
fractionDF Integer
whole Int
scale Integer
part)
                    ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isDecimal (Int -> ByteString -> ByteString
BS.drop (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
scale) ByteString
xs))


-- | A variant of 'readExponential' which only reads up to some limited
-- precision. The first argument gives the number of decimal digits
-- at which to limit the precision. See 'readDecimalLimited' for
-- more discussion of the performance benefits of using this function.
readExponentialLimited :: (Fractional a) => Int -> ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readExponentialLimited ::
    Int -> ByteString -> Maybe (Float,    ByteString),
    Int -> ByteString -> Maybe (Double,   ByteString),
    Int -> ByteString -> Maybe (Rational, ByteString) #-}
readExponentialLimited :: Int -> ByteString -> Maybe (a, ByteString)
readExponentialLimited = Int -> ByteString -> Maybe (a, ByteString)
forall a.
Fractional a =>
Int -> ByteString -> Maybe (a, ByteString)
start
    where
    start :: Int -> ByteString -> Maybe (a, ByteString)
start !Int
p !ByteString
xs =
        case Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
forall a.
Fractional a =>
Int -> ByteString -> Maybe (DecimalFraction a, ByteString)
readDecimalLimited_ Int
p ByteString
xs of
        Maybe (DecimalFraction a, ByteString)
Nothing       -> Maybe (a, ByteString)
forall a. Maybe a
Nothing
        Just (DecimalFraction a
df,ByteString
xs') -> (a, ByteString) -> Maybe (a, ByteString)
forall a. a -> Maybe a
Just ((a, ByteString) -> Maybe (a, ByteString))
-> (a, ByteString) -> Maybe (a, ByteString)
forall a b. (a -> b) -> a -> b
$! DecimalFraction a -> ByteString -> (a, ByteString)
forall a.
Fractional a =>
DecimalFraction a -> ByteString -> (a, ByteString)
readExponentPart DecimalFraction a
df ByteString
xs'

    readExponentPart :: DecimalFraction a -> ByteString -> (a, ByteString)
readExponentPart !DecimalFraction a
df !ByteString
xs
        | ByteString -> Bool
BS.null ByteString
xs                 = a -> ByteString -> (a, ByteString)
forall a b. a -> b -> (a, b)
pair (DecimalFraction a -> a
forall a. Fractional a => DecimalFraction a -> a
fromDF DecimalFraction a
df) ByteString
BS.empty
        | Word8 -> Bool
isNotE (ByteString -> Word8
BSU.unsafeHead ByteString
xs) = a -> ByteString -> (a, ByteString)
forall a b. a -> b -> (a, b)
pair (DecimalFraction a -> a
forall a. Fractional a => DecimalFraction a -> a
fromDF DecimalFraction a
df) ByteString
xs
        | Bool
otherwise                  =
            -- HACK: monomorphizing at 'Int'
            -- TODO: how to handle too-large exponents?
            case (ByteString -> Maybe (Int, ByteString))
-> ByteString -> Maybe (Int, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
I.readDecimal (ByteString -> ByteString
BSU.unsafeTail ByteString
xs) of
            Maybe (Int, ByteString)
Nothing           -> a -> ByteString -> (a, ByteString)
forall a b. a -> b -> (a, b)
pair (DecimalFraction a -> a
forall a. Fractional a => DecimalFraction a -> a
fromDF DecimalFraction a
df) ByteString
xs
            Just (Int
scale, ByteString
xs') -> a -> ByteString -> (a, ByteString)
forall a b. a -> b -> (a, b)
pair (DecimalFraction a -> a
forall a. Fractional a => DecimalFraction a -> a
fromDF (DecimalFraction a -> a) -> DecimalFraction a -> a
forall a b. (a -> b) -> a -> b
$ DecimalFraction a -> Int -> DecimalFraction a
forall a. DecimalFraction a -> Int -> DecimalFraction a
scaleDF DecimalFraction a
df Int
scale) ByteString
xs'

----------------------------------------------------------------
----------------------------------------------------------- fin.