{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module defines a bunch of small parsers used to parse individual
--   lexemes.
module Language.GraphQL.AST.Lexer
    ( Parser
    , amp
    , at
    , bang
    , blockString
    , braces
    , brackets
    , colon
    , dollar
    , comment
    , equals
    , extend
    , integer
    , float
    , lexeme
    , name
    , parens
    , pipe
    , spaceConsumer
    , spread
    , string
    , symbol
    , unicodeBOM
    ) where

import Control.Applicative (Alternative(..), liftA2)
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
import Data.Foldable (foldl')
import Data.List (dropWhileEnd)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
import Data.Proxy (Proxy(..))
import Data.Void (Void)
import Text.Megaparsec ( Parsec
                       , (<?>)
                       , between
                       , chunk
                       , chunkToTokens
                       , notFollowedBy
                       , oneOf
                       , option
                       , optional
                       , satisfy
                       , sepBy
                       , skipSome
                       , takeP
                       , takeWhile1P
                       , try
                       )
import Text.Megaparsec.Char (char, digitChar, space1)
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Control.Monad (void)

-- | Standard parser.
-- Accepts the type of the parsed token.
type Parser = Parsec Void T.Text

ignoredCharacters :: Parser ()
ignoredCharacters :: Parser ()
ignoredCharacters = Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',')

-- | Parser that skips comments and meaningless characters, whitespaces and
-- commas.
spaceConsumer :: Parser ()
spaceConsumer :: Parser ()
spaceConsumer = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lexer.space Parser ()
ignoredCharacters Parser ()
comment Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Parser for comments.
comment :: Parser ()
comment :: Parser ()
comment = Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
Lexer.skipLineComment Tokens Text
"#"

-- | Lexeme definition which ignores whitespaces and commas.
lexeme :: forall a. Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lexer.lexeme Parser ()
spaceConsumer

-- | Symbol definition which ignores whitespaces and commas.
symbol :: T.Text -> Parser T.Text
symbol :: Text -> ParsecT Void Text Identity Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lexer.symbol Parser ()
spaceConsumer

-- | Parser for "!".
bang :: Parser T.Text
bang :: ParsecT Void Text Identity Text
bang = Text -> ParsecT Void Text Identity Text
symbol Text
"!"

-- | Parser for "$".
dollar :: Parser T.Text
dollar :: ParsecT Void Text Identity Text
dollar = Text -> ParsecT Void Text Identity Text
symbol Text
"$"

-- | Parser for "@".
at :: Parser ()
at :: Parser ()
at = ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> Parser ())
-> ParsecT Void Text Identity Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
"@"

-- | Parser for "&".
amp :: Parser T.Text
amp :: ParsecT Void Text Identity Text
amp = Text -> ParsecT Void Text Identity Text
symbol Text
"&"

-- | Parser for ":".
colon :: Parser ()
colon :: Parser ()
colon = ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> Parser ())
-> ParsecT Void Text Identity Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
":"

-- | Parser for "=".
equals :: Parser T.Text
equals :: ParsecT Void Text Identity Text
equals = Text -> ParsecT Void Text Identity Text
symbol Text
"="

-- | Parser for the spread operator (...).
spread :: Parser T.Text
spread :: ParsecT Void Text Identity Text
spread = Text -> ParsecT Void Text Identity Text
symbol Text
"..."

-- | Parser for "|".
pipe :: Parser T.Text
pipe :: ParsecT Void Text Identity Text
pipe = Text -> ParsecT Void Text Identity Text
symbol Text
"|"

-- | Parser for an expression between "(" and ")".
parens :: forall a. Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity Text
symbol Text
"(") (Text -> ParsecT Void Text Identity Text
symbol Text
")")

-- | Parser for an expression between "[" and "]".
brackets :: forall a. Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity Text
symbol Text
"[") (Text -> ParsecT Void Text Identity Text
symbol Text
"]")

-- | Parser for an expression between "{" and "}".
braces :: forall a. Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> ParsecT Void Text Identity Text
symbol Text
"{") (Text -> ParsecT Void Text Identity Text
symbol Text
"}")

-- | Parser for strings.
string :: Parser T.Text
string :: ParsecT Void Text Identity Text
string = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void Text Identity Text
"\"" ParsecT Void Text Identity Text
"\"" ParsecT Void Text Identity Text
stringValue ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaceConsumer
  where
    stringValue :: ParsecT Void Text Identity Text
