{-|
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
  , floatToScientific
  , doubleToScientific
  ) where

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import           Data.Int
import qualified Data.Scientific          as Sci
import           Data.Word
import           Z.Data.ASCII
import qualified Z.Data.Builder.Numeric as B
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

#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
{-# INLINE hex #-}
hex :: Parser a
hex = Text
"Z.Data.Parser.Numeric.hex" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> do
    Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isHexDigit
    if Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
2
    then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Bytes -> a
forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 Bytes
bs)
    else Text -> Parser a
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
{-# INLINE hex' #-}
hex' :: Parser a
hex' = Text
"Z.Data.Parser.Numeric.hex'" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> do
    a -> Bytes -> a
forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 (Bytes -> a) -> Parser Bytes -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Word8 -> Bool) -> Int -> Parser Bytes
P.takeN Word8 -> Bool
isHexDigit (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
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
{-# INLINE hex_ #-}
hex_ :: Parser a
hex_ = Text
"Z.Data.Parser.Numeric.hex_" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> a -> Bytes -> a
forall a. (Integral a, Bits a) => a -> Bytes -> a
hexLoop a
0 (Bytes -> a) -> Parser Bytes -> Parser a
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 :: a -> Bytes -> a
hexLoop = (a -> Word8 -> a) -> a -> Bytes -> a
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 a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
4 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a
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 :: Word8 -> a
w2iHex Word8
w
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57   = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
70   = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w a -> a -> a
forall a. Num a => a -> a -> a
- a
55
    | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
102  = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w a -> a -> a
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
{-# INLINE uint_ #-}
uint_ :: Parser a
uint_ = Text
"Z.Data.Parser.Numeric.uint_" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> a -> Bytes -> a
forall a. Integral a => a -> Bytes -> a
decLoop a
0 (Bytes -> a) -> Parser Bytes -> Parser a
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
{-# INLINE uint #-}
uint :: Parser a
uint = Text
"Z.Data.Parser.Numeric.uint" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> do
    Bytes
bs <- (Word8 -> Bool) -> Parser Bytes
P.takeWhile1 Word8 -> Bool
isDigit
    if Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
    then do
        let w64 :: Word64
w64 = Word64 -> Bytes -> Word64
forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
bs
        if Word64
w64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)
        then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64)
        else Text -> Parser a
forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
    else do
        let w64 :: Integer
w64 = Integer -> Bytes -> Integer
forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs
        if Integer
w64 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)
        then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w64)
        else Text -> Parser a
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 :: a -> Bytes -> a
decLoop = (a -> Word8 -> a) -> a -> Bytes -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' a -> Word8 -> a
forall a. Integral a => a -> Word8 -> a
step
  where step :: a -> Word8 -> a
step a
a Word8
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> 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 :: Word8 -> a
w2iDec Word8
w = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w a -> a -> a
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
    | Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN = fromIntegral (decLoop @Word64 0 bs)
    | Bool
otherwise                            = Integer -> Bytes -> Integer
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
digit :: Parser Int
digit = do
    Word8
d <- (Word8 -> Bool) -> Parser Word8
P.satisfy Word8 -> Bool
isDigit
    Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$! Word8 -> Int
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
{-# INLINE int #-}
int :: Parser a
int = Text
"Z.Data.Parser.Numeric.int" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
loopNe
    else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 Parser () -> Parser a -> Parser a
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 Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
        then do
            let w64 :: Word64
w64 = Word64 -> Bytes -> Word64
forall a. Integral a => a -> Bytes -> a
decLoop @Word64 Word64
0 Bytes
bs
            if Word64
w64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)
            then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64)
            else Text -> Parser a
forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
        else do
            let w64 :: Integer
w64 = Integer -> Bytes -> Integer
forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs
            if Integer
w64 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)
            then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w64)
            else Text -> Parser a
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 Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= INT64_SAFE_DIGITS_LEN
        then do
            let i64 :: Int64
i64 = Int64 -> Int64
forall a. Num a => a -> a
negate (Int64 -> Bytes -> Int64
forall a. Integral a => a -> Bytes -> a
decLoop @Int64 Int64
0 Bytes
bs)
            if Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a)
            then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i64)
            else Text -> Parser a
forall a. Text -> Parser a
P.fail' Text
"decimal numeric value overflow"
        else do
            let i64 :: Integer
