{-# 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

-- | 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 (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 (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 :: Parser a -> Parser a
lexeme = Parser () -> Parser a -> Parser 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 -> Parser 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 :: Parser Text
bang = Text -> Parser Text
symbol Text
"!"

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

-- | Parser for "@".
at :: Parser ()
at :: Parser ()
at = Text -> Parser Text
symbol Text
"@" Parser Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

-- | Parser for ":".
colon :: Parser ()
colon :: Parser ()
colon = Text -> Parser Text
symbol Text
":" Parser Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

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

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

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

-- | Parser for strings.
string :: Parser T.Text
string :: Parser Text
string = Parser Text -> Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between Parser Text
"\"" Parser Text
"\"" Parser Text
stringValue Parser Text -> Parser () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaceConsumer
  where
    stringValue :: Parser Text
stringValue = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
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 (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 (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 :: Parser Text
blockString = Parser Text -> Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between Parser Text
"\"\"\"" Parser Text
"\"\"\"" Parser Text
stringValue Parser Text -> Parser () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaceConsumer
  where
    stringValue :: Parser Text
stringValue = do
        [[Text]]
byLine <- ParsecT Void Text Identity [Text]
-> Parser Text -> ParsecT Void Text Identity [[Text]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Parser Text -> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
ParsecT Void Text Identity (Tokens Text)
blockStringCharacter) Parser Text
lineTerminator
        let indentSize :: Int
indentSize = ([Text] -> Int -> Int) -> Int -> [[Text]] -> Int
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. [a] -> [a]
tail [[Text]]
byLine
            withoutIndent :: [[Text]]
withoutIndent = [[Text]] -> [Text]
forall a. [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. [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 (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 -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser 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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Tokens Text) -> 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 (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 (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
$ 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 :: Parser a
integer = Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Parser a -> Parser a
forall a. Parser a -> Parser a
lexeme Parser a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lexer.decimal) Parser a -> String -> Parser 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 (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 :: Parser Text
name = do
    Char
firstLetter <- ParsecT Void Text Identity Char
nameFirstLetter
    String
rest <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
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
nameFirstLetter ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    ()
_ <- Parser ()
spaceConsumer
    Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser 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 Char
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 Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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 Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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 (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 :: Parser Text
lineTerminator = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"\r\n" Parser Text -> Parser Text -> Parser Text
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 Tokens Text
"\n" Parser Text -> Parser Text -> Parser Text
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 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 (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
        Char
'f' -> Char -> ParsecT Void Text Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
        Char
'n' -> Char -> ParsecT Void Text Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
        Char
'r' -> Char -> ParsecT Void Text Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
        Char
't' -> Char -> ParsecT Void Text Identity Char
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 (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) -> Parser 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 (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 Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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') ParsecT Void Text Identity (Maybe Char) -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend :: 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 (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 (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 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 -> Parser Text
symbol Text
"extend"
        Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
symbol Text
token
        Parser Text
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity a
extensionParser