{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Parsing.Internal.Terms
  ( name,
    variable,
    varName,
    ignoredTokens,
    parseString,
    collection,
    setOf,
    uniqTuple,
    uniqTupleOpt,
    parseTypeCondition,
    spreadLiteral,
    parseNonNull,
    parseWrappedType,
    parseAlias,
    sepByAnd,
    parseName,
    parseType,
    keyword,
    symbol,
    optDescription,
    optionalCollection,
    parseNegativeSign,
    parseTypeName,
    pipe,
    fieldNameColon,
    brackets,
    equal,
    comma,
    colon,
    at,
  )
where

import Data.ByteString.Lazy
  ( pack,
  )
import Data.Morpheus.Internal.Utils
  ( Collection,
    FromElems (..),
    KeyOf,
    empty,
    fromElems,
    fromLBS,
    toLBS,
  )
import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
    Position,
    getLocation,
  )
import Data.Morpheus.Types.Internal.AST
  ( DataTypeWrapper (..),
    Description,
    FieldName (..),
    Ref (..),
    Token,
    TypeName (..),
    TypeRef (..),
    toHSWrappers,
  )
import Data.Morpheus.Types.Internal.Resolving (Eventless)
import Data.Text
  ( strip,
  )
import Relude hiding (empty, many)
import Text.Megaparsec
  ( (<?>),
    between,
    choice,
    label,
    many,
    manyTill,
    sepBy,
    sepBy1,
    sepEndBy,
    skipManyTill,
    try,
  )
import Text.Megaparsec.Byte
  ( char,
    digitChar,
    letterChar,
    newline,
    printChar,
    space,
    space1,
    string,
  )

parseNegativeSign :: Parser Bool
parseNegativeSign :: Parser Bool
parseNegativeSign = (Parser ()
minus Parser () -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser Bool -> Parser () -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens) Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

parseName :: Parser FieldName
parseName :: Parser FieldName
parseName = Text -> FieldName
FieldName (Text -> FieldName)
-> ParsecT MyError ByteString Eventless Text -> Parser FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Text
name

parseTypeName :: Parser TypeName
parseTypeName :: Parser TypeName
parseTypeName = String -> Parser TypeName -> Parser TypeName
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"TypeName" (Parser TypeName -> Parser TypeName)
-> Parser TypeName -> Parser TypeName
forall a b. (a -> b) -> a -> b
$ Text -> TypeName
TypeName (Text -> TypeName)
-> ParsecT MyError ByteString Eventless Text -> Parser TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Text
name

keyword :: FieldName -> Parser ()
keyword :: FieldName -> Parser ()
keyword (FieldName Text
word) = Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ByteString
toLBS Text
word) ParsecT MyError ByteString Eventless ByteString
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space1 Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens

symbol :: Word8 -> Parser ()
symbol :: Word8 -> Parser ()
symbol Word8
x = Token ByteString
-> ParsecT MyError ByteString Eventless (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Word8
Token ByteString
x ParsecT MyError ByteString Eventless Word8
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens

-- braces: {}
braces :: Parser a -> Parser a
braces :: Parser a -> Parser a
braces = Parser () -> Parser () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Word8 -> Parser ()
symbol Word8
123) (Word8 -> Parser ()
symbol Word8
125)

-- brackets: []
brackets :: Parser a -> Parser a
brackets :: Parser a -> Parser a
brackets = Parser () -> Parser () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Word8 -> Parser ()
symbol Word8
91) (Word8 -> Parser ()
symbol Word8
93)

-- parens : '()'
parens :: Parser a -> Parser a
parens :: Parser a -> Parser a
parens = Parser () -> Parser () -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Word8 -> Parser ()
symbol Word8
40) (Word8 -> Parser ()
symbol Word8
41)

