{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_GHC -O2 #-}
-- | Parser from lazy 'ByteString' to 'Tokens'.
module Data.Aeson.Decoding.ByteString.Lazy (
    lbsToTokens,
) where

import           Data.ByteString.Lazy         (ByteString)
import           Data.Char                    (chr)
import           Data.Text                    (Text)
import           Data.Word                    (Word8)

import qualified Data.Aeson.Key               as Key
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Lazy         as LBS
import qualified Data.Scientific              as Sci

import           Data.Aeson.Decoding.Internal
import           Data.Aeson.Decoding.Tokens
import           Data.Aeson.Internal.Integer
import           Data.Aeson.Internal.Text     (unsafeDecodeASCII)
import           Data.Aeson.Internal.Word8
import           Data.Aeson.Parser.Unescape   (unescapeText)

-- | Lex (and parse) lazy 'ByteString' into 'Tokens' stream.
--
-- @since 2.1.2.0
--
lbsToTokens :: ByteString -> Tokens ByteString String
lbsToTokens :: ByteString -> Tokens ByteString String
lbsToTokens ByteString
bs0 = Parser Tokens ByteString
forall k. Parser Tokens k
goT ByteString
bs0 ByteString -> ByteString
forall a. a -> a
id where
    goT :: Parser Tokens k
    goT :: forall k. Parser Tokens k
goT (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
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 (!Word8
w, !ByteString
bs1) -> Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
w ByteString
bs1 ByteString
bs ByteString -> k
k

    tokenCase
        :: Word8              -- head
        -> ByteString         -- tail
        -> ByteString         -- whole input, needed for number parsing
        -> (ByteString -> k)  -- continuation
        -> Tokens k String
    tokenCase :: forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
W8_OPEN_CURLY   !ByteString
bs !ByteString
_   ByteString -> 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 ByteString
bs ByteString -> k
k)
    tokenCase Word8
W8_OPEN_SQUARE   ByteString
bs  ByteString
_   ByteString -> 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 ByteString
bs ByteString -> k
k)
    tokenCase Word8
