{-|
Module      : Z.Data.Parser.Numeric
Description : Textual numeric parsers.
Copyright   : (c) Dong Han, 2017-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Textual numeric parsers.

-}

module Z.Data.Parser.Numeric
  ( -- * Decimal
    uint, int, integer
  , uint_, int_, digit
    -- * Hex
  , hex, hex', hex_
    -- * Fractional
  , rational
  , float, double
  , scientific
  , scientifically
    -- * Stricter fractional(rfc8259)
  , rational'
  , float', double'
  , scientific'
  , scientifically'
    -- * Misc
  , w2iHex, w2iDec
  , hexLoop
  , decLoop
  , decLoopIntegerFast
  , sciToDouble
  ) where

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import           Data.Int
import qualified Data.Scientific        as Sci
import           Data.Word
import           GHC.Exts
import           GHC.Num
import           GHC.Float              (expt)
import           Z.Data.ASCII
import           Z.Data.Parser.Base     (Parser, (<?>))
import qualified Z.Data.Parser.Base     as P
import qualified Z.Data.Vector.Base     as V
import qualified Z.Data.Vector.Extra    as V
import           Z.Foreign
import           System.IO.Unsafe

#define WORD64_SAFE_DIGITS_LEN 19
#define INT64_SAFE_DIGITS_LEN 18