stringValue = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Char
stringCharacter
    stringCharacter :: ParsecT Void Text Identity Char
stringCharacter = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isStringCharacter1
        ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
escapeSequence
    isStringCharacter1 :: Char -> Bool
isStringCharacter1 = (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) Char -> Bool
isSourceCharacter Char -> Bool
isChunkDelimiter

-- | Parser for block strings.
blockString :: Parser T.Text
blockString :: ParsecT Void Text Identity Text
blockString = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT Void Text Identity Text
"\"\"\"" ParsecT Void Text Identity Text
"\"\"\"" ParsecT Void Text Identity Text
stringValue ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaceConsumer
  where
    stringValue :: ParsecT Void Text Identity Text
stringValue = do
        [[Text]]
byLine <- ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [[Text]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
blockStringCharacter) ParsecT Void Text Identity Text
lineTerminator
        let indentSize :: Int
indentSize = ([Text] -> Int -> Int) -> Int -> [[Text]] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Text] -> Int -> Int
countIndent Int
0 ([[Text]] -> Int) -> [[Text]] -> Int
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. HasCallStack => [a] -> [a]
tail [[Text]]
byLine
            withoutIndent :: [[Text]]
withoutIndent = [[Text]] -> [Text]
forall a. HasCallStack => [a] -> a
head [[Text]]
byLine [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: (Int -> [Text] -> [Text]
removeIndent Int
indentSize ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]] -> [[Text]]
forall a. HasCallStack => [a] -> [a]
tail [[Text]]
byLine)
            withoutEmptyLines :: [[Text]]
withoutEmptyLines = (([[Text]] -> [[Text]])
 -> ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]])
-> (([Text] -> Bool) -> [[Text]] -> [[Text]])
-> (([Text] -> Bool) -> [[Text]] -> [[Text]])
-> ([Text] -> Bool)
-> [[Text]]
-> [[Text]]
forall a b c.
(a -> b -> c)
-> (([Text] -> Bool) -> a)
-> (([Text] -> Bool) -> b)
-> ([Text] -> Bool)
-> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([[Text]] -> [[Text]])
-> ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd [Text] -> Bool
removeEmptyLine [[Text]]
withoutIndent

        Text -> ParsecT Void Text Identity Text
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [[Text]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]]
withoutEmptyLines
    removeEmptyLine :: [Text] -> Bool
removeEmptyLine [] = Bool
True
    removeEmptyLine [Text
x] = Text -> Bool
T.null Text
x Bool -> Bool -> Bool
|| Char -> Bool
isWhiteSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
x)
    removeEmptyLine [Text]
_ = Bool
False
    blockStringCharacter :: ParsecT Void Text Identity (Tokens Text)
blockStringCharacter
        = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isWhiteSpace
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isBlockStringCharacter1
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity (Tokens Text)
escapeTripleQuote
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\"" ParsecT Void Text Identity (Tokens Text)
-> Parser () -> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Tokens Text) -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\"\""))
    escapeTripleQuote :: ParsecT Void Text Identity (Tokens Text)
