{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Unicode.Parser
-- Copyright   : (c) 2021 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- To parse a text input, use the decode routines from
-- "Streamly.Unicode.Stream" module to convert an input byte stream to a
-- Unicode Char stream and then use these parsers on the Char stream.

module Streamly.Internal.Unicode.Parser
    (
    -- * Setup
    -- | To execute the code examples provided in this module in ghci, please
    -- run the following commands first.
    --
    -- $setup

    -- * Generic
      char
    , charIgnoreCase

    -- * Sequences
    , string
    , stringIgnoreCase
    , dropSpace
    , dropSpace1

    -- * Classes
    , alpha
    , alphaNum
    , letter
    , ascii
    , asciiLower
    , asciiUpper
    , latin1
    , lower
    , upper
    , mark
    , printable
    , punctuation
    , separator
    , space
    , symbol

    -- digits
    , digit
    , octDigit
    , hexDigit
    , numeric

    -- * Numeric
    , signed
    , number
    , doubleParser
    , double
    , decimal
    , hexadecimal

    -- * Utilities
    , mkDouble
    )
where

import Control.Applicative (Alternative(..))
import Data.Bits (Bits, (.|.), shiftL, (.&.))
import Data.Char (ord)
import Data.Ratio ((%))
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Parser (Parser(..), Initial(..),  Step(..))

import qualified Data.Char as Char
import qualified Streamly.Data.Fold as Fold
import qualified Streamly.Internal.Data.Parser as Parser
    (
      lmap
    , satisfy
    , listEq
    , takeWhile1
    , dropWhile
    )

#include "DocTestUnicodeParser.hs"

--------------------------------------------------------------------------------
-- Character classification
--------------------------------------------------------------------------------

-- XXX It may be possible to implement faster predicates for ASCII byte stream.
-- We can measure if there is a signficant difference and if so we can add such
-- predicates to Streamly.Unicode.Parser.Latin1.
--
#define CHAR_PARSER_SIG(NAME)         NAME :: Monad m => Parser Char m Char
-- XXX Need to use the predicates from Unicode.Char module/unicode-data package
#define CHAR_PARSER(NAME, PREDICATE)  NAME = Parser.satisfy Char.PREDICATE
#define CHAR_PARSER_DOC(PREDICATE) -- | Match any character that satisfies 'Char.PREDICATE'
#define CHAR_PARSER_INLINE(NAME)      {-# INLINE NAME #-}

CHAR_PARSER_DOC(isSpace)
CHAR_PARSER_INLINE(space)
CHAR_PARSER_SIG(space)
CHAR_PARSER(space,isSpace)

CHAR_PARSER_DOC(isLower)
CHAR_PARSER_INLINE(lower)
CHAR_PARSER_SIG(lower)
CHAR_PARSER(lower,isLower)

CHAR_PARSER_DOC(isUpper)
CHAR_PARSER_INLINE(upper)
CHAR_PARSER_SIG(upper)
CHAR_PARSER(upper,isUpper)

CHAR_PARSER_DOC(isAlpha)
CHAR_PARSER_INLINE(alpha)
CHAR_PARSER_SIG(alpha)
CHAR_PARSER(alpha,isAlpha)

CHAR_PARSER_DOC(isAlphaNum)
CHAR_PARSER_INLINE(alphaNum)
CHAR_PARSER_SIG(alphaNum)
CHAR_PARSER(alphaNum,isAlphaNum)

CHAR_PARSER_DOC(isPrint)
CHAR_PARSER_INLINE(printable)
CHAR_PARSER_SIG(printable)
CHAR_PARSER(printable,isPrint)

CHAR_PARSER_DOC(isDigit)
CHAR_PARSER_INLINE(digit)
CHAR_PARSER_SIG(digit)
CHAR_PARSER(digit,isDigit)

CHAR_PARSER_DOC(isOctDigit)
CHAR_PARSER_INLINE(octDigit)
CHAR_PARSER_SIG(octDigit)
CHAR_PARSER(octDigit,isOctDigit)

CHAR_PARSER_DOC(isHexDigit)
CHAR_PARSER_INLINE(hexDigit)
CHAR_PARSER_SIG(hexDigit)
CHAR_PARSER(hexDigit,isHexDigit)

CHAR_PARSER_DOC(isLetter)
CHAR_PARSER_INLINE(letter)
CHAR_PARSER_SIG(letter)
CHAR_PARSER(letter,isLetter)

CHAR_PARSER_DOC(isMark)
CHAR_PARSER_INLINE(mark)
CHAR_PARSER_SIG(mark)
CHAR_PARSER(mark,isMark)

CHAR_PARSER_DOC(isNumber)
CHAR_PARSER_INLINE(numeric)
CHAR_PARSER_SIG(numeric)
CHAR_PARSER(numeric,isNumber)

CHAR_PARSER_DOC(isPunctuation)
CHAR_PARSER_INLINE(punctuation)
CHAR_PARSER_SIG(punctuation)
punctuation :: forall (m :: * -> *). Monad m => Parser Char m Char
CHAR_PARSER(punctuation,isPunctuation)

CHAR_PARSER_DOC(isSymbol)
CHAR_PARSER_INLINE(symbol)
CHAR_PARSER_SIG(symbol)
CHAR_PARSER(symbol,isSymbol)

CHAR_PARSER_DOC(isSeparator)
CHAR_PARSER_INLINE(separator)
CHAR_PARSER_SIG(separator)
CHAR_PARSER(separator,isSeparator)

CHAR_PARSER_DOC(isAscii)
CHAR_PARSER_INLINE(ascii)
CHAR_PARSER_SIG(ascii)
CHAR_PARSER(ascii,isAscii)

CHAR_PARSER_DOC(isLatin1)
CHAR_PARSER_INLINE(latin1)
CHAR_PARSER_SIG(latin1)
CHAR_PARSER(latin1,isLatin1)

CHAR_PARSER_DOC(isAsciiUpper)
CHAR_PARSER_INLINE(asciiUpper)
CHAR_PARSER_SIG(asciiUpper)
CHAR_PARSER(asciiUpper,isAsciiUpper)

CHAR_PARSER_DOC(isAsciiLower)
CHAR_PARSER_INLINE(asciiLower)
CHAR_PARSER_SIG(asciiLower)
CHAR_PARSER(asciiLower,isAsciiLower)

--------------------------------------------------------------------------------
-- Character parsers
--------------------------------------------------------------------------------

-- | Match a specific character.
{-# INLINE char #-}
char :: Monad m => Char -> Parser Char m Char
char :: forall (m :: * -> *). Monad m => Char -> Parser Char m Char
char Char
c = (Char -> Bool) -> Parser Char m Char
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
Parser.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

-- XXX Case conversion may lead to change in number of chars
-- | Match a specific character ignoring case.
{-# INLINE charIgnoreCase #-}
charIgnoreCase :: Monad m => Char -> Parser Char m Char
charIgnoreCase :: forall (m :: * -> *). Monad m => Char -> Parser Char m Char
charIgnoreCase Char
c = (Char -> Char) -> Parser Char m Char -> Parser Char m Char
forall a b (m :: * -> *) r.
(a -> b) -> Parser b m r -> Parser a m r
Parser.lmap Char -> Char
Char.toLower ((Char -> Bool) -> Parser Char m Char
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m a
Parser.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
Char.toLower Char
c))

--------------------------------------------------------------------------------
-- Character sequences
--------------------------------------------------------------------------------

-- | Match the input with the supplied string and return it if successful.
string :: Monad m => String -> Parser Char m String
string :: forall (m :: * -> *). Monad m => String -> Parser Char m String
string = String -> Parser Char m String
forall (m :: * -> *) a. (Monad m, Eq a) => [a] -> Parser a m [a]
Parser.listEq

-- XXX Not accurate unicode case conversion
-- | Match the input with the supplied string and return it if successful.
stringIgnoreCase :: Monad m => String -> Parser Char m String
stringIgnoreCase :: forall (m :: * -> *). Monad m => String -> Parser Char m String
stringIgnoreCase String
s =
    (Char -> Char) -> Parser Char m String -> Parser Char m String
forall a b (m :: * -> *) r.
(a -> b) -> Parser b m r -> Parser a m r
Parser.lmap Char -> Char
Char.toLower (String -> Parser Char m String
forall (m :: * -> *) a. (Monad m, Eq a) => [a] -> Parser a m [a]
Parser.listEq ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower String
s))

-- | Drop /zero/ or more white space characters.
dropSpace :: Monad m => Parser Char m ()
dropSpace :: forall (m :: * -> *). Monad m => Parser Char m ()
dropSpace = (Char -> Bool) -> Parser Char m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Parser a m ()
Parser.dropWhile Char -> Bool
Char.isSpace

-- | Drop /one/ or more white space characters.
dropSpace1 :: Monad m => Parser Char m ()
dropSpace1 :: forall (m :: * -> *). Monad m => Parser Char m ()
dropSpace1 = (Char -> Bool) -> Fold m Char () -> Parser Char m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
Parser.takeWhile1 Char -> Bool
Char.isSpace Fold m Char ()
forall (m :: * -> *) a. Monad m => Fold m a ()
Fold.drain

--------------------------------------------------------------------------------
-- Numeric parsers
--------------------------------------------------------------------------------

-- XXX It should fail if the number is larger than the size of the type.
--
-- | Parse and decode an unsigned integral decimal number.
{-# INLINE decimal #-}
decimal :: (Monad m, Integral a) => Parser Char m a
decimal :: forall (m :: * -> *) a. (Monad m, Integral a) => Parser Char m a
decimal = (Char -> Bool) -> Fold m Char a -> Parser Char m a
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
Parser.takeWhile1 Char -> Bool
Char.isDigit ((a -> Char -> a) -> a -> Fold m Char a
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
Fold.foldl' a -> Char -> a
forall {a}. Num a => a -> Char -> a
step a
0)

    where

    step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48)

-- | Parse and decode an unsigned integral hexadecimal number.  The hex digits
-- @\'a\'@ through @\'f\'@ may be upper or lower case.
--
-- Note: This parser does not accept a leading @\"0x\"@ string.
{-# INLINE hexadecimal #-}
hexadecimal :: (Monad m, Integral a, Bits a) => Parser Char m a
hexadecimal :: forall (m :: * -> *) a.
(Monad m, Integral a, Bits a) =>
Parser Char m a
hexadecimal = (Char -> Bool) -> Fold m Char a -> Parser Char m a
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Parser a m b
Parser.takeWhile1 Char -> Bool
isHexDigit ((a -> Char -> a) -> a -> Fold m Char a
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
Fold.foldl' a -> Char -> a
forall {a}. (Bits a, Num a) => a -> Char -> a
step a
0)

    where

    isHexDigit :: Char -> Bool
isHexDigit Char
c =
           (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
        Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')
        Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')

    step :: a -> Char -> a
step a
a Char
c
        | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
48 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
57 =
            (a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48)
        | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
97 =
            (a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
87)
        | Bool
otherwise =
            (a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
55)

        where

        w :: Int
w = Char -> Int
ord Char
c

-- | Allow an optional leading @\'+\'@ or @\'-\'@ sign character before any
-- parser.
{-# INLINE signed #-}
signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a
signed :: forall a (m :: * -> *).
(Num a, Monad m) =>
Parser Char m a -> Parser Char m a
signed Parser Char m a
p = (a -> a
forall a. Num a => a -> a
negate (a -> a) -> Parser Char m a -> Parser Char m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char m Char
forall (m :: * -> *). Monad m => Char -> Parser Char m Char
char Char
'-' Parser Char m Char -> Parser Char m a -> Parser Char m a
forall a b. Parser Char m a -> Parser Char m b -> Parser Char m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char m a
p)) Parser Char m a -> Parser Char m a -> Parser Char m a
forall a. Parser Char m a -> Parser Char m a -> Parser Char m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char m Char
forall (m :: * -> *). Monad m => Char -> Parser Char m Char
char Char
'+' Parser Char m Char -> Parser Char m a -> Parser Char m a
forall a b. Parser Char m a -> Parser Char m b -> Parser Char m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char m a
p) Parser Char m a -> Parser Char m a -> Parser Char m a
forall a. Parser Char m a -> Parser Char m a -> Parser Char m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char m a
p

-- XXX Change Multiplier to Sign
type Multiplier = Int

-- XXX We can use Int instead of Integer to make it twice as fast. But then we
-- will have to truncate the significant digits before overflow occurs.
type Number = Integer
type DecimalPlaces = Int
type PowerMultiplier = Int
type Power = Int

{-# ANN type ScientificParseState Fuse #-}
data ScientificParseState
  = SPInitial
  | SPSign !Multiplier
  | SPAfterSign !Multiplier !Number
  | SPDot !Multiplier !Number
  | SPAfterDot !Multiplier !Number !DecimalPlaces
  | SPExponent !Multiplier !Number !DecimalPlaces
  | SPExponentWithSign !Multiplier !Number !DecimalPlaces !PowerMultiplier
  | SPAfterExponent !Multiplier !Number !DecimalPlaces !PowerMultiplier !Power

-- XXX See https://hackage.haskell.org/package/integer-conversion for large
-- integers.

-- | A generic parser for scientific notation of numbers. Returns (mantissa,
-- exponent) tuple. The result can be mapped to 'Double' or any other number
-- representation e.g. @Scientific@.
--
-- For example, using the @scientific@ package:
-- >> parserScientific = uncurry Data.Scientific.scientific <$> 'number'
{-# INLINE number #-}
number :: Monad m => Parser Char m (Integer, Int)
number :: forall (m :: * -> *). Monad m => Parser Char m (Integer, Int)
number =  (ScientificParseState
 -> Char -> m (Step ScientificParseState (Integer, Int)))
-> m (Initial ScientificParseState (Integer, Int))
-> (ScientificParseState
    -> m (Step ScientificParseState (Integer, Int)))
-> Parser Char m (Integer, Int)
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser (\ScientificParseState
s Char
a -> Step ScientificParseState (Integer, Int)
-> m (Step ScientificParseState (Integer, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ScientificParseState (Integer, Int)
 -> m (Step ScientificParseState (Integer, Int)))
-> Step ScientificParseState (Integer, Int)
-> m (Step ScientificParseState (Integer, Int))
forall a b. (a -> b) -> a -> b
$ ScientificParseState
-> Char -> Step ScientificParseState (Integer, Int)
step ScientificParseState
s Char
a) m (Initial ScientificParseState (Integer, Int))
forall {b}. m (Initial ScientificParseState b)
initial (Step ScientificParseState (Integer, Int)
-> m (Step ScientificParseState (Integer, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step ScientificParseState (Integer, Int)
 -> m (Step ScientificParseState (Integer, Int)))
-> (ScientificParseState
    -> Step ScientificParseState (Integer, Int))
-> ScientificParseState
-> m (Step ScientificParseState (Integer, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScientificParseState -> Step ScientificParseState (Integer, Int)
forall {s}. ScientificParseState -> Step s (Integer, Int)
extract)

    where

    intToInteger :: Int -> Integer
    intToInteger :: Int -> Integer
intToInteger = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    combineNum :: a -> a -> a
combineNum a
buf a
num = a
buf a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
num

    {-# INLINE initial #-}
    initial :: m (Initial ScientificParseState b)
initial = Initial ScientificParseState b
-> m (Initial ScientificParseState b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Initial ScientificParseState b
 -> m (Initial ScientificParseState b))
-> Initial ScientificParseState b
-> m (Initial ScientificParseState b)
forall a b. (a -> b) -> a -> b
$ ScientificParseState -> Initial ScientificParseState b
forall s b. s -> Initial s b
IPartial ScientificParseState
SPInitial

    exitSPInitial :: String -> String
exitSPInitial String
msg =
        String
"number: expecting sign or decimal digit, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    exitSPSign :: String -> String
exitSPSign String
msg =
        String
"number: expecting decimal digit, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    exitSPAfterSign :: Int -> Integer -> (Integer, b)
exitSPAfterSign Int
multiplier Integer
num = (Int -> Integer
intToInteger Int
multiplier Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
num, b
0)
    exitSPAfterDot :: Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
multiplier Integer
num b
decimalPlaces =
        ( Int -> Integer
intToInteger Int
multiplier Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
num
        , -b
decimalPlaces
        )
    exitSPAfterExponent :: Int -> Integer -> b -> b -> b -> (Integer, b)
exitSPAfterExponent Int
mult Integer
num b
decimalPlaces b
powerMult b
powerNum =
        let e :: b
e = b
powerMult b -> b -> b
forall a. Num a => a -> a -> a
* b
powerNum b -> b -> b
forall a. Num a => a -> a -> a
- b
decimalPlaces
         in (Int -> Integer
intToInteger Int
mult Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
num, b
e)

    {-# INLINE step #-}
    step :: ScientificParseState
-> Char -> Step ScientificParseState (Integer, Int)
step ScientificParseState
SPInitial Char
val =
        case Char
val of
          Char
'+' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> ScientificParseState
SPSign Int
1)
          Char
'-' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ (Int -> ScientificParseState
SPSign (-Int
1))
          Char
_ -> do
              let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
              if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
              then Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ScientificParseState
SPAfterSign Int
1 (Int -> Integer
intToInteger Int
num)
              else String -> Step ScientificParseState (Integer, Int)
forall s b. String -> Step s b
Error (String -> Step ScientificParseState (Integer, Int))
-> String -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitSPInitial (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
val
    step (SPSign Int
multiplier) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ScientificParseState
SPAfterSign Int
multiplier (Int -> Integer
intToInteger Int
num)
            else String -> Step ScientificParseState (Integer, Int)
forall s b. String -> Step s b
Error (String -> Step ScientificParseState (Integer, Int))
-> String -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitSPSign (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
val
    step (SPAfterSign Int
multiplier Integer
buf) Char
val =
        case Char
val of
            Char
'.' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ScientificParseState
SPDot Int
multiplier Integer
buf
            Char
'e' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPExponent Int
multiplier Integer
buf Int
0
            Char
'E' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPExponent Int
multiplier Integer
buf Int
0
            Char
_ ->
                let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
                 in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
                    then
                        Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0
                            (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ScientificParseState
SPAfterSign Int
multiplier (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
combineNum Integer
buf (Int -> Integer
intToInteger Int
num))
                    else Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> (Integer, b)
exitSPAfterSign Int
multiplier Integer
buf
    step (SPDot Int
multiplier Integer
buf) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPAfterDot Int
multiplier (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
combineNum Integer
buf (Int -> Integer
intToInteger Int
num)) Int
1
            else Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> (Integer, b)
exitSPAfterSign Int
multiplier Integer
buf
    step (SPAfterDot Int
multiplier Integer
buf Int
decimalPlaces) Char
val =
        case Char
val of
            Char
'e' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPExponent Int
multiplier Integer
buf Int
decimalPlaces
            Char
'E' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPExponent Int
multiplier Integer
buf Int
decimalPlaces
            Char
_ ->
                let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
                 in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
                    then
                        Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0
                            (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> ScientificParseState
SPAfterDot
                                  Int
multiplier
                                  (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
combineNum Integer
buf (Int -> Integer
intToInteger Int
num))
                                  (Int
decimalPlaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    else Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
multiplier Integer
buf Int
decimalPlaces
    step (SPExponent Int
multiplier Integer
buf Int
decimalPlaces) Char
val =
        case Char
val of
          Char
'+' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> Integer -> Int -> Int -> ScientificParseState
SPExponentWithSign Int
multiplier Integer
buf Int
decimalPlaces Int
1)
          Char
'-' -> Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> Integer -> Int -> Int -> ScientificParseState
SPExponentWithSign Int
multiplier Integer
buf Int
decimalPlaces (-Int
1))
          Char
_ -> do
              let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
              if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
              then Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> Int -> Int -> ScientificParseState
SPAfterExponent Int
multiplier Integer
buf Int
decimalPlaces Int
1 Int
num
              else Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
multiplier Integer
buf Int
decimalPlaces
    step (SPExponentWithSign Int
mult Integer
buf Int
decimalPlaces Int
powerMult) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> Int -> Int -> ScientificParseState
SPAfterExponent Int
mult Integer
buf Int
decimalPlaces Int
powerMult Int
num
            else Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
3 ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
mult Integer
buf Int
decimalPlaces
    step (SPAfterExponent Int
mult Integer
num Int
decimalPlaces Int
powerMult Int
buf) Char
val =
        let n :: Int
n = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then
                Int
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall s b. Int -> s -> Step s b
Partial Int
0
                    (ScientificParseState -> Step ScientificParseState (Integer, Int))
-> ScientificParseState -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> Int -> Int -> ScientificParseState
SPAfterExponent
                          Int
mult Integer
num Int
decimalPlaces Int
powerMult (Int -> Int -> Int
forall a. Num a => a -> a -> a
combineNum Int
buf Int
n)
            else
                Int -> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
1
                    ((Integer, Int) -> Step ScientificParseState (Integer, Int))
-> (Integer, Int) -> Step ScientificParseState (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> Int -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> b -> b -> (Integer, b)
exitSPAfterExponent Int
mult Integer
num Int
decimalPlaces Int
powerMult Int
buf

    {-# INLINE extract #-}
    extract :: ScientificParseState -> Step s (Integer, Int)
extract ScientificParseState
SPInitial = String -> Step s (Integer, Int)
forall s b. String -> Step s b
Error (String -> Step s (Integer, Int))
-> String -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitSPInitial String
"end of input"
    extract (SPSign Int
_) = String -> Step s (Integer, Int)
forall s b. String -> Step s b
Error (String -> Step s (Integer, Int))
-> String -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitSPSign String
"end of input"
    extract (SPAfterSign Int
mult Integer
num) = Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> (Integer, b)
exitSPAfterSign Int
mult Integer
num
    extract (SPDot Int
mult Integer
num) = Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> (Integer, b)
exitSPAfterSign Int
mult Integer
num
    extract (SPAfterDot Int
mult Integer
num Int
decimalPlaces) =
        Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
mult Integer
num Int
decimalPlaces
    extract (SPExponent Int
mult Integer
num Int
decimalPlaces) =
        Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
mult Integer
num Int
decimalPlaces
    extract (SPExponentWithSign Int
mult Integer
num Int
decimalPlaces Int
_) =
        Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> (Integer, b)
exitSPAfterDot Int
mult Integer
num Int
decimalPlaces
    extract (SPAfterExponent Int
mult Integer
num Int
decimalPlaces Int
powerMult Int
powerNum) =
        Int -> (Integer, Int) -> Step s (Integer, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Integer, Int) -> Step s (Integer, Int))
-> (Integer, Int) -> Step s (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Int -> Int -> Int -> (Integer, Int)
forall {b}. Num b => Int -> Integer -> b -> b -> b -> (Integer, b)
exitSPAfterExponent Int
mult Integer
num Int
decimalPlaces Int
powerMult Int
powerNum

type MantissaInt = Int
type OverflowPower = Int

{-# ANN type DoubleParseState Fuse #-}
data DoubleParseState
  = DPInitial
  | DPSign !Multiplier
  | DPAfterSign !Multiplier !MantissaInt !OverflowPower
  | DPDot !Multiplier !MantissaInt !OverflowPower
  | DPAfterDot !Multiplier !MantissaInt !OverflowPower
  | DPExponent !Multiplier !MantissaInt !OverflowPower
  | DPExponentWithSign !Multiplier !MantissaInt !OverflowPower !PowerMultiplier
  | DPAfterExponent !Multiplier !MantissaInt !OverflowPower !PowerMultiplier !Power

-- | A fast, custom parser for double precision flaoting point numbers. Returns
-- (mantissa, exponent) tuple. This is much faster than 'number' because it
-- assumes the number will fit in a 'Double' type and uses 'Int' representation
-- to store mantissa.
--
-- Number larger than 'Double' may overflow. Int overflow is not checked in the
-- exponent.
--
{-# INLINE doubleParser #-}
doubleParser :: Monad m => Parser Char m (Int, Int)
doubleParser :: forall (m :: * -> *). Monad m => Parser Char m (Int, Int)
doubleParser =  (DoubleParseState -> Char -> m (Step DoubleParseState (Int, Int)))
-> m (Initial DoubleParseState (Int, Int))
-> (DoubleParseState -> m (Step DoubleParseState (Int, Int)))
-> Parser Char m (Int, Int)
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser (\DoubleParseState
s Char
a -> Step DoubleParseState (Int, Int)
-> m (Step DoubleParseState (Int, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step DoubleParseState (Int, Int)
 -> m (Step DoubleParseState (Int, Int)))
-> Step DoubleParseState (Int, Int)
-> m (Step DoubleParseState (Int, Int))
forall a b. (a -> b) -> a -> b
$ DoubleParseState -> Char -> Step DoubleParseState (Int, Int)
step DoubleParseState
s Char
a) m (Initial DoubleParseState (Int, Int))
forall {b}. m (Initial DoubleParseState b)
initial (Step DoubleParseState (Int, Int)
-> m (Step DoubleParseState (Int, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step DoubleParseState (Int, Int)
 -> m (Step DoubleParseState (Int, Int)))
-> (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState
-> m (Step DoubleParseState (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleParseState -> Step DoubleParseState (Int, Int)
forall {s}. DoubleParseState -> Step s (Int, Int)
extract)

    where

    -- XXX Assuming Int = Int64

    -- Up to 58 bits Int won't overflow
    -- ghci> (2^59-1)*10+9 :: Int
    -- 5764607523034234879
    mask :: Word
    mask :: Word
mask = Word
0x7c00000000000000 -- 58 bits, ignore the sign bit

    {-# INLINE combineNum #-}
    combineNum :: Int -> Int -> Int -> (Int, Int)
    combineNum :: Int -> Int -> Int -> (Int, Int)
combineNum Int
mantissa Int
power Int
num =
         if Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mantissa Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
mask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
         then (Int
mantissa Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num, Int
power)
         else (Int
mantissa, Int
power Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    {-# INLINE initial #-}
    initial :: m (Initial DoubleParseState b)
initial = Initial DoubleParseState b -> m (Initial DoubleParseState b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Initial DoubleParseState b -> m (Initial DoubleParseState b))
-> Initial DoubleParseState b -> m (Initial DoubleParseState b)
forall a b. (a -> b) -> a -> b
$ DoubleParseState -> Initial DoubleParseState b
forall s b. s -> Initial s b
IPartial DoubleParseState
DPInitial

    exitDPInitial :: String -> String
exitDPInitial String
msg =
        String
"number: expecting sign or decimal digit, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    exitDPSign :: String -> String
exitDPSign String
msg =
        String
"number: expecting decimal digit, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
    exitDPAfterSign :: a -> a -> b -> (a, b)
exitDPAfterSign a
multiplier a
num b
opower = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
multiplier a -> a -> a
forall a. Num a => a -> a -> a
* a
num, b
opower)
    exitDPAfterDot :: a -> a -> b -> (a, b)
exitDPAfterDot a
multiplier a
num b
opow =
        (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
multiplier a -> a -> a
forall a. Num a => a -> a -> a
* a
num , b
opow)
    exitDPAfterExponent :: a -> a -> b -> b -> b -> (a, b)
exitDPAfterExponent a
mult a
num b
opow b
powerMult b
powerNum =
        (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
mult a -> a -> a
forall a. Num a => a -> a -> a
* a
num, b
opow b -> b -> b
forall a. Num a => a -> a -> a
+ b
powerMult b -> b -> b
forall a. Num a => a -> a -> a
* b
powerNum)

    {-# INLINE step #-}
    step :: DoubleParseState -> Char -> Step DoubleParseState (Int, Int)
step DoubleParseState
DPInitial Char
val =
        case Char
val of
          Char
'+' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> DoubleParseState
DPSign Int
1)
          Char
'-' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Int -> DoubleParseState
DPSign (-Int
1))
          Char
_ -> do
              let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
              if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
              then Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPAfterSign Int
1 Int
num Int
0
              else String -> Step DoubleParseState (Int, Int)
forall s b. String -> Step s b
Error (String -> Step DoubleParseState (Int, Int))
-> String -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitDPInitial (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
val
    step (DPSign Int
multiplier) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPAfterSign Int
multiplier Int
num Int
0
            else String -> Step DoubleParseState (Int, Int)
forall s b. String -> Step s b
Error (String -> Step DoubleParseState (Int, Int))
-> String -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitDPSign (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. Show a => a -> String
show Char
val
    step (DPAfterSign Int
multiplier Int
buf Int
opower) Char
val =
        case Char
val of
            Char
'.' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPDot Int
multiplier Int
buf Int
opower
            Char
'e' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPExponent Int
multiplier Int
buf Int
opower
            Char
'E' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPExponent Int
multiplier Int
buf Int
opower
            Char
_ ->
                let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
                 in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
                    then
                        let (Int
buf1, Int
power1) = Int -> Int -> Int -> (Int, Int)
combineNum Int
buf Int
opower Int
num
                         in Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0
                            (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPAfterSign Int
multiplier Int
buf1 Int
power1
                    else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterSign Int
multiplier Int
buf Int
opower
    step (DPDot Int
multiplier Int
buf Int
opower) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then
                let (Int
buf1, Int
power1) = Int -> Int -> Int -> (Int, Int)
combineNum Int
buf Int
opower Int
num
                 in Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPAfterDot Int
multiplier Int
buf1 (Int
power1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterSign Int
multiplier Int
buf Int
opower
    step (DPAfterDot Int
multiplier Int
buf Int
opower) Char
val =
        case Char
val of
            Char
'e' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPExponent Int
multiplier Int
buf Int
opower
            Char
'E' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPExponent Int
multiplier Int
buf Int
opower
            Char
_ ->
                let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
                 in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
                    then
                        let (Int
buf1, Int
power1) = Int -> Int -> Int -> (Int, Int)
combineNum Int
buf Int
opower Int
num
                         in Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> DoubleParseState
DPAfterDot Int
multiplier Int
buf1 (Int
power1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
multiplier Int
buf Int
opower
    step (DPExponent Int
multiplier Int
buf Int
opower) Char
val =
        case Char
val of
          Char
'+' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> Int -> Int -> Int -> DoubleParseState
DPExponentWithSign Int
multiplier Int
buf Int
opower Int
1)
          Char
'-' -> Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Continue Int
0 (Int -> Int -> Int -> Int -> DoubleParseState
DPExponentWithSign Int
multiplier Int
buf Int
opower (-Int
1))
          Char
_ -> do
              let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
              if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
              then Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> DoubleParseState
DPAfterExponent Int
multiplier Int
buf Int
opower Int
1 Int
num
              else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
multiplier Int
buf Int
opower
    step (DPExponentWithSign Int
mult Int
buf Int
opower Int
powerMult) Char
val =
        let num :: Int
num = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0 (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> DoubleParseState
DPAfterExponent Int
mult Int
buf Int
opower Int
powerMult Int
num
            else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
3 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
mult Int
buf Int
opower
    step (DPAfterExponent Int
mult Int
num Int
opower Int
powerMult Int
buf) Char
val =
        let n :: Int
n = Char -> Int
ord Char
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9
            then
                Int -> DoubleParseState -> Step DoubleParseState (Int, Int)
forall s b. Int -> s -> Step s b
Partial Int
0
                    (DoubleParseState -> Step DoubleParseState (Int, Int))
-> DoubleParseState -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> DoubleParseState
DPAfterExponent Int
mult Int
num Int
opower Int
powerMult (Int
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
            else Int -> (Int, Int) -> Step DoubleParseState (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Int, Int) -> Step DoubleParseState (Int, Int))
-> (Int, Int) -> Step DoubleParseState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}.
(Integral a, Num a, Num b) =>
a -> a -> b -> b -> b -> (a, b)
exitDPAfterExponent Int
mult Int
num Int
opower Int
powerMult Int
buf

    {-# INLINE extract #-}
    extract :: DoubleParseState -> Step s (Int, Int)
extract DoubleParseState
DPInitial = String -> Step s (Int, Int)
forall s b. String -> Step s b
Error (String -> Step s (Int, Int)) -> String -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitDPInitial String
"end of input"
    extract (DPSign Int
_) = String -> Step s (Int, Int)
forall s b. String -> Step s b
Error (String -> Step s (Int, Int)) -> String -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ String -> String
exitDPSign String
"end of input"
    extract (DPAfterSign Int
mult Int
num Int
opow) = Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterSign Int
mult Int
num Int
opow
    extract (DPDot Int
mult Int
num Int
opow) = Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterSign Int
mult Int
num Int
opow
    extract (DPAfterDot Int
mult Int
num Int
opow) =
        Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
mult Int
num Int
opow
    extract (DPExponent Int
mult Int
num Int
opow) =
        Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
1 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
mult Int
num Int
opow
    extract (DPExponentWithSign Int
mult Int
num Int
opow Int
_) =
        Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
2 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}. (Integral a, Num a) => a -> a -> b -> (a, b)
exitDPAfterDot Int
mult Int
num Int
opow
    extract (DPAfterExponent Int
mult Int
num Int
opow Int
powerMult Int
powerNum) =
        Int -> (Int, Int) -> Step s (Int, Int)
forall s b. Int -> b -> Step s b
Done Int
0 ((Int, Int) -> Step s (Int, Int))
-> (Int, Int) -> Step s (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> (Int, Int)
forall {a} {a} {b}.
(Integral a, Num a, Num b) =>
a -> a -> b -> b -> b -> (a, b)
exitDPAfterExponent Int
mult Int
num Int
opow Int
powerMult Int
powerNum

-- XXX We can have a `realFloat` parser instead to parse any RealFloat value.
-- And a integral parser to read any integral value.

-- XXX This is very expensive, takes much more time than the rest of the
-- parsing. Need to look into fromRational.

-- | @mkDouble mantissa exponent@ converts a mantissa and exponent to a
-- 'Double' value equivalent to @mantissa * 10^exponent@. It does not check for
-- overflow, powers more than 308 will overflow.
{-# INLINE mkDouble #-}
mkDouble :: Integer -> Int -> Double
mkDouble :: Integer -> Int -> Double
mkDouble Integer
mantissa Int
power =
    if Int
power Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    then Rational -> Double
forall a. Fractional a => Rational -> a
fromRational ((Integer
mantissa 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
power) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)
    else Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
mantissa Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (-Int
power))

-- | Parse a decimal 'Double' value. This parser accepts an optional sign (+ or
-- -) followed by at least one decimal digit. Decimal digits are optionally
-- followed by a decimal point and at least one decimal digit after the point.
-- This parser accepts the maximal valid input as long as it gives a valid
-- number. Specifcally a trailing decimal point is allowed but not consumed.
-- This function does not accept \"NaN\" or \"Infinity\" string representations
-- of double values.
--
-- Definition:
--
-- >>> double = uncurry Unicode.mkDouble <$> Unicode.number
--
-- Examples:
--
-- >>> p = Stream.parse Unicode.double . Stream.fromList
--
-- >>> p "-1.23e-123"
-- Right (-1.23e-123)
--
-- Trailing input examples:
--
-- >>> p "1."
-- Right 1.0
--
-- >>> p "1.2.3"
-- Right 1.2
--
-- >>> p "1e"
-- Right 1.0
--
-- >>> p "1e2.3"
-- Right 100.0
--
-- >>> p "1+2"
-- Right 1.0
--
-- Error cases:
--
-- >>> p ""
-- Left (ParseError "number: expecting sign or decimal digit, got end of input")
--
-- >>> p ".1"
-- Left (ParseError "number: expecting sign or decimal digit, got '.'")
--
-- >>> p "+"
-- Left (ParseError "number: expecting decimal digit, got end of input")
--
{-# INLINE double #-}
double :: Monad m => Parser Char m Double
double :: forall (m :: * -> *). Monad m => Parser Char m Double
double = ((Int, Int) -> Double)
-> Parser Char m (Int, Int) -> Parser Char m Double
forall a b. (a -> b) -> Parser Char m a -> Parser Char m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
m,Int
e) -> Integer -> Int -> Double
mkDouble (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Int
e) Parser Char m (Int, Int)
forall (m :: * -> *). Monad m => Parser Char m (Int, Int)
doubleParser