{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
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)
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
',')
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
comment :: Parser ()
= Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
Lexer.skipLineComment Tokens Text
"#"
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 :: 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
bang :: Parser T.Text
bang :: ParsecT Void Text Identity Text
bang = Text -> ParsecT Void Text Identity Text
symbol Text
"!"
dollar :: Parser T.Text
dollar :: ParsecT Void Text Identity Text
dollar = Text -> ParsecT Void Text Identity Text
symbol Text
"$"
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
"@"
amp :: Parser T.Text
amp :: ParsecT Void Text Identity Text
amp = Text -> ParsecT Void Text Identity Text
symbol Text
"&"
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
":"
equals :: Parser T.Text
equals :: ParsecT Void Text Identity Text
equals = Text -> ParsecT Void Text Identity Text
symbol Text
"="
spread :: Parser T.Text
spread :: ParsecT Void Text Identity Text
spread = Text -> ParsecT Void Text Identity Text
symbol Text
"..."
pipe :: Parser T.Text
pipe :: ParsecT Void Text Identity Text
pipe = Text -> ParsecT Void Text Identity Text
symbol Text
"|"
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
")")
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
"]")
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
"}")
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
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
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"
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"
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
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'
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