escapeTripleQuote = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\\" ParsecT Void Text Identity (Tokens Text)
-> (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tokens Text
 -> ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> Tokens Text
-> ParsecT Void Text Identity (Tokens Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tokens Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\"\"")
    isBlockStringCharacter1 :: Char -> Bool
isBlockStringCharacter1 = (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) Char -> Bool
isSourceCharacter Char -> Bool
isChunkDelimiter
    countIndent :: [Text] -> Int -> Int
countIndent [] Int
acc = Int
acc
    countIndent (Text
x:[Text]
_) Int
acc
        | Text -> Bool
T.null Text
x = Int
acc
        | Bool -> Bool
not (Char -> Bool
isWhiteSpace (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
x) = Int
acc
        | Int
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text -> Int
T.length Text
x
        | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
acc (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
x
    removeIndent :: Int -> [Text] -> [Text]
removeIndent Int
_ [] = []
    removeIndent Int
n (Text
x:[Text]
chunks) = Int -> Text -> Text
T.drop Int
n Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
chunks

-- | Parser for integers.
integer :: Integral a => Parser a
integer :: forall a. Integral a => Parser a
integer = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.decimal) ParsecT Void Text Identity a
-> String -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"IntValue"

-- | Parser for floating-point numbers.
float :: Parser Double
float :: Parser Double
float = Parser () -> Parser Double -> Parser Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Parser Double -> Parser Double
forall a. Parser a -> Parser a
lexeme Parser Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
Lexer.float) Parser Double -> String -> Parser Double
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"FloatValue"

-- | Parser for names (/[_A-Za-z][_0-9A-Za-z]*/).
name :: Parser T.Text
name :: ParsecT Void Text Identity Text
name = do
    Char
firstLetter <- ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
nameFirstLetter
    String
rest <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
nameFirstLetter ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    ()
_ <- Parser ()
spaceConsumer
    Text -> ParsecT Void Text Identity Text
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
TL.cons Char
firstLetter (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TL.pack String
rest
      where
        nameFirstLetter :: ParsecT Void Text Identity (Token Text)
nameFirstLetter = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAsciiUpper ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAsciiLower ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_'

isChunkDelimiter :: Char -> Bool
isChunkDelimiter :: Char -> Bool
isChunkDelimiter = (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char
'"', Char
'\\', Char
'\n', Char
'\r']

isWhiteSpace :: Char -> Bool
isWhiteSpace :: Char -> Bool
isWhiteSpace = (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

lineTerminator :: Parser T.Text
lineTerminator :: ParsecT Void Text Identity Text
lineTerminator = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\r\n" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\n" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Text
Tokens Text
"\r"

isSourceCharacter :: Char -> Bool
isSourceCharacter :: Char -> Bool
isSourceCharacter = Int -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isSourceCharacter' (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    isSourceCharacter' :: a -> Bool
isSourceCharacter' a
code = a
code a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x0020
                           Bool -> Bool -> Bool
|| a
code a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x0009
                           Bool -> Bool -> Bool
|| a
code a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x000a
                           Bool -> Bool -> Bool
|| a
code a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0x000d

escapeSequence :: Parser Char
escapeSequence :: ParsecT Void Text Identity Char
escapeSequence = do
    Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
    Char
escaped <- [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'"', Char
'\\', Char
'/', Char
'b', Char
'f', Char
'n', Char
'r', Char
't', Char
'u']
    case Char
escaped of
        Char
'b' -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
        Char
'f' -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
        Char
'n' -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
        Char
'r' -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
        Char
't' -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
        Char
'u' -> Int -> Char
chr (Int -> Char) -> (Text -> Int) -> Text -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Char -> Int
step Int
0
                   (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Text -> Tokens Text -> [Token Text]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy Text
forall {k} (t :: k). Proxy t
Proxy :: Proxy T.Text)
                 (Text -> Char)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Int -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
takeP Maybe String
forall a. Maybe a
Nothing Int
4
        Char
_ -> Char -> ParsecT Void Text Identity Char
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
escaped
  where
    step :: Int -> Char -> Int
step Int
accumulator = (Int
accumulator Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt

-- | Parser for the "Byte Order Mark".
unicodeBOM :: Parser ()
unicodeBOM :: Parser ()
unicodeBOM = ParsecT Void Text Identity (Maybe Char) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Maybe Char) -> Parser ())
-> ParsecT Void Text Identity (Maybe Char) -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity (Maybe Char))
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\xfeff'

-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
token String
extensionLabel NonEmpty (Parser a)
parsers
    = (Parser a -> Parser a -> Parser a)
-> Parser a -> [Parser a] -> Parser a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser a -> Parser a -> Parser a
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
combine Parser a
headParser (NonEmpty (Parser a) -> [Parser a]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty (Parser a)
parsers)
    Parser a -> String -> Parser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
extensionLabel
  where
    headParser :: Parser a
headParser = Parser a -> Parser a
forall a. Parser a -> Parser a
tryExtension (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Parser a) -> Parser a
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (Parser a)
parsers
    combine :: ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
combine ParsecT Void Text Identity a
current ParsecT Void Text Identity a
accumulated = ParsecT Void Text Identity a
accumulated ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a. Parser a -> Parser a
tryExtension ParsecT Void Text Identity a
current
    tryExtension :: ParsecT Void Text Identity a -> ParsecT Void Text Identity a
tryExtension ParsecT Void Text Identity a
extensionParser = ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
        (ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
"extend"
        ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ParsecT Void Text Identity Text
symbol Text
token
        ParsecT Void Text Identity Text
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity a
extensionParser