i64 = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Bytes -> Integer
forall a. Integral a => a -> Bytes -> a
decLoop @Integer Integer
0 Bytes
bs)
            if Integer
i64 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a)
            then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i64)
            else Text -> Parser a
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
{-# INLINE int_ #-}
int_ :: Parser a
int_ = Text
"Z.Data.Parser.Numeric.int_" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a
forall a. Num a => a -> a
negate (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
loop)
    else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
loop else Parser a
loop
  where
    loop :: Parser a
loop = a -> Bytes -> a
forall a. Integral a => a -> Bytes -> a
decLoop a
0 (Bytes -> a) -> Parser Bytes -> Parser a
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
{-# INLINE integer #-}
integer :: Parser Integer
integer =  Text
"Z.Data.Parser.Numeric.integer" Text -> Parser Integer -> Parser Integer
forall a. Text -> Parser a -> Parser a
<?> do
    Word8
w <- Parser Word8
P.peek
    if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MINUS
    then Parser ()
P.skipWord8 Parser () -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
integer')
    else if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PLUS then Parser ()
P.skipWord8 Parser () -> Parser Integer -> Parser Integer
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 (Bytes -> Integer) -> Parser Bytes -> Parser Integer
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
{-# INLINE rational #-}
rational :: Parser a
rational = Text
"Z.Data.Parser.Numeric.rational" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> a) -> Parser a
forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> a
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
{-# INLINE double #-}
double :: Parser Double
double = Text
"Z.Data.Parser.Numeric.double" Text -> Parser Double -> Parser Double
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Double) -> Parser Double
forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> Double
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat

-- | Parse a rational number and round to 'Float'.
--
-- Single precision version of 'double'.
float :: Parser Float
{-# INLINE float #-}
float :: Parser Float
float = Text
"Z.Data.Parser.Numeric.float" Text -> Parser Float -> Parser Float
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Float) -> Parser Float
forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> Float
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
{-# INLINE scientific #-}
scientific :: Parser Scientific
scientific = Text
"Z.Data.Parser.Numeric.scientific" Text -> Parser Scientific -> Parser Scientific
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Scientific) -> Parser Scientific
forall a. (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> Scientific
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
{-# INLINE scientifically #-}
scientifically :: (Scientific -> a) -> Parser a
scientifically Scientific -> a
h = Text
"Z.Data.Parser.Numeric.scientifically" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> 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 :: (Scientific -> a) -> Parser a
scientificallyInternal Scientific -> a
h = do
    !Word8
sign <- Parser Word8
P.peek
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
PLUS Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
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 Parser () -> Parser Bytes -> Parser Bytes
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 = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart
            !flen :: Int
flen = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
fracPart
            !base :: Integer
base =
                if Int
ilen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
flen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
                then Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Bytes -> Word64
forall a. Integral a => a -> Bytes -> a
decLoop @Word64 (Word64 -> Bytes -> 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 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
flen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
f
        Integer -> Int -> Parser Scientific
parseE Integer
base Int
flen) Parser Scientific -> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Int -> Parser Scientific
parseE (Bytes -> Integer
decLoopIntegerFast Bytes
intPart) Int
0)

    a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$! if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
MINUS then Scientific -> a
h Scientific
sci else Scientific -> a
h (Scientific -> Scientific
forall a. Num a => a -> a
negate Scientific
sci)
  where
    {-# INLINE parseE #-}
    parseE :: Integer -> Int -> Parser Scientific
parseE Integer
c Int
e =
        (do Word8
_ <- (Word8 -> Bool) -> Parser Word8
P.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==  Word8
LETTER_e Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_E)
            Integer -> Int -> Scientific
Sci.scientific Integer
c (Int -> Scientific) -> (Int -> Int) -> Int -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
e (Int -> Scientific) -> Parser Int -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
forall a. (Integral a, Bounded a) => Parser a
int) Parser Scientific -> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> Scientific
Sci.scientific Integer
c (Int -> Int
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
{-# INLINE rational' #-}
rational' :: Parser a
rational' = Text
"Z.Data.Parser.Numeric.rational'" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> a) -> Parser a
forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> a
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
{-# INLINE double' #-}
double' :: Parser Double
double' = Text
"Z.Data.Parser.Numeric.double'" Text -> Parser Double -> Parser Double
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Double) -> Parser Double
forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> Double
forall a. RealFloat a => Scientific -> a
Sci.toRealFloat

-- | Parse a rational number and round to 'Float' using stricter grammer.
--
-- Single precision version of 'double''.
float' :: Parser Float
{-# INLINE float' #-}
float' :: Parser Float
float' = Text
"Z.Data.Parser.Numeric.float'" Text -> Parser Float -> Parser Float
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Float) -> Parser Float
forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> Float
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
{-# INLINE scientific' #-}
scientific' :: Parser Scientific
scientific' = Text
"Z.Data.Parser.Numeric.scientific'" Text -> Parser Scientific -> Parser Scientific
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> Scientific) -> Parser Scientific
forall a. (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> Scientific
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
{-# INLINE scientifically' #-}
scientifically' :: (Scientific -> a) -> Parser a
scientifically' Scientific -> a
h = Text
"Z.Data.Parser.Numeric.scientifically'" Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
<?> (Scientific -> 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' :: (Scientific -> a) -> Parser a
scientificallyInternal' Scientific -> a
h = do
    !Word8
sign <- Parser Word8
P.peek
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
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
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bytes -> Word8
forall (v :: * -> *) a. (Vec v a, HasCallStack) => v a -> a
V.head Bytes
intPart Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
DIGIT_0) (Text -> Parser ()
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 Parser () -> Parser Bytes -> Parser Bytes
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 = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
intPart
                !flen :: Int
flen = Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
fracPart
                !base :: Integer
base =
                    if Int
ilen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
flen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WORD64_SAFE_DIGITS_LEN
                    then Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Bytes -> Word64
forall a. Integral a => a -> Bytes -> a
decLoop @Word64 (Word64 -> Bytes -> 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 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
flen Integer -> Integer -> Integer
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
    a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$! if Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
MINUS then Scientific -> a
h Scientific
sci else Scientific -> a
h (Scientific -> Scientific
forall a. Num a => a -> a
negate Scientific
sci)
  where
    {-# INLINE parseE #-}
    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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_e Bool -> Bool -> Bool
|| Word8
ec Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
LETTER_E -> Parser ()
P.skipWord8 Parser () -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int
forall a. (Integral a, Bounded a) => Parser a
int
            Maybe Word8
_ -> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
        Scientific -> Parser Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Parser Scientific)
-> Scientific -> Parser Scientific
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Scientific
Sci.scientific Integer
c (Int
e' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e)

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

floatToScientific :: Float -> Sci.Scientific
{-# INLINE floatToScientific #-}
floatToScientific :: Float -> Scientific
floatToScientific Float
rf | Float
rf Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0    = -(([Int], Int) -> Scientific
fromFloatingDigits (Float -> ([Int], Int)
B.grisu3_sp (-Float
rf)))
                     | Float
rf Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0   = Scientific
0
                     | Bool
otherwise = ([Int], Int) -> Scientific
fromFloatingDigits (Float -> ([Int], Int)
B.grisu3_sp Float
rf)

doubleToScientific :: Double -> Sci.Scientific
{-# INLINE doubleToScientific #-}
doubleToScientific :: Double -> Scientific
doubleToScientific Double
rf | Double
rf Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0    = -(([Int], Int) -> Scientific
fromFloatingDigits (Double -> ([Int], Int)
B.grisu3 (-Double
rf)))
                      | Double
rf Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0   = Scientific
0
                      | Bool
otherwise = ([Int], Int) -> Scientific
fromFloatingDigits (Double -> ([Int], Int)
B.grisu3 Double
rf)

fromFloatingDigits :: ([Int], Int) -> Sci.Scientific
{-# INLINE fromFloatingDigits #-}
fromFloatingDigits :: ([Int], Int) -> Scientific
fromFloatingDigits ([Int]
digits, Int
e) = [Int] -> Int64 -> Int -> Scientific
go [Int]
digits Int64
0 Int
0
  where
    -- There's no way a float or double has more digits a 'Int64' can't handle
    go :: [Int] -> Int64 -> Int -> Sci.Scientific
    go :: [Int] -> Int64 -> Int -> Scientific
go []     !Int64
c !Int
n = Integer -> Int -> Scientific
Sci.scientific (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
c) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
    go (Int
d:[Int]
ds) !Int64
c !Int
n = [Int] -> Int64 -> Int -> Scientific
go [Int]
ds (Int64
c Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)