W8_DOUBLE_QUOTE  ByteString
bs  ByteString
_   ByteString -> k
k      = (Text -> ByteString -> Tokens k String)
-> (String -> Tokens k String) -> ByteString -> Tokens k String
forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral (\Text
t ByteString
bs' -> Text -> k -> Tokens k String
forall k e. Text -> k -> Tokens k e
TkText Text
t (ByteString -> k
k ByteString
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs
    tokenCase Word8
W8_MINUS         ByteString
bs  ByteString
_   ByteString -> k
k      = (Number -> ByteString -> Tokens k String)
-> (String -> Tokens k String) -> ByteString -> Tokens k String
forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral (\Number
n ByteString
bs' -> Number -> k -> Tokens k String
forall k e. Number -> k -> Tokens k e
TkNumber (Number -> Number
negateNumber Number
n) (ByteString -> k
k ByteString
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs
    tokenCase Word8
w                ByteString
_   ByteString
wbs ByteString -> k
k
        | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w, Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9                = (Number -> ByteString -> Tokens k String)
-> (String -> Tokens k String) -> ByteString -> Tokens k String
forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral (\Number
n ByteString
bs' -> Number -> k -> Tokens k String
forall k e. Number -> k -> Tokens k e
TkNumber Number
n (ByteString -> k
k ByteString
bs')) String -> Tokens k String
forall e k. e -> Tokens k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
wbs
    tokenCase Word8
W8_n             ByteString
bs  ByteString
_   ByteString -> k
k
        | Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"ull" Int
3 ByteString
bs  = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitNull (ByteString -> k
k ByteString
bs1)
    tokenCase Word8
W8_t             ByteString
bs  ByteString
_   ByteString -> k
k
        | Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"rue" Int
3 ByteString
bs  = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitTrue (ByteString -> k
k ByteString
bs1)
    tokenCase Word8
W8_f             ByteString
bs  ByteString
_   ByteString -> k
k
        | Just ByteString
bs1 <- ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
"alse" Int
4 ByteString
bs = Lit -> k -> Tokens k String
forall k e. Lit -> k -> Tokens k e
TkLit Lit
LitFalse (ByteString -> k
k ByteString
bs1)
    tokenCase Word8
_                ByteString
_   ByteString
wbs ByteString -> 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]
++ ByteString -> String
showBeginning ByteString
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 (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing         -> String -> TkArray k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"JSON value or ]"
        Just (Word8
W8_CLOSE_SQUARE, !ByteString
bs1) -> k -> TkArray k String
forall k e. k -> TkArray k e
TkArrayEnd (ByteString -> k
k ByteString
bs1)
        Just (Word8
w,  !ByteString
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
$ Word8
-> ByteString
-> ByteString
-> (ByteString -> TkArray k String)
-> Tokens (TkArray k String) String
forall k.
Word8
-> ByteString -> ByteString -> (ByteString -> k) -> Tokens k String
tokenCase Word8
w ByteString
bs1 ByteString
bs ((ByteString -> TkArray k String)
 -> Tokens (TkArray k String) String)
-> (ByteString -> TkArray k String)
-> Tokens (TkArray k String) String
forall a b. (a -> b) -> a -> b
$ \ByteString
bs2 -> Parser TkArray k
forall k. Parser TkArray k
goA1 ByteString
bs2 ByteString -> k
k

    goA1 :: Parser TkArray k
    goA1 :: forall k. Parser TkArray k
goA1 (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                      -> String -> TkArray k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
", or ]"
        Just (Word8
W8_CLOSE_SQUARE, !ByteString
bs1) -> k -> TkArray k String
forall k e. k -> TkArray k e
TkArrayEnd (ByteString -> k
k ByteString
bs1)
        Just (Word8
W8_COMMA, !ByteString
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 ByteString
bs1 ((ByteString -> TkArray k String)
 -> Tokens (TkArray k String) String)
-> (ByteString -> TkArray k String)
-> Tokens (TkArray k String) String
forall a b. (a -> b) -> a -> b
$ \ByteString
bs2 -> Parser TkArray k
forall k. Parser TkArray k
goA1 ByteString
bs2 ByteString -> k
k
        Maybe (Word8, ByteString)
_                            -> ByteString -> String -> TkArray k String
forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
", or ]"

    -- Record
    goR :: Parser TkRecord k
    goR :: forall k. Parser TkRecord k
goR (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                       -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"record key literal or }"
        Just (Word8
W8_DOUBLE_QUOTE,  !ByteString
bs1) -> Parser TkRecord k
forall k. Parser TkRecord k
goRK ByteString
bs1 ByteString -> k
k           -- "
        Just (Word8
W8_CLOSE_CURLY, !ByteString
bs1)   -> k -> TkRecord k String
forall k e. k -> TkRecord k e
TkRecordEnd (ByteString -> k
k ByteString
bs1)  -- }
        Just (Word8, ByteString)
_                        -> ByteString -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
"record key literal or }"

    -- after record pair, expecting ," or }
    goR1 :: Parser TkRecord k
    goR1 :: forall k. Parser TkRecord k
goR1 (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
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 (Word8
W8_COMMA, !ByteString
bs1) -> case ByteString -> Maybe (Word8, ByteString)
LBS.uncons (ByteString -> ByteString
skipSpace ByteString
bs1) of
            Maybe (Word8, ByteString)
Nothing                      -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
"key literal"
            Just (Word8
W8_DOUBLE_QUOTE, !ByteString
bs2) -> Parser TkRecord k
forall k. Parser TkRecord k
goRK ByteString
bs2 ByteString -> k
k
            Just (Word8, ByteString)
_                       -> ByteString -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
"key literal"
        Just (Word8
W8_CLOSE_CURLY, !ByteString
bs1)       -> k -> TkRecord k String
forall k e. k -> TkRecord k e
TkRecordEnd (ByteString -> k
k ByteString
bs1)
        Maybe (Word8, ByteString)
_                                 -> 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]
++ ByteString -> String
showBeginning ByteString
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 ByteString
bs1 ByteString -> k
k = (Text -> ByteString -> TkRecord k String)
-> (String -> TkRecord k String) -> ByteString -> TkRecord k String
forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral (\Text
t ByteString
bs -> Text -> Parser TkRecord k
forall k. Text -> Parser TkRecord k
goRK' Text
t ByteString
bs ByteString -> k
k) String -> TkRecord k String
forall e k. e -> TkRecord k e
forall (t :: * -> * -> *) e k. AsError t => e -> t k e
tkErr ByteString
bs1

    -- after key of a record, expecting :
    goRK' :: Text -> Parser TkRecord k
    goRK' :: forall k. Text -> Parser TkRecord k
goRK' Text
t (ByteString -> ByteString
skipSpace -> ByteString
bs) ByteString -> k
k = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing               -> String -> TkRecord k String
forall (t :: * -> * -> *) k. AsError t => String -> t k String
tkErrEOF String
":"
        Just (Word8
W8_COLON, !ByteString
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 ByteString
bs3 ((ByteString -> TkRecord k String)
 -> Tokens (TkRecord k String) String)
-> (ByteString -> TkRecord k String)
-> Tokens (TkRecord k String) String
forall a b. (a -> b) -> a -> b
$ \ByteString
bs4 -> Parser TkRecord k
forall k. Parser TkRecord k
goR1 ByteString
bs4 ByteString -> k
k
        Just (Word8, ByteString)
_                -> ByteString -> String -> TkRecord k String
forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
bs String
":"

stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString
stripPrefix ByteString
pfx Int
n ByteString
bs | ByteString -> ByteString -> Bool
LBS.isPrefixOf ByteString
pfx ByteString
bs = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
LBS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
bs)
                     | Bool
otherwise             = Maybe ByteString
forall a. Maybe a
Nothing
{-# INLINE stripPrefix #-}

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

showBeginning :: ByteString -> String
showBeginning :: ByteString -> String
showBeginning = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
LBS.take Int64
30

-- | Strip leading (ASCII) space
skipSpace :: ByteString -> ByteString
skipSpace :: ByteString -> ByteString
skipSpace = (Word8 -> Bool) -> ByteString -> ByteString
LBS.dropWhile ((Word8 -> Bool) -> ByteString -> ByteString)
-> (Word8 -> Bool) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09
{-# 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 => ByteString -> String ->  t k String
tkErrBS :: forall (t :: * -> * -> *) k.
AsError t =>
ByteString -> String -> t k String
tkErrBS ByteString
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]
++ ByteString -> String
showBeginning ByteString
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expected
{-# INLINE tkErrBS #-}

lbsTake :: Int -> ByteString -> BS.ByteString
lbsTake :: Int -> ByteString -> ByteString
lbsTake Int
n ByteString
bs = ByteString -> ByteString
LBS.toStrict (Int64 -> ByteString -> ByteString
LBS.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ByteString
bs)

lbsDrop :: Int -> ByteString -> ByteString
lbsDrop :: Int -> ByteString -> ByteString
lbsDrop Int
n = Int64 -> ByteString -> ByteString
LBS.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

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

scanStringLiteral
    :: forall r. (Text -> ByteString -> r)
    -> (String -> r)
    -> ByteString
    -> r
scanStringLiteral :: forall r.
(Text -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanStringLiteral Text -> ByteString -> r
ok String -> r
err ByteString
bs0 = Int -> ByteString -> r
go Int
0 ByteString
bs0 where
    go :: Int -> ByteString -> r
    go :: Int -> ByteString -> r
go !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing          -> r
errEnd
        Just (Word8
34, ByteString
_)     -> Text -> ByteString -> r
ok (ByteString -> Text
unsafeDecodeASCII (Int -> ByteString -> ByteString
lbsTake Int
n ByteString
bs0)) (Int -> ByteString -> ByteString
lbsDrop  (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs0)
        Just (Word8
92, ByteString
bs')   -> Int -> ByteString -> r
goSlash (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
        Just (Word8
w8, ByteString
bs')
            | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x20  -> r
errCC
            | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x80 -> Int -> ByteString -> r
goEsc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
            | Bool
otherwise  -> Int -> ByteString -> r
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'

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

    goSlash :: Int -> ByteString -> r
    goSlash :: Int -> ByteString -> r
goSlash !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing       -> r
errEnd
        Just (Word8
_, ByteString
bs') -> Int -> ByteString -> r
goEsc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
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 -> ByteString -> r)
    -> (String -> r)
    -> ByteString
    -> r
scanNumberLiteral :: forall r.
(Number -> ByteString -> r) -> (String -> r) -> ByteString -> r
scanNumberLiteral Number -> ByteString -> r
kont String -> r
err ByteString
bs0 = ByteString -> r
state_start ByteString
bs0 where
    state_start :: ByteString -> r
    state_start :: ByteString -> r
state_start !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                      -> r
errEnd
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Int -> ByteString -> r
state_i1 Int
1 ByteString
bs'
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8             -> ByteString -> r
state_after0 ByteString
bs'
            | Bool
otherwise              -> String -> r
err (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w8 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"

    state_after0 :: ByteString -> r
    state_after0 :: ByteString -> r
state_after0 !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                         -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
0) ByteString
bs
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9    -> String -> r
err String
"Number literal with leading zero"
            | Word8
W8_DOT Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8              -> Integer -> ByteString -> r
go_dec Integer
0 ByteString
bs'
            | Word8
W8_e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8  -> Integer -> Int -> ByteString -> r
go_sci Integer
0 Int
0 ByteString
bs'
            | Bool
otherwise                 -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
0) ByteString
bs

    state_i1 :: Int -> ByteString -> r
    state_i1 :: Int -> ByteString -> r
state_i1 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                         -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
int) ByteString
bs
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9    -> Int -> ByteString -> r
state_i1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
            | Word8
W8_DOT Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8              -> Integer -> ByteString -> r
go_dec Integer
int ByteString
bs'
            | Word8
W8_e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8  -> Integer -> Int -> ByteString -> r
go_sci Integer
int Int
0 ByteString
bs'
            | Bool
otherwise                 -> Number -> ByteString -> r
kont (Integer -> Number
NumInteger Integer
int) ByteString
bs
      where
        int :: Integer
int = ByteString -> Integer
bsToInteger (Int -> ByteString -> ByteString
lbsTake Int
n ByteString
bs0)

    go_dec :: Integer -> ByteString -> r
    go_dec :: Integer -> ByteString -> r
go_dec !Integer
int !ByteString
bs1 = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs1 of
        Maybe (Word8, ByteString)
Nothing                       -> r
errEnd
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Int -> ByteString -> r
state_dec Int
1 ByteString
bs'
            | Bool
otherwise               -> String -> r
err (String -> r) -> String -> r
forall a b. (a -> b) -> a -> b
$ String
"Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w8 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" while parsing number literal"
      where
        state_dec :: Int -> ByteString -> r
        state_dec :: Int -> ByteString -> r
state_dec !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
            Maybe (Word8, ByteString)
Nothing                         -> Number -> ByteString -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) ByteString
bs
            Just (Word8
w8, ByteString
bs')
                | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9    -> Int -> ByteString -> r
state_dec (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
                | Word8
W8_e Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8 Bool -> Bool -> Bool
|| Word8
W8_E Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8  -> Integer -> Int -> ByteString -> r
go_sci Integer
coef (Int -> Int
forall a. Num a => a -> a
negate Int
n) ByteString
bs'
                | Bool
otherwise                 -> Number -> ByteString -> r
kont (Scientific -> Number
NumDecimal Scientific
dec) ByteString
bs
          where
            frac :: Integer
frac = ByteString -> Integer
bsToInteger (Int -> ByteString -> ByteString
lbsTake Int
n ByteString
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 -> ByteString -> r
    go_sci :: Integer -> Int -> ByteString -> r
go_sci !Integer
coef !Int
exp10 !ByteString
bs2 = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs2 of
        Maybe (Word8, ByteString)
Nothing                       -> r
errEnd
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs2 Int
1 ByteString
bs'
            | Word8
W8_PLUS Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8           -> case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs' of
                Maybe (Word8, ByteString)
Nothing               -> r
errEnd
                Just (Word8
w8', ByteString
bs'')
                    | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8', Word8
w8' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs' Int
1 ByteString
bs''
                    | Bool
otherwise       ->  Word8 -> r
forall {a}. Integral a => a -> r
errUnx Word8
w8'
            | Word8
W8_MINUS Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w8          -> case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs' of
                Maybe (Word8, ByteString)
Nothing               -> r
errEnd
                Just (Word8
w8', ByteString
bs'')
                    | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8', Word8
w8' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg Integer
coef Int
exp10 ByteString
bs' Int
1 ByteString
bs''
                    | Bool
otherwise       ->  Word8 -> r
forall {a}. Integral a => a -> r
errUnx Word8
w8'
            | Bool
otherwise               -> Word8 -> r
forall {a}. Integral a => a -> r
errUnx Word8
w8

    go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r
    go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos !Integer
coef !Int
exp10 !ByteString
bs2 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                       -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_pos Integer
coef Int
exp10 ByteString
bs2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
            | Bool
otherwise               -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
      where
        exp10' :: Int
exp10' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (ByteString -> Integer
bsToInteger (Int -> ByteString -> ByteString
lbsTake Int
n ByteString
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 -> ByteString -> Int -> ByteString -> r
    go_sci_neg :: Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg !Integer
coef !Int
exp10 !ByteString
bs2 !Int
n !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing                       -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
        Just (Word8
w8, ByteString
bs')
            | Word8
W8_0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
w8, Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8_9  -> Integer -> Int -> ByteString -> Int -> ByteString -> r
go_sci_neg Integer
coef Int
exp10 ByteString
bs2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs'
            | Bool
otherwise               -> Number -> ByteString -> r
kont (Scientific -> Number
NumScientific Scientific
sci) ByteString
bs
      where
        exp10' :: Int
exp10' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (ByteString -> Integer
bsToInteger (Int -> ByteString -> ByteString
lbsTake Int
n ByteString
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"