-- underscore : '_'
underscore :: Parser Word8
underscore :: ParsecT MyError ByteString Eventless Word8
underscore = Token ByteString
-> ParsecT MyError ByteString Eventless (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
95

comma :: Parser ()
comma :: Parser ()
comma = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"," (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT MyError ByteString Eventless (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
44 ParsecT MyError ByteString Eventless Word8
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space

-- dollar :: $
dollar :: Parser ()
dollar :: Parser ()
dollar = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"$" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
36

-- equal :: '='
equal :: Parser ()
equal :: Parser ()
equal = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"=" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
61

-- colon :: ':'
colon :: Parser ()
colon :: Parser ()
colon = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
":" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
58

-- minus: '-'
minus :: Parser ()
minus :: Parser ()
minus = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"-" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
45

-- verticalPipe: '|'
verticalPipe :: Parser ()
verticalPipe :: Parser ()
verticalPipe = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"|" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
124

ampersand :: Parser ()
ampersand :: Parser ()
ampersand = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"&" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
38

-- at: '@'
at :: Parser ()
at :: Parser ()
at = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"@" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ()
symbol Word8
64

-- PRIMITIVE
------------------------------------

-- 2.1.9 Names
-- https://spec.graphql.org/draft/#Name
-- Name ::
--  NameStart NameContinue[list,opt]
--
name :: Parser Token
name :: ParsecT MyError ByteString Eventless Text
name =
  String
-> ParsecT MyError ByteString Eventless Text
-> ParsecT MyError ByteString Eventless Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Name" (ParsecT MyError ByteString Eventless Text
 -> ParsecT MyError ByteString Eventless Text)
-> ParsecT MyError ByteString Eventless Text
-> ParsecT MyError ByteString Eventless Text
forall a b. (a -> b) -> a -> b
$
    ByteString -> Text
fromLBS (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack
      ([Word8] -> Text)
-> ParsecT MyError ByteString Eventless [Word8]
-> ParsecT MyError ByteString Eventless Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Word8 -> [Word8] -> [Word8])
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless ([Word8] -> [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Word8
nameStart ParsecT MyError ByteString Eventless ([Word8] -> [Word8])
-> ParsecT MyError ByteString Eventless [Word8]
-> ParsecT MyError ByteString Eventless [Word8]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless [Word8]
nameContinue)
      ParsecT MyError ByteString Eventless Text
-> Parser () -> ParsecT MyError ByteString Eventless Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens

-- NameStart::
--   Letter
--   _
nameStart :: Parser Word8
nameStart :: ParsecT MyError ByteString Eventless Word8
nameStart = ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
letterChar ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless Word8
underscore

--  NameContinue::
--   Letter
--   Digit
nameContinue :: Parser [Word8]
nameContinue :: ParsecT MyError ByteString Eventless [Word8]
nameContinue = ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
letterChar ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless Word8
underscore ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
digitChar)

varName :: Parser FieldName
varName :: Parser FieldName
varName = Parser ()
dollar Parser () -> Parser FieldName -> Parser FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FieldName
parseName Parser FieldName -> Parser () -> Parser FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens

-- Variable : https://graphql.github.io/graphql-spec/June2018/#Variable
--
-- Variable :  $Name
--
variable :: Parser Ref
variable :: Parser Ref
variable =
  String -> Parser Ref -> Parser Ref
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"variable" (Parser Ref -> Parser Ref) -> Parser Ref -> Parser Ref
forall a b. (a -> b) -> a -> b
$
    (FieldName -> Position -> Ref) -> Position -> FieldName -> Ref
forall a b c. (a -> b -> c) -> b -> a -> c
flip FieldName -> Position -> Ref
Ref
      (Position -> FieldName -> Ref)
-> ParsecT MyError ByteString Eventless Position
-> ParsecT MyError ByteString Eventless (FieldName -> Ref)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Position
getLocation
      ParsecT MyError ByteString Eventless (FieldName -> Ref)
-> Parser FieldName -> Parser Ref
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FieldName
varName

-- Descriptions: https://graphql.github.io/graphql-spec/June2018/#Description
--
-- Description:
--   StringValue
parseDescription :: Parser Description
parseDescription :: ParsecT MyError ByteString Eventless Text
parseDescription = Text -> Text
strip (Text -> Text)
-> ParsecT MyError ByteString Eventless Text
-> ParsecT MyError ByteString Eventless Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Text
parseString

optDescription :: Parser (Maybe Description)
optDescription :: Parser (Maybe Text)
optDescription = ParsecT MyError ByteString Eventless Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT MyError ByteString Eventless Text
parseDescription

parseString :: Parser Token
parseString :: ParsecT MyError ByteString Eventless Text
parseString = ParsecT MyError ByteString Eventless Text
blockString ParsecT MyError ByteString Eventless Text
-> ParsecT MyError ByteString Eventless Text
-> ParsecT MyError ByteString Eventless Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless Text
singleLineString

blockString :: Parser Token
blockString :: ParsecT MyError ByteString Eventless Text
blockString = ParsecT MyError ByteString Eventless ByteString
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Text
forall quote.
Parser quote
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Text
stringWith (Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"\"\"\"") (ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
printChar ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline)

singleLineString :: Parser Token
singleLineString :: ParsecT MyError ByteString Eventless Text
singleLineString = ParsecT MyError ByteString Eventless ByteString
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Text
forall quote.
Parser quote
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Text
stringWith (Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"\"") ParsecT MyError ByteString Eventless Word8
escapedChar

stringWith :: Parser quote -> Parser Word8 -> Parser Token
stringWith :: Parser quote
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Text
stringWith Parser quote
quote ParsecT MyError ByteString Eventless Word8
parser =
  ByteString -> Text
fromLBS (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack
    ([Word8] -> Text)
-> ParsecT MyError ByteString Eventless [Word8]
-> ParsecT MyError ByteString Eventless Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser quote
quote
            Parser quote
-> ParsecT MyError ByteString Eventless [Word8]
-> ParsecT MyError ByteString Eventless [Word8]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString Eventless Word8
-> Parser quote -> ParsecT MyError ByteString Eventless [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT MyError ByteString Eventless Word8
parser Parser quote
quote
            ParsecT MyError ByteString Eventless [Word8]
-> Parser () -> ParsecT MyError ByteString Eventless [Word8]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
        )

escapedChar :: Parser Word8
escapedChar :: ParsecT MyError ByteString Eventless Word8
escapedChar = String
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"EscapedChar" (ParsecT MyError ByteString Eventless Word8
 -> ParsecT MyError ByteString Eventless Word8)
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall a b. (a -> b) -> a -> b
$ ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
printChar ParsecT MyError ByteString Eventless Word8
-> (Word8 -> ParsecT MyError ByteString Eventless Word8)
-> ParsecT MyError ByteString Eventless Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> ParsecT MyError ByteString Eventless Word8
handleEscape

handleEscape :: Word8 -> Parser Word8
handleEscape :: Word8 -> ParsecT MyError ByteString Eventless Word8
handleEscape Word8
92 = [ParsecT MyError ByteString Eventless Word8]
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT MyError ByteString Eventless Word8]
escape
handleEscape Word8
x = Word8 -> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
x

escape :: [Parser Word8]
escape :: [ParsecT MyError ByteString Eventless Word8]
escape = (Word8, Word8) -> ParsecT MyError ByteString Eventless Word8
escapeCh ((Word8, Word8) -> ParsecT MyError ByteString Eventless Word8)
-> [(Word8, Word8)] -> [ParsecT MyError ByteString Eventless Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Word8, Word8)]
escapeOptions
  where
    escapeCh :: (Word8, Word8) -> Parser Word8
    escapeCh :: (Word8, Word8) -> ParsecT MyError ByteString Eventless Word8
escapeCh (Word8
code, Word8
replacement) = Token ByteString
-> ParsecT MyError ByteString Eventless (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Word8
Token ByteString
code ParsecT MyError ByteString Eventless Word8
-> Word8 -> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Word8
replacement

escapeOptions :: [(Word8, Word8)]
escapeOptions :: [(Word8, Word8)]
escapeOptions =
  [ (Word8
98, Word8
8),
    (Word8
110, Word8
10),
    (Word8
102, Word8
12),
    (Word8
114, Word8
13),
    (Word8
116, Word8
9),
    (Word8
92, Word8
92),
    (Word8
34, Word8
34),
    (Word8
47, Word8
47)
  ]

-- Ignored Tokens : https://graphql.github.io/graphql-spec/June2018/#sec-Source-Text.Ignored-Tokens
--  Ignored:
--    UnicodeBOM
--    WhiteSpace
--    LineTerminator
--    Comment
--    Comma
ignoredTokens :: Parser ()
ignoredTokens :: Parser ()
ignoredTokens =
  String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"IgnoredTokens" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
      Parser ()
-> ParsecT MyError ByteString Eventless [()]
-> ParsecT MyError ByteString Eventless [()]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT MyError ByteString Eventless [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
ignored
      ParsecT MyError ByteString Eventless [()] -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space

ignored :: Parser ()
ignored :: Parser ()
ignored = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Ignored" (Parser ()
comment Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
comma)

comment :: Parser ()
comment :: Parser ()
comment =
  String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Comment" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    Parser ()
octothorpe Parser ()
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
-> ParsecT MyError ByteString Eventless Word8
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
printChar ParsecT MyError ByteString Eventless Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline ParsecT MyError ByteString Eventless Word8
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space

-- exclamationMark: '!'
exclamationMark :: Parser ()
exclamationMark :: Parser ()
exclamationMark = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"!" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$Word8 -> Parser ()
symbol Word8
33

-- octothorpe: '#'
octothorpe :: Parser ()
octothorpe :: Parser ()
octothorpe = String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"#" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT MyError ByteString Eventless (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
35 ParsecT MyError ByteString Eventless Word8 -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

------------------------------------------------------------------------

sepByAnd :: Parser a -> Parser [a]
sepByAnd :: Parser a -> Parser [a]
sepByAnd Parser a
entry = Parser a
entry Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` (Parser () -> ParsecT MyError ByteString Eventless (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
ampersand ParsecT MyError ByteString Eventless (Maybe ())
-> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens)

pipe :: Parser a -> Parser [a]
pipe :: Parser a -> Parser [a]
pipe Parser a
x = Parser () -> ParsecT MyError ByteString Eventless (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
verticalPipe ParsecT MyError ByteString Eventless (Maybe ())
-> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser a
x Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` Parser ()
verticalPipe)

-----------------------------
collection :: Parser a -> Parser [a]
collection :: Parser a -> Parser [a]
collection Parser a
entry = Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
braces (Parser a
entry Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepEndBy` Parser ()
ignoredTokens)

setOf :: (FromElems Eventless a coll, KeyOf k a) => Parser a -> Parser coll
setOf :: Parser a -> Parser coll
setOf = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
collection (Parser a -> Parser [a])
-> ([a] -> Parser coll) -> Parser a -> Parser coll
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Eventless coll -> Parser coll
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eventless coll -> Parser coll)
-> ([a] -> Eventless coll) -> [a] -> Parser coll
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Eventless coll
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems

optionalCollection :: Collection a c => Parser c -> Parser c
optionalCollection :: Parser c -> Parser c
optionalCollection Parser c
x = Parser c
x Parser c -> Parser c -> Parser c
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> c -> Parser c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
forall a coll. Collection a coll => coll
empty

parseNonNull :: Parser [DataTypeWrapper]
parseNonNull :: Parser [DataTypeWrapper]
parseNonNull =
  (Parser ()
exclamationMark Parser () -> [DataTypeWrapper] -> Parser [DataTypeWrapper]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [DataTypeWrapper
NonNullType])
    Parser [DataTypeWrapper]
-> Parser [DataTypeWrapper] -> Parser [DataTypeWrapper]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [DataTypeWrapper] -> Parser [DataTypeWrapper]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

uniqTuple :: (FromElems Eventless a coll, KeyOf k a) => Parser a -> Parser coll
uniqTuple :: Parser a -> Parser coll
uniqTuple Parser a
parser =
  String -> Parser coll -> Parser coll
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Tuple" (Parser coll -> Parser coll) -> Parser coll -> Parser coll
forall a b. (a -> b) -> a -> b
$
    Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
parens
      (Parser a
parser Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Parser ()
ignoredTokens Parser [a] -> String -> Parser [a]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"empty Tuple value!")
      Parser [a] -> ([a] -> Parser coll) -> Parser coll
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Eventless coll -> Parser coll
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eventless coll -> Parser coll)
-> ([a] -> Eventless coll) -> [a] -> Parser coll
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Eventless coll
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems

uniqTupleOpt :: (FromElems Eventless a coll, Collection a coll, KeyOf k a) => Parser a -> Parser coll
uniqTupleOpt :: Parser a -> Parser coll
uniqTupleOpt Parser a
x = Parser a -> Parser coll
forall a coll k.
(FromElems Eventless a coll, KeyOf k a) =>
Parser a -> Parser coll
uniqTuple Parser a
x Parser coll -> Parser coll -> Parser coll
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> coll -> Parser coll
forall (f :: * -> *) a. Applicative f => a -> f a
pure coll
forall a coll. Collection a coll => coll
empty

fieldNameColon :: Parser FieldName
fieldNameColon :: Parser FieldName
fieldNameColon = Parser FieldName
parseName Parser FieldName -> Parser () -> Parser FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon

-- Type Conditions: https://graphql.github.io/graphql-spec/June2018/#sec-Type-Conditions
--
--  TypeCondition:
--    on NamedType
--
parseTypeCondition :: Parser TypeName
parseTypeCondition :: Parser TypeName
parseTypeCondition = FieldName -> Parser ()
keyword FieldName
"on" Parser () -> Parser TypeName -> Parser TypeName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TypeName
parseTypeName

spreadLiteral :: Parser Position
spreadLiteral :: ParsecT MyError ByteString Eventless Position
spreadLiteral = ParsecT MyError ByteString Eventless Position
getLocation ParsecT MyError ByteString Eventless Position
-> ParsecT MyError ByteString Eventless ByteString
-> ParsecT MyError ByteString Eventless Position
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"..." ParsecT MyError ByteString Eventless Position
-> Parser () -> ParsecT MyError ByteString Eventless Position
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space

-- Field Alias : https://graphql.github.io/graphql-spec/June2018/#sec-Field-Alias
-- Alias
--  Name:
parseAlias :: Parser (Maybe FieldName)
parseAlias :: Parser (Maybe FieldName)
parseAlias = Parser (Maybe FieldName) -> Parser (Maybe FieldName)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser FieldName -> Parser (Maybe FieldName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FieldName
alias) Parser (Maybe FieldName)
-> Parser (Maybe FieldName) -> Parser (Maybe FieldName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FieldName -> Parser (Maybe FieldName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FieldName
forall a. Maybe a
Nothing
  where
    alias :: Parser FieldName
alias = String -> Parser FieldName -> Parser FieldName
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"alias" Parser FieldName
fieldNameColon

parseType :: Parser TypeRef
parseType :: Parser TypeRef
parseType = ([DataTypeWrapper], TypeName) -> [DataTypeWrapper] -> TypeRef
parseTypeW (([DataTypeWrapper], TypeName) -> [DataTypeWrapper] -> TypeRef)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper] -> TypeRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
parseWrappedType ParsecT MyError ByteString Eventless ([DataTypeWrapper] -> TypeRef)
-> Parser [DataTypeWrapper] -> Parser TypeRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [DataTypeWrapper]
parseNonNull

parseTypeW :: ([DataTypeWrapper], TypeName) -> [DataTypeWrapper] -> TypeRef
parseTypeW :: ([DataTypeWrapper], TypeName) -> [DataTypeWrapper] -> TypeRef
parseTypeW ([DataTypeWrapper]
wrappers, TypeName
typeConName) [DataTypeWrapper]
nonNull =
  TypeRef :: TypeName -> Maybe String -> [TypeWrapper] -> TypeRef
TypeRef
    { TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName,
      typeArgs :: Maybe String
typeArgs = Maybe String
forall a. Maybe a
Nothing,
      typeWrappers :: [TypeWrapper]
typeWrappers = [DataTypeWrapper] -> [TypeWrapper]
toHSWrappers ([DataTypeWrapper]
nonNull [DataTypeWrapper] -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. Semigroup a => a -> a -> a
<> [DataTypeWrapper]
wrappers)
    }

parseWrappedType :: Parser ([DataTypeWrapper], TypeName)
parseWrappedType :: ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
parseWrappedType = (ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
unwrapped ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
wrapped) ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> Parser ()
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
  where
    unwrapped :: Parser ([DataTypeWrapper], TypeName)
    unwrapped :: ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
unwrapped = ([],) (TypeName -> ([DataTypeWrapper], TypeName))
-> Parser TypeName
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
parseTypeName ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> Parser ()
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
    ----------------------------------------------
    wrapped :: Parser ([DataTypeWrapper], TypeName)
    wrapped :: ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
wrapped = ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall a. Parser a -> Parser a
brackets (([DataTypeWrapper], TypeName)
-> [DataTypeWrapper] -> ([DataTypeWrapper], TypeName)
wrapAsList (([DataTypeWrapper], TypeName)
 -> [DataTypeWrapper] -> ([DataTypeWrapper], TypeName))
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError
     ByteString
     Eventless
     ([DataTypeWrapper] -> ([DataTypeWrapper], TypeName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
unwrapped ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString Eventless ([DataTypeWrapper], TypeName)
wrapped) ParsecT
  MyError
  ByteString
  Eventless
  ([DataTypeWrapper] -> ([DataTypeWrapper], TypeName))
-> Parser [DataTypeWrapper]
-> ParsecT
     MyError ByteString Eventless ([DataTypeWrapper], TypeName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [DataTypeWrapper]
parseNonNull)

wrapAsList :: ([DataTypeWrapper], TypeName) -> [DataTypeWrapper] -> ([DataTypeWrapper], TypeName)
wrapAsList :: ([DataTypeWrapper], TypeName)
-> [DataTypeWrapper] -> ([DataTypeWrapper], TypeName)
wrapAsList ([DataTypeWrapper]
wrappers, TypeName
tName) [DataTypeWrapper]
nonNull = (DataTypeWrapper
ListType DataTypeWrapper -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. a -> [a] -> [a]
: [DataTypeWrapper]
nonNull [DataTypeWrapper] -> [DataTypeWrapper] -> [DataTypeWrapper]
forall a. Semigroup a => a -> a -> a
<> [DataTypeWrapper]
wrappers, TypeName
tName)