-- | Parse and decode an unsigned hex number, fail if input length is larger than (bit_size/4). The hex digits
-- @\'a\'@ through @\'f\'@ may be upper or lower case.
--
-- This parser does not accept a leading @\"0x\"@ string, and consider
-- sign bit part of the binary hex nibbles, e.g.
--
-- >>> parse' hex "FF" == Right (-1 :: Int8)
-- >>> parse' hex "7F" == Right (127 :: Int8)
-- >>> parse' hex "7Ft" == Right (127 :: Int8)
-- >>> parse' hex "7FF" == Left ["Z.Data.Parser.Numeric.hex","hex numeric number overflow"]
--
hex :: forall a.(Integral a, FiniteBits a) => Parser a
{-# INLINABLE hex #-}
{-# SPECIALIZE INLINE hex :: Parser Int #-}
{-# SPECIALIZE INLINE hex :: Parser Int8 #-}
{-# SPECIALIZE INLINE hex :: Parser Int16 #-}
{-# SPECIALIZE INLINE hex :: Parser Int32 #-}
{-# SPECIALIZE INLINE hex :: Parser Int64 #-}
{-# SPECIALIZE INLINE hex :: Parser Word #-}
{-# SPECIALIZE INLINE hex :: Parser Word8 #-}
{-# SPECIALIZE INLINE hex :: Parser Word16 #-}
{-# SPECIALIZE INLINE hex :: Parser Word32 #-}
{-# SPECIALIZE INLINE hex :: Parser Word64 #-}
hex :: forall a. (Integral a, FiniteBits a) => Parser a
hex = Text
"Z.Data.Parser.Numeric.hex" forall a. Text -> Parser a -> Parser a
<?> do
    Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isHexDigit
    if forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
<= forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 Bytes
bs
    else forall a. Text -> Parser a
P.fail' Text
"hex numeric number overflow"

-- | Same with 'hex', but only take as many as (bit_size/4) bytes.
--
-- >>> parse' hex "FF" == Right (-1 :: Int8)
-- >>> parse' hex "7F" == Right (127 :: Int8)
-- >>> parse' hex "7Ft" == Right (127 :: Int8)
-- >>> parse' hex "7FF" == Right (127 :: Int8)
hex' :: forall a.(Integral a, FiniteBits a) => Parser a
{-# INLINABLE hex' #-}
{-# SPECIALIZE INLINE hex' :: Parser Int #-}
{-# SPECIALIZE INLINE hex' :: Parser Int8 #-}
{-# SPECIALIZE INLINE hex' :: Parser Int16 #-}
{-# SPECIALIZE INLINE hex' :: Parser Int32 #-}
{-# SPECIALIZE INLINE hex' :: Parser Int64 #-}
{-# SPECIALIZE INLINE hex' :: Parser Word #-}
{-# SPECIALIZE INLINE hex' :: Parser Word8 #-}
{-# SPECIALIZE INLINE hex' :: Parser Word16 #-}
{-# SPECIALIZE INLINE hex' :: Parser Word32 #-}
{-# SPECIALIZE INLINE hex' :: Parser Word64 #-}
hex' :: forall a. (Integral a, FiniteBits a) => Parser a
hex' = Text
"Z.Data.Parser.Numeric.hex'" forall a. Text -> Parser a -> Parser a
<?> do
    forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Word8 -> Bool) -> Int -> Parser Bytes
P.takeN Word8 -> Bool
isHexDigit (forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2)
  where

-- | Same with 'hex', but silently cast in case of overflow.
--
-- >>> parse' hex "FF" == Right (-1 :: Int8)
-- >>> parse' hex "7F" == Right (127 :: Int8)
-- >>> parse' hex "7Ft" == Right (127 :: Int8)
-- >>> parse' hex "7FF" == Right (-1 :: Int8)
hex_ :: (Integral a, Bits a) => Parser a
{-# INLINABLE hex_ #-}
{-# SPECIALIZE INLINE hex_ :: Parser Int #-}
{-# SPECIALIZE INLINE hex_ :: Parser Int8 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Int16 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Int32 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Int64 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Word #-}
{-# SPECIALIZE INLINE hex_ :: Parser Word8 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Word16 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Word32 #-}
{-# SPECIALIZE INLINE hex_ :: Parser Word64 #-}
hex_ :: forall a. (Integral a, Bits a) => Parser a
hex_ = Text
"Z.Data.Parser.Numeric.hex_" forall a. Text -> Parser a -> Parser a
<?> forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isHexDigit

-- | decode hex digits sequence within an array.
hexLoop :: forall a. (Integral a, Bits a)
        => a    -- ^ accumulator, usually start from 0
        -> V.Bytes
        -> a
{-# INLINE hexLoop #-}
hexLoop :: forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop = forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' a -> Word8 -> a
step
  where
    step :: a -> Word8 -> a
step a
a Word8
w = a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => Word8 -> a
w2iHex Word8
w :: a)

-- | Convert A ASCII hex digit to 'Int' value.
w2iHex :: Integral a => Word8 -> a
{-# INLINE w2iHex #-}
w2iHex :: forall a. Integral a => Word8 -> a
w2iHex Word8
w
    | Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
57   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Num a => a -> a -> a
- a
48
    | Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
70   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Num a => a -> a -> a
- a
55
    | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Num a => a -> a -> a
- a
87

-- | Same with 'uint', but sliently cast in case of overflow.
uint_ :: forall a. (Integral a, Bounded a) => Parser a
{-# INLINABLE uint_ #-}
{-# SPECIALIZE INLINE uint_ :: Parser Int #-}
{-# SPECIALIZE INLINE uint_ :: Parser Int8 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Int16 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Int32 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Int64 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Word #-}
{-# SPECIALIZE INLINE uint_ :: Parser Word8 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Word16 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Word32 #-}
{-# SPECIALIZE INLINE uint_ :: Parser Word64 #-}
uint_ :: forall a. (Integral a, Bounded a) => Parser a
uint_ = Text
"Z.Data.Parser.Numeric.uint_" forall a. Text -> Parser a -> Parser a
<?> forall a. Integral a => a -> Bytes -> a
decLoop a
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit

-- | Parse and decode an unsigned decimal number.
--
-- Will fail in case of overflow.
uint :: forall a. (Integral a, Bounded a) => Parser a
{-# INLINABLE uint #-}
{-# SPECIALIZE INLINE uint :: Parser Int #-}
{-# SPECIALIZE INLINE uint :: Parser Int8 #-}
{-# SPECIALIZE INLINE uint :: Parser Int16 #-}
{-# SPECIALIZE INLINE uint :: Parser Int32 #-}
{-# SPECIALIZE INLINE uint :: Parser Int64 #-}
{-# SPECIALIZE INLINE uint :: Parser Word #-}
{-# SPECIALIZE INLINE uint :: Parser Word8 #-}
{-# SPECIALIZE INLINE uint :: Parser Word16 #-}
{-# SPECIALIZE INLINE uint :: Parser Word32 #-}
{-# SPECIALIZE INLINE uint :: Parser Word64 #-}
uint :: forall a. (Integral a, Bounded a) => Parser a
uint = Text
"Z.Data.Parser.Numeric.uint" forall a. Text -> Parser a -> Parser a
<?> do
    Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
    if forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
    then do
        let w64 :: Word64
w64 = forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
bs
        if Word64
w64 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
        else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
    else do
        let w64 :: Integer
w64 = forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs
        if Integer
w64 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w64
        else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"

-- | Decode digits sequence within an array.
--
-- This function may overflow if result can't fit into type.
decLoop :: Integral a
        => a    -- ^ accumulator, usually start from 0
        -> V.Bytes
        -> a
{-# INLINE decLoop #-}
decLoop :: forall a. Integral a => a -> Bytes -> a
decLoop = forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' forall {a}. Integral a => a -> Word8 -> a
step
  where step :: a -> Word8 -> a
step a
a Word8
w = a
a forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ forall a. Integral a => Word8 -> a
w2iDec Word8
w


-- | Convert A ASCII decimal digit to 'Int' value.
--
w2iDec :: Integral a => Word8 -> a
{-# INLINE w2iDec #-}
w2iDec :: forall a. Integral a => Word8 -> a
w2iDec Word8
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Num a => a -> a -> a
- a
48

-- | decode digits sequence within an array.
--
-- A fast version to decode 'Integer' using machine word as much as possible.
decLoopIntegerFast :: V.Bytes -> Integer
{-# INLINE decLoopIntegerFast #-}
decLoopIntegerFast :: Bytes -> Integer
decLoopIntegerFast Bytes
bs
    | forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN = fromIntegral (decLoop @Word64 0 bs)
    | Bool
otherwise                            = forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs


-- | Take a single decimal digit and return as 'Int'.
--
digit :: Parser Int
{-# INLINE digit #-}
digit :: Parser Int
digit = do
    Word8
d <- (Word8 -> Bool) -> Parser Word8
P.satisfy Word8 -> Bool
isDigit
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Integral a => Word8 -> a
w2iDec Word8
d

-- | Parse a decimal number with an optional leading @\'+\'@ or @\'-\'@ sign
-- character.
--
-- This parser will fail if overflow happens.
int :: forall a. (Integral a, Bounded a) => Parser a
{-# INLINABLE int #-}
{-# SPECIALIZE INLINE int :: Parser Int #-}
{-# SPECIALIZE INLINE int :: Parser Int8 #-}
{-# SPECIALIZE INLINE int :: Parser Int16 #-}
{-# SPECIALIZE INLINE int :: Parser Int32 #-}
{-# SPECIALIZE INLINE int :: Parser Int64 #-}
{-# SPECIALIZE INLINE int :: Parser Word #-}
{-# SPECIALIZE INLINE int :: Parser Word8 #-}
{-# SPECIALIZE INLINE int :: Parser Word16 #-}
{-# SPECIALIZE INLINE int :: Parser Word32 #-}
{-# SPECIALIZE INLINE int :: Parser Word64 #-}
int :: forall a. (Integral a, Bounded a) => Parser a
int = Text
"Z.Data.Parser.Numeric.int" forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
loopNe
    else if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
loop else Parser a
loop
  where
    loop :: Parser a
loop = do
        Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
        if forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
        then do
            let w64 :: Word64
w64 = forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
bs
            if Word64
w64 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
            else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
        else do
            let w64 :: Integer
w64 = forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs
            if Integer
w64 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w64
            else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
    loopNe :: Parser a
loopNe = do
        Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
        if forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs forall a. Ord a => a -> a -> Bool
<= INT64_SAFE_DIGITS_LEN
        then do
            let i64 :: Int64
i64 = forall a. Num a => a -> a
negate (forall a. Integral a => a -> Bytes -> a
decLoop @Int64 Int64
0 Bytes
bs)
            if Int64
i64 forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a)
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i64
            else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
        else do
            let i64 :: Integer
i64 = forall a. Num a => a -> a
negate (forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs)
            if Integer
i64 forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a)
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i64
            else forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"

-- | Same with 'int', but sliently cast if overflow happens.
int_ :: (Integral a, Bounded a) => Parser a
{-# INLINABLE int_ #-}
{-# SPECIALIZE INLINE int_ :: Parser Int #-}
{-# SPECIALIZE INLINE int_ :: Parser Int8 #-}
{-# SPECIALIZE INLINE int_ :: Parser Int16 #-}
{-# SPECIALIZE INLINE int_ :: Parser Int32 #-}
{-# SPECIALIZE INLINE int_ :: Parser Int64 #-}
{-# SPECIALIZE INLINE int_ :: Parser Word #-}
{-# SPECIALIZE INLINE int_ :: Parser Word8 #-}
{-# SPECIALIZE INLINE int_ :: Parser Word16 #-}
{-# SPECIALIZE INLINE int_ :: Parser Word32 #-}
{-# SPECIALIZE INLINE int_ :: Parser Word64 #-}
int_ :: forall a. (Integral a, Bounded a) => Parser a
int_ = Text
"Z.Data.Parser.Numeric.int_" forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
loop)
    else if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
loop else Parser a
loop
  where
    loop :: Parser a
loop = forall a. Integral a => a -> Bytes -> a
decLoop a
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit

-- | Parser specifically optimized for 'Integer'.
--
integer :: Parser Integer
{-# INLINABLE integer #-}
integer :: Parser Integer
integer =  Text
"Z.Data.Parser.Numeric.integer" forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
integer')
    else if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
integer' else Parser Integer
integer'
  where
    -- strip integer's message
    integer' :: Parser Integer
integer' = Bytes -> Integer
decLoopIntegerFast forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit

-- | Parse a rational number.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
-- /Note/: this parser is not safe for use with inputs from untrusted
-- sources.  An input with a suitably large exponent such as
-- @"1e1000000000"@ will cause a huge 'Integer' to be allocated,
-- resulting in what is effectively a denial-of-service attack.
--
-- In most cases, it is better to use 'double' or 'scientific'
-- instead.
--
rational :: (Fractional a) => Parser a
{-# INLINABLE rational #-}
rational :: forall a. Fractional a => Parser a
rational = Text
"Z.Data.Parser.Numeric.rational" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Parse a rational number and round to 'Double'.
--
-- This parser accepts an optional leading sign character, followed by
-- at least one decimal digit.  The syntax similar to that accepted by
-- the 'read' function, with the exception that a trailing @\'.\'@ or
-- @\'e\'@ /not/ followed by a number is not consumed.
--
-- Examples with behaviour identical to 'read':
--
-- >parse' double "3"     == ("", Right 3.0)
-- >parse' double "3.1"   == ("", Right 3.1)
-- >parse' double "3e4"   == ("", Right 30000.0)
-- >parse' double "3.1e4" == ("", Right 31000.0)
--
-- >parse' double ".3"    == (".3", Left ParserError)
-- >parse' double "e3"    == ("e3", Left ParserError)
--
-- Examples of differences from 'read':
--
-- >parse' double "3.foo" == (".foo", Right 3.0)
-- >parse' double "3e"    == ("e",    Right 3.0)
-- >parse' double "-3e"   == ("e",    Right -3.0)
--
-- This function does not accept string representations of \"NaN\" or
-- \"Infinity\".
--
double :: Parser Double
{-# INLINABLE double #-}
double :: Parser Double
double = Text
"Z.Data.Parser.Numeric.double" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> Double
sciToDouble

-- | Parse a rational number and round to 'Float'.
--
-- Single precision version of 'double'.
float :: Parser Float
{-# INLINABLE float #-}
float :: Parser Float
float = Text
"Z.Data.Parser.Numeric.float" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal forall a. RealFloat a => Scientific -> a
Sci.toRealFloat

-- | Parse a scientific number.
--
-- The syntax accepted by this parser is the same as for 'double'.
--
scientific :: Parser Sci.Scientific
{-# INLINABLE scientific #-}
scientific :: Parser Scientific
scientific = Text
"Z.Data.Parser.Numeric.scientific" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal forall a. a -> a
id

-- | Parse a scientific number and convert to result using a user supply function.
--
-- The syntax accepted by this parser is the same as for 'double'.
scientifically :: (Sci.Scientific -> a) -> Parser a
{-# INLINABLE scientifically #-}
scientifically :: forall a. (Scientific -> a) -> Parser a
scientifically Scientific -> a
h = Text
"Z.Data.Parser.Numeric.scientifically" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> a
h

-- | Strip message version.
scientificallyInternal :: (Sci.Scientific -> a) -> Parser a
{-# INLINE scientificallyInternal #-}
scientificallyInternal :: forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> a
h = do
    !Word8
sign <- Parser Word8
P.peek
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
PLUS Bool -> Bool -> Bool
|| Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
MINUS) (Parser ()
P.skipWord8)
    !Bytes
intPart <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
    -- backtrack here is neccessary to avoid eating extra dot or e
    -- attoparsec is doing it wrong here: https://github.com/bos/attoparsec/issues/112
    !Scientific
sci <- (do
        -- during number parsing we want to use machine word as much as possible
        -- so as long as range permit, we use Word64 instead of final Integer
        !Bytes
fracPart <- Word8 -> Parser ()
P.word8 Word8
DOT forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
        let !ilen :: Int
ilen = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart
            !flen :: Int
flen = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
fracPart
            !base :: Integer
base =
                if Int
ilen forall a. Num a => a -> a -> a
+ Int
flen forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
                then forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> Bytes -> a
decLoop @Word64 (forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
intPart) Bytes
fracPart)
                else
                    let i :: Integer
i = Bytes -> Integer
decLoopIntegerFast Bytes
intPart
                        f :: Integer
f = Bytes -> Integer
decLoopIntegerFast Bytes
fracPart
                    in Integer
i forall a. Num a => a -> a -> a
* (Integer -> Int -> Integer
expt Integer
10 Int
flen) forall a. Num a => a -> a -> a
+ Integer
f
        Integer -> Int -> Parser Scientific
parseE Integer
base Int
flen) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Int -> Parser Scientific
parseE (Bytes -> Integer
decLoopIntegerFast Bytes
intPart) Int
0)
    -- intentionally lazy return here, we have done the grammar check, and h could potentially be very expensive, e.g. sciToDouble
    -- retained references are sign and sci, which are already in NF
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Word8
sign forall a. Eq a => a -> a -> Bool
/= Word8
MINUS then Scientific -> a
h Scientific
sci else Scientific -> a
h (forall a. Num a => a -> a
negate Scientific
sci))
  where
    parseE :: Integer -> Int -> Parser Scientific
parseE Integer
c Int
e =
        (do Word8
_ <- (Word8 -> Bool) -> Parser Word8
P.satisfy (\Word8
w -> Word8
w forall a. Eq a => a -> a -> Bool
==  Word8
LETTER_e Bool -> Bool -> Bool
|| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
LETTER_E)
            Int
e' <- forall a. (Integral a, Bounded a) => Parser a
int
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Scientific
Sci.scientific Integer
c (Int
e' forall a. Num a => a -> a -> a
- Int
e)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Scientific
Sci.scientific Integer
c (forall a. Num a => a -> a
negate Int
e))

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

-- | Parse a rational number.
--
-- The syntax accepted by this parser is the same as for 'double''.
--
-- /Note/: this parser is not safe for use with inputs from untrusted
-- sources.  An input with a suitably large exponent such as
-- @"1e1000000000"@ will cause a huge 'Integer' to be allocated,
-- resulting in what is effectively a denial-of-service attack.
--
-- In most cases, it is better to use 'double'' or 'scientific''
-- instead.
--
rational' :: (Fractional a) => Parser a
{-# INLINABLE rational' #-}
rational' :: forall a. Fractional a => Parser a
rational' = Text
"Z.Data.Parser.Numeric.rational'" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal' forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | More strict number parsing(rfc8259).
--
-- 'scientific' support parse @2314.@ and @21321exyz@ without eating extra dot or @e@ via
-- backtrack, this is not allowed in some strict grammer such as JSON, so we make an
-- non-backtrack strict number parser separately using LL(1) lookahead. This parser also
-- agree with 'read' on extra dot or e handling:
--
-- >parse' double "3.foo" == Left ParseError
-- >parse' double "3e"    == Left ParseError
--
-- Leading zeros or @+@ sign is also not allowed:
--
-- >parse' double "+3.14" == Left ParseError
-- >parse' double "0014" == Left ParseError
--
-- If you have a similar grammer, you can use this parser to save considerable time.
--
-- @
--      number = [ minus ] int [ frac ] [ exp ]
--      decimal-point = %x2E       ; .
--      digit1-9 = %x31-39         ; 1-9
--      e = %x65 / %x45            ; e E
--      exp = e [ minus / plus ] 1*DIGIT
--      frac = decimal-point 1*DIGIT
-- @
--
-- This function does not accept string representations of \"NaN\" or
-- \"Infinity\".
-- reference: https://tools.ietf.org/html/rfc8259#section-6
double' :: Parser Double
{-# INLINABLE double' #-}
double' :: Parser Double
double' = Text
"Z.Data.Parser.Numeric.double'" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> Double
sciToDouble

#define FASTFLOAT_SMALLEST_POWER -325
#define FASTFLOAT_LARGEST_POWER 308

-- | Faster scientific to double conversion using <https://github.com/lemire/fast_double_parser/>.
--
-- See @cbits/compute_float_64.c@.
sciToDouble :: Sci.Scientific -> Double
{-# INLINABLE sciToDouble #-}
sciToDouble :: Scientific -> Double
sciToDouble Scientific
sci = case Integer
c of
    (IS Int#
i#) | (Int
e forall a. Ord a => a -> a -> Bool
>= FASTFLOAT_SMALLEST_POWER && e <= FASTFLOAT_LARGEST_POWER) -> unsafeDupablePerformIO $ do
        let i = (I# i#)
            s = if i >= 0 then 0 else 1
            i' = fromIntegral $ if i >= 0 then i else (0-i)
        (success, r) <- allocPrimUnsafe @Word8 (compute_float_64 (fromIntegral e) i' s)
        if success == 0
        then return $! Sci.toRealFloat sci
        else return $! r
    Integer
_ -> forall a. RealFloat a => Scientific -> a
Sci.toRealFloat Scientific
sci
  where
    e :: Int
e = Scientific -> Int
Sci.base10Exponent Scientific
sci
    c :: Integer
c = Scientific -> Integer
Sci.coefficient Scientific
sci

-- | Parse a rational number and round to 'Float' using stricter grammer.
--
-- Single precision version of 'double''.
float' :: Parser Float
{-# INLINABLE float' #-}
float' :: Parser Float
float' = Text
"Z.Data.Parser.Numeric.float'" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal' forall a. RealFloat a => Scientific -> a
Sci.toRealFloat

-- | Parse a scientific number.
--
-- The syntax accepted by this parser is the same as for 'double''.
scientific' :: Parser Sci.Scientific
{-# INLINABLE scientific' #-}
scientific' :: Parser Scientific
scientific' = Text
"Z.Data.Parser.Numeric.scientific'" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal' forall a. a -> a
id

-- | Parse a scientific number and convert to result using a user supply function.
--
-- The syntax accepted by this parser is the same as for 'double''.
scientifically' :: (Sci.Scientific -> a) -> P.Parser a
{-# INLINABLE scientifically' #-}
scientifically' :: forall a. (Scientific -> a) -> Parser a
scientifically' Scientific -> a
h = Text
"Z.Data.Parser.Numeric.scientifically'" forall a. Text -> Parser a -> Parser a
<?> forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> a
h

-- | Strip message version of scientifically'.
scientificallyInternal' :: (Sci.Scientific -> a) -> P.Parser a
{-# INLINE scientificallyInternal' #-}
scientificallyInternal' :: forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> a
h = do
    !Word8
sign <- Parser Word8
P.peek
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign forall a. Eq a => a -> a -> Bool
== Word8
MINUS) (Parser ()
P.skipWord8) -- no leading plus is allowed
    !Bytes
intPart <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& forall (v :: * -> *) a. (Vec v a, HasCallStack) => v a -> a
V.head Bytes
intPart forall a. Eq a => a -> a -> Bool
== Word8
DIGIT_0) (forall a. Text -> Parser a
P.fail' Text
"leading zeros are not allowed")
    Maybe Word8
mdot <- Parser (Maybe Word8)
P.peekMaybe
    !Scientific
sci <- case Maybe Word8
mdot of
        Just Word8
DOT -> do
            !Bytes
fracPart <- Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
            -- during number parsing we want to use machine word as much as possible
            -- so as long as range permit, we use Word64 instead of final Integer
            let !ilen :: Int
ilen = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart
                !flen :: Int
flen = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
fracPart
                !base :: Integer
base =
                    if Int
ilen forall a. Num a => a -> a -> a
+ Int
flen forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
                    then forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Integral a => a -> Bytes -> a
decLoop @Word64 (forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
intPart) Bytes
fracPart)
                    else
                        let i :: Integer
i = Bytes -> Integer
decLoopIntegerFast Bytes
intPart
                            f :: Integer
f = Bytes -> Integer
decLoopIntegerFast Bytes
fracPart
                        in Integer
i forall a. Num a => a -> a -> a
* (Integer -> Int -> Integer
expt Integer
10 Int
flen) forall a. Num a => a -> a -> a
+ Integer
f
            Integer -> Int -> Parser Scientific
parseE Integer
base Int
flen
        Maybe Word8
_ -> Integer -> Int -> Parser Scientific
parseE (Bytes -> Integer
decLoopIntegerFast Bytes
intPart) Int
0
    -- intentionally lazy return here, we have done the grammar check, and h could potentially be very expensive, e.g. sciToDouble
    -- retained references are sign and sci, which are already in NF
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Word8
sign forall a. Eq a => a -> a -> Bool
/= Word8
MINUS then Scientific -> a
h Scientific
sci else Scientific -> a
h (forall a. Num a => a -> a
negate Scientific
sci))
  where
    parseE :: Integer -> Int -> Parser Scientific
parseE !Integer
c !Int
e = do
        Maybe Word8
me <- Parser (Maybe Word8)
P.peekMaybe
        Int
e' <- case Maybe Word8
me of
            Just Word8
ec | Word8
ec forall a. Eq a => a -> a -> Bool
== Word8
LETTER_e Bool -> Bool -> Bool
|| Word8
ec forall a. Eq a => a -> a -> Bool
== Word8
LETTER_E -> Parser ()
P.skipWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (Integral a, Bounded a) => Parser a
int
            Maybe Word8
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Scientific
Sci.scientific Integer
c (Int
e' forall a. Num a => a -> a -> a
- Int
e)

foreign import ccall unsafe compute_float_64 :: Int64   -- ^ power of 10
                                             -> Word64  -- ^ base
                                             -> Word8   -- ^ negative
                                             -> MBA# Word8      -- ^ success?
                                             -> IO Double       -- ^ result