{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_GHC -O2 #-}
-- | Parser from strict 'Text' to 'Tokens'.
module Data.Aeson.Decoding.Text (
    textToTokens,
) where

import           Data.Char                            (chr)
import           Data.Integer.Conversion              (textToInteger)
import           Data.Text.Internal                   (Text (..))

import qualified Data.Aeson.Key                       as Key
import qualified Data.Scientific                      as Sci
import qualified Data.Text                            as T
import qualified Data.Text.Array                      as A

import           Data.Aeson.Decoding.Internal
import           Data.Aeson.Decoding.Tokens
import           Data.Aeson.Internal.Prelude
import           Data.Aeson.Internal.UnescapeFromText (unescapeFromText)

#if MIN_VERSION_text(2,0,0)
import qualified Data.Word8.Patterns as W
#else
import qualified Data.Word16.Patterns as W
#endif

#if MIN_VERSION_text(2,0,0)
type Point = Word8
#else
type Point = Word16
#endif


-- | Lex (and parse) strict 'ByteString' into 'Tokens' stream.
--
-- @since 2.2.1.0
--
textToTokens :: Text -> Tokens Text String
textToTokens :: Text -> Tokens Text String
textToTokens Text
bs0 = Parser Tokens Text
forall k. Parser Tokens k
goT Text
bs0 Text -> Text
forall a. a -> a
id where
    goT :: Parser Tokens k
    goT :: forall k. Parser Tokens k
goT (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing         -> String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting JSON value"
        Just (!Point
w, !Text
bs1) -> Point -> Text -> Text -> (Text -> k) -> Tokens k String
forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
w Text
bs1 Text
bs Text -> k
k

    tokenCase
        :: Point              -- head
        -> Text               -- tail
        -> Text               -- whole input, needed for number parsing
        -> (Text -> k)        -- continuation
        -> Tokens k String
    tokenCase :: forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
W.LEFT_CURLY   !Text
bs !Text
_   Text -> k
k       = TkRecord k String -> Tokens k String
forall k e. TkRecord k e -> Tokens k e
TkRecordOpen (Parser TkRecord k
forall k. Parser TkRecord k
goR Text
bs Text -> k
k)
    tokenCase Point
W.LEFT_SQUARE   Text
bs  Text
_   Text -> k
k       = TkArray k String -> Tokens k String
forall k e. TkArray k e -> Tokens k e
TkArrayOpen (Parser TkArray k
forall k. Parser TkArray k
goA Text
bs Text -> k
k)
    tokenCase Point
W.DOUBLE_QUOTE  Text
bs  Text
_   Text -> k
k       = (Text -> Text -> Tokens k String)
-> (String -> Tokens k String) -> Text -> Tokens k String
forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral (\Text
t Text
bs' -> Text -> k -> Tokens k String
forall k e. Text -> k -> Tokens k e
TkText Text
t (Text -> k
k Text
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs
    tokenCase Point
W.HYPHEN        Text
bs  Text
_   Text -> k
k       = (Number -> Text -> Tokens k String)
-> (String -> Tokens k String) -> Text -> Tokens k String
forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral (\Number
n Text
bs' -> Number -> k -> Tokens k String
forall k e. Number -> k -> Tokens k e
TkNumber (Number -> Number
negateNumber Number
n) (Text -> k
k Text
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs
    tokenCase Point
w                Text
_   Text
wbs Text -> k
k
        | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w, Point
w Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9      = (Number -> Text -> Tokens k String)
-> (String -> Tokens k String) -> Text -> Tokens k String
forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral (\Number
n Text
bs' -> Number -> k -> Tokens k String
forall k e. Number -> k -> Tokens k e
TkNumber Number
n (Text -> k
k Text
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
wbs
    tokenCase Point
W.LOWER_N       Text
bs  Text
_   Text -> k
k
        | Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"ull" Int
3 Text
bs  = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitNull (Text -> k
k Text
bs1)
    tokenCase Point
W.LOWER_T       Text
bs  Text
_   Text -> k
k
        | Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"rue" Int
3 Text
bs  = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitTrue (Text -> k
k Text
bs1)
    tokenCase Point
W.LOWER_F       Text
bs  Text
_   Text -> k
k
        | Just Text
bs1 <- Text -> Int -> Text -> Maybe Text
stripPrefix Text
"alse" Int
4 Text
bs = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitFalse (Text -> k
k Text
bs1)
    tokenCase Point
_          Text
_   Text
wbs Text -> k
_            = String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr (String -> Tokens k String) -> String -> Tokens k String
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
showBeginning Text
wbs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expecting JSON value"
    -- Array
    goA :: Parser TkArray k
    goA :: forall k. Parser TkArray k
goA (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing         -> String -> TkArray k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"JSON value or ]"
        Just (Point
W.RIGHT_SQUARE, !Text
bs1) -> k -> TkArray k String
forall k e. k -> TkArray k e
TkArrayEnd (Text -> k
k Text
bs1)
        Just (Point
w,  !Text
bs1) -> Tokens (TkArray k String) String -> TkArray k String
forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem (Tokens (TkArray k String) String -> TkArray k String)
-> Tokens (TkArray k String) String -> TkArray k String
forall a b. (a -> b) -> a -> b
$ Point
-> Text
-> Text
-> (Text -> TkArray k String)
-> Tokens (TkArray k String) String
forall k. Point -> Text -> Text -> (Text -> k) -> Tokens k String
tokenCase Point
w Text
bs1 Text
bs ((Text -> TkArray k String) -> Tokens (TkArray k String) String)
-> (Text -> TkArray k String) -> Tokens (TkArray k String) String
forall a b. (a -> b) -> a -> b
$ \Text
bs2 -> Parser TkArray k
forall k. Parser TkArray k
goA1 Text
bs2 Text -> k
k

    goA1 :: Parser TkArray k
    goA1 :: forall k. Parser TkArray k
goA1 (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                      -> String -> TkArray k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
", or ]"
        Just (Point
W.RIGHT_SQUARE, !Text
bs1) -> k -> TkArray k String
forall k e. k -> TkArray k e
TkArrayEnd (Text -> k
k Text
bs1)
        Just (Point
W.COMMA, !Text
bs1)        -> Tokens (TkArray k String) String -> TkArray k String
forall k e. Tokens (TkArray k e) e -> TkArray k e
TkItem (Tokens (TkArray k String) String -> TkArray k String)
-> Tokens (TkArray k String) String -> TkArray k String
forall a b. (a -> b) -> a -> b
$ Parser Tokens (TkArray k String)
forall k. Parser Tokens k
goT Text
bs1 ((Text -> TkArray k String) -> Tokens (TkArray k String) String)
-> (Text -> TkArray k String) -> Tokens (TkArray k String) String
forall a b. (a -> b) -> a -> b
$ \Text
bs2 -> Parser TkArray k
forall k. Parser TkArray k
goA1 Text
bs2 Text -> k
k
        Maybe (Point, Text)
_                            -> Text -> String -> TkArray k String
forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
", or ]"

    -- Record
    goR :: Parser TkRecord k
    goR :: forall k. Parser TkRecord k
goR (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                       -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"record key literal or }"
        Just (Point
W.DOUBLE_QUOTE,  !Text
bs1) -> Parser TkRecord k
forall k. Parser TkRecord k
goRK Text
bs1 Text -> k
k           -- "
        Just (Point
W.RIGHT_CURLY, !Text
bs1)   -> k -> TkRecord k String
forall k e. k -> TkRecord k e
TkRecordEnd (Text -> k
k Text
bs1)  -- }
        Just (Point, Text)
_                        -> Text -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
"record key literal or }"

    -- after record pair, expecting ," or }
    goR1 :: Parser TkRecord k
    goR1 :: forall k. Parser TkRecord k
goR1 (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                           -> String -> TkRecord k String
forall e k. e -> TkRecord k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr String
"Unexpected end-of-input, expecting , or }"
        Just (Point
W.COMMA, !Text
bs1) -> case Text -> Maybe (Point, Text)
unconsPoint (Text -> Text
skipSpace Text
bs1) of
            Maybe (Point, Text)
Nothing                      -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"key literal"
            Just (Point
W.DOUBLE_QUOTE, !Text
bs2) -> Parser TkRecord k
forall k. Parser TkRecord k
goRK Text
bs2 Text -> k
k
            Just (Point, Text)
_                       -> Text -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
"key literal"
        Just (Point
W.RIGHT_CURLY, !Text
bs1)       -> k -> TkRecord k String
forall k e. k -> TkRecord k e
TkRecordEnd (Text -> k
k Text
bs1)
        Maybe (Point, Text)
_                                 -> String -> TkRecord k String
forall e k. e -> TkRecord k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr (String -> TkRecord k String) -> String -> TkRecord k String
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
showBeginning Text
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expecting , or }"

    -- key of record (after double quote)
    goRK :: Parser TkRecord k
    goRK :: forall k. Parser TkRecord k
goRK Text
bs1 Text -> k
k = (Text -> Text -> TkRecord k String)
-> (String -> TkRecord k String) -> Text -> TkRecord k String
forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral (\Text
t Text
bs -> Text -> Parser TkRecord k
forall k. Text -> Parser TkRecord k
goRK' Text
t Text
bs Text -> k
k) String -> TkRecord k String
forall e k. e -> TkRecord k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr Text
bs1

    -- after key of a record, expecting :
    goRK' :: Text -> Parser TkRecord k
    goRK' :: forall k. Text -> Parser TkRecord k
goRK' Text
t (Text -> Text
skipSpace -> Text
bs) Text -> k
k = case Text -> Maybe (Char, Text)
T.uncons Text
bs of
        Maybe (Char, Text)
Nothing          -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
":"
        Just (Char
':', !Text
bs3) -> Key -> Tokens (TkRecord k String) String -> TkRecord k String
forall k e. Key -> Tokens (TkRecord k e) e -> TkRecord k e
TkPair (Text -> Key
Key.fromText Text
t) (Tokens (TkRecord k String) String -> TkRecord k String)
-> Tokens (TkRecord k String) String -> TkRecord k String
forall a b. (a -> b) -> a -> b
$ Parser Tokens (TkRecord k String)
forall k. Parser Tokens k
goT Text
bs3 ((Text -> TkRecord k String) -> Tokens (TkRecord k String) String)
-> (Text -> TkRecord k String) -> Tokens (TkRecord k String) String
forall a b. (a -> b) -> a -> b
$ \Text
bs4 -> Parser TkRecord k
forall k. Parser TkRecord k
goR1 Text
bs4 Text -> k
k
        Just (Char, Text)
_           -> Text -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
":"

stripPrefix :: Text -> Int -> Text -> Maybe Text
stripPrefix :: Text -> Int -> Text -> Maybe Text
stripPrefix Text
pfx Int
_ Text
bs = Text -> Text -> Maybe Text
T.stripPrefix Text
pfx Text
bs
{-# INLINE stripPrefix #-}

type Parser tk k = Text -> (Text -> k) -> tk k String

showBeginning :: Text -> String
showBeginning :: Text -> String
showBeginning = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
30

-- | Strip leading (ASCII) space
skipSpace :: Text -> Text
skipSpace :: Text -> Text
skipSpace = (Char -> Bool) -> Text -> Text
T.dropWhile ((Char -> Bool) -> Text -> Text) -> (Char -> Bool) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
w -> Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x20' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0a' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0d' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09'
{-# INLINE skipSpace #-}

tkErrEOF :: AsError t => String ->  t k String
tkErrEOF :: forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
expected = String -> t k String
forall e k. e -> t k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr (String -> t k String) -> String -> t k String
forall a b. (a -> b) -> a -> b
$
    String
"Unexpected end-of-input, expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrEOF #-}

tkErrBS :: AsError t => Text -> String ->  t k String
tkErrBS :: forall (t :: * -> * -> *) k.
AsError t =>
Text -> String -> t k String
tkErrBS Text
bs String
expected = String -> t k String
forall e k. e -> t k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr (String -> t k String) -> String -> t k String
forall a b. (a -> b) -> a -> b
$
    String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
showBeginning Text
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrBS #-}

-------------------------------------------------------------------------------
-- Text
-------------------------------------------------------------------------------

scanStringLiteral
    :: forall r. (Text -> Text -> r)
    -> (String -> r)
    -> Text
    -> r
scanStringLiteral :: forall r. (Text -> Text -> r) -> (String -> r) -> Text -> r
scanStringLiteral Text -> Text -> r
ok String -> r
err Text
bs0 = Int -> Text -> r
go Int
0 Text
bs0 where
    -- the length is counted in bytes.
    go :: Int -> Text -> r
    go :: Int -> Text -> r
go !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing          -> r
errEnd
        Just (Point
34, Text
_)     -> Text -> Text -> r
ok (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0) (Int -> Text -> Text
unsafeDropPoints (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs0)
        Just (Point
92, Text
bs')   -> Int -> Text -> r
goSlash (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
        Just (Point
w8, Text
bs')
            | Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
0x20  -> r
errCC
            -- we don't need to check for @>= 0x80@ chars, as text is valid unicode.
            | Bool
otherwise  -> Int -> Text -> r
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'

    -- in goEsc and goSlash we don't need to check for control characters as unescapeText verifies that.
    goEsc :: Int -> Text -> r
    goEsc :: Int -> Text -> r
goEsc !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing        -> r
errEnd
        Just (Point
34, Text
_)   -> case Text -> Either UnicodeException Text
unescapeFromText (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0) of
            Right Text
t -> Text -> Text -> r
ok Text
t (Int -> Text -> Text
unsafeDropPoints (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs0)
            Left UnicodeException
e  -> String -> r
err (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)
        Just (Point
92, Text
bs') -> Int -> Text -> r
goSlash (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
        Just (Point
_,  Text
bs') -> Int -> Text -> r
goEsc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'

    goSlash :: Int -> Text -> r
    goSlash :: Int -> Text -> r
goSlash !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing       -> r
errEnd
        Just (Point
_, Text
bs') -> Int -> Text -> r
goEsc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'

    errEnd :: r
errEnd = String -> r
err String
"Unexpected end-of-input while parsing string literal"
    errCC :: r
errCC  = String -> r
err String
"Unespected control character while parsing string literal"

-------------------------------------------------------------------------------
-- Number
-------------------------------------------------------------------------------

--
-- number   := integer fraction exponent
-- integer  := 0 | [1-9][0-9]* | -0 | -[1-9][0-9]*
-- fraction := "" | . [0-9]+
-- exponent := "" | E sign [0-9]+ | e sign [0-9]+
-- sign     := "" | - | +
--
-- This scanner doesn't recognize the leading minus sign, we recognize only integer := 0 | [1-9][0-9]*,
-- as the minus sign is recognized by outer scanner already.
--
scanNumberLiteral
    :: forall r. (Number -> Text -> r)
    -> (String -> r)
    -> Text
    -> r
scanNumberLiteral :: forall r. (Number -> Text -> r) -> (String -> r) -> Text -> r
scanNumberLiteral Number -> Text -> r
kont String -> r
err Text
bs0 = Text -> r
state_start Text
bs0 where
    state_start :: Text -> r
    state_start :: Text -> r
state_start !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                                   -> r
errEnd
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9     -> Int -> Text -> r
state_i1 Int
1 Text
bs'
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8                     -> Text -> r
state_after0 Text
bs'
            | Bool
otherwise                           -> Point -> r
forall {a}. Integral a => a -> r
errUnx Point
w8

    state_after0 :: Text -> r
    state_after0 :: Text -> r
state_after0 !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                                   -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
0) Text
bs
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9    -> String -> r
err String
"Number literal with leading zero"
            | Point
W.PERIOD Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8                      -> Integer -> Text -> r
go_dec Integer
0 Text
bs'
            | Point
W.LOWER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W.UPPER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8  -> Integer -> Int -> Text -> r
go_sci Integer
0 Int
0 Text
bs'
            | Bool
otherwise                           -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
0) Text
bs

    state_i1 :: Int -> Text -> r
    state_i1 :: Int -> Text -> r
state_i1 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                                   -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
int) Text
bs
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9    -> Int -> Text -> r
state_i1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
            | Point
W.PERIOD Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8                      -> Integer -> Text -> r
go_dec Integer
int Text
bs'
            | Point
W.LOWER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W.UPPER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8  -> Integer -> Int -> Text -> r
go_sci Integer
int Int
0 Text
bs'
            | Bool
otherwise                           -> Number -> Text -> r
kont (Integer -> Number
NumInteger Integer
int) Text
bs
      where
        int :: Integer
int = Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs0)

    go_dec :: Integer -> Text -> r
    go_dec :: Integer -> Text -> r
go_dec !Integer
int !Text
bs1 = case Text -> Maybe (Point, Text)
unconsPoint Text
bs1 of
        Maybe (Point, Text)
Nothing                                   -> r
errEnd
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9    -> Int -> Text -> r
state_dec Int
1 Text
bs'
            | Bool
otherwise                           -> Point -> r
forall {a}. Integral a => a -> r
errUnx Point
w8
      where
        state_dec :: Int -> Text -> r
        state_dec :: Int -> Text -> r
state_dec !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
            Maybe (Point, Text)
Nothing                                   -> Number -> Text -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) Text
bs
            Just (Point
w8, Text
bs')
                | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9    -> Int -> Text -> r
state_dec (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
                | Point
W.LOWER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8 Bool -> Bool -> Bool
|| Point
W.UPPER_E Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8  -> Integer -> Int -> Text -> r
go_sci Integer
coef (Int -> Int
forall a. Num a => a -> a
negate Int
n) Text
bs'
                | Bool
otherwise                           -> Number -> Text -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) Text
bs
          where
            frac :: Integer
frac = Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs1)
            coef :: Integer
coef = Integer
int 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
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
frac
            dec :: Scientific
dec  = Integer -> Int -> Scientific
Sci.scientific Integer
coef (Int -> Int
forall a. Num a => a -> a
negate Int
n)

    go_sci :: Integer -> Int -> Text -> r
    go_sci :: Integer -> Int -> Text -> r
go_sci !Integer
coef !Int
exp10 !Text
bs2 = case Text -> Maybe (Point, Text)
unconsPoint Text
bs2 of
        Maybe (Point, Text)
Nothing                                           -> r
errEnd
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9            -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs2 Int
1 Text
bs'
            | Point
W.PLUS Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8 -> case Text -> Maybe (Point, Text)
unconsPoint Text
bs' of
                Maybe (Point, Text)
Nothing                                   -> r
errEnd
                Just (Point
w8', Text
bs'')
                    | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8', Point
w8' Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs' Int
1 Text
bs''
                    | Bool
otherwise                           -> Point -> r
forall {a}. Integral a => a -> r
errUnx Point
w8'
            | Point
W.HYPHEN Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
w8 -> case Text -> Maybe (Point, Text)
unconsPoint Text
bs' of
                Maybe (Point, Text)
Nothing                                   -> r
errEnd
                Just (Point
w8', Text
bs'')
                    | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8', Point
w8' Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
bs' Int
1 Text
bs''
                    | Bool
otherwise                           -> Point -> r
forall {a}. Integral a => a -> r
errUnx Point
w8'
            | Bool
otherwise                                   -> Point -> r
forall {a}. Integral a => a -> r
errUnx Point
w8

    go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r
    go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos !Integer
coef !Int
exp10 !Text
bs2 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                                 -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_pos Integer
coef Int
exp10 Text
bs2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
            | Bool
otherwise                         -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
      where
        exp10' :: Int
exp10' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs2))
        sci :: Scientific
sci = Integer -> Int -> Scientific
Sci.scientific Integer
coef (Int
exp10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
exp10')

    go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r
    go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg !Integer
coef !Int
exp10 !Text
bs2 !Int
n !Text
bs = case Text -> Maybe (Point, Text)
unconsPoint Text
bs of
        Maybe (Point, Text)
Nothing                                 -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
        Just (Point
w8, Text
bs')
            | Point
W.DIGIT_0 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
w8, Point
w8 Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
W.DIGIT_9  -> Integer -> Int -> Text -> Int -> Text -> r
go_sci_neg Integer
coef Int
exp10 Text
bs2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
bs'
            | Bool
otherwise                         -> Number -> Text -> r
kont (Scientific -> Number
NumScientific Scientific
sci) Text
bs
      where
        exp10' :: Int
exp10' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Text -> Integer
textToInteger (Int -> Text -> Text
unsafeTakePoints Int
n Text
bs2))
        sci :: Scientific
sci = Integer -> Int -> Scientific
Sci.scientific Integer
coef (Int
exp10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
exp10')

    errEnd :: r
errEnd    = String -> r
err String
"Unexpected end-of-input while parsing number literal"
    errUnx :: a -> r
errUnx a
w8 = String -> r
err (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show (Int -> Char
chr (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w8)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"

-------------------------------------------------------------------------------
-- Unsafe primitives
-------------------------------------------------------------------------------

{-# INLINE unconsPoint #-}
-- Uncons a primitive unit of storage from text.
-- The left-over 'Text' value may be invalid.
unconsPoint :: Text -> Maybe (Point, Text)
unconsPoint :: Text -> Maybe (Point, Text)
unconsPoint (Text Array
arr Int
off Int
len)
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Maybe (Point, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Point, Text) -> Maybe (Point, Text)
forall a. a -> Maybe a
Just (Point
w8, Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  where
    w8 :: Point
w8 = Array -> Int -> Point
A.unsafeIndex Array
arr Int
off

unsafeTakePoints :: Int -> Text -> Text
unsafeTakePoints :: Int -> Text -> Text
unsafeTakePoints Int
n (Text Array
arr Int
off Int
_len) = Array -> Int -> Int -> Text
Text Array
arr Int
off Int
n
{-# INLINE unsafeTakePoints #-}

unsafeDropPoints :: Int -> Text -> Text
unsafeDropPoints :: Int -> Text -> Text
unsafeDropPoints Int
n (Text Array
arr Int
off Int
len) = Array -> Int -> Int -> Text
Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
{-# INLINE unsafeDropPoints #-}