{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Parsing.Internal.Terms
( name,
variable,
varName,
ignoredTokens,
parseString,
collection,
setOf,
uniqTuple,
uniqTupleOpt,
parseTypeCondition,
spreadLiteral,
parseAlias,
sepByAnd,
parseName,
parseType,
keyword,
optDescription,
optionalCollection,
parseTypeName,
pipe,
brackets,
equal,
colon,
at,
symbol,
)
where
import Data.ByteString.Lazy.Internal (ByteString)
import Data.Mergeable.IsMap (FromList)
import Data.Morpheus.Ext.Result (GQLResult)
import Data.Morpheus.Internal.Utils
( Empty (..),
KeyOf,
fromElems,
fromLBS,
)
import Data.Morpheus.Parsing.Internal.Internal
( Parser,
Position,
getLocation,
)
import Data.Morpheus.Parsing.Internal.SourceText
( ignoredTokens,
ignoredTokens1,
parseStringBS,
)
import Data.Morpheus.Types.Internal.AST
( Description,
FieldName,
Ref (..),
TypeName,
TypeRef (..),
TypeWrapper (..),
packName,
)
import qualified Data.Morpheus.Types.Internal.AST as AST
import Data.Morpheus.Types.Internal.AST.Name (Name)
import Relude hiding (ByteString, empty, many)
import Text.Megaparsec
( between,
label,
sepBy,
sepBy1,
sepEndBy,
takeWhile1P,
takeWhileP,
try,
(<?>),
)
import Text.Megaparsec.Byte
( char,
string,
)
#define COLON 58
#define AT 64
#define EQUAL 61
#define PIPE 124
#define DOLLAR 36
#define AMPERSAND 38
#define UNDERSCORE 95
#define BANG 33
#define CHAR_A 65
#define CHAR_Z 90
#define CHAR_a 97
#define CHAR_z 122
#define DIGIT_0 48
#define DIGIT_9 57
symbol :: Word8 -> Parser ()
symbol :: Word8 -> Parser ()
symbol Word8
x = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Word8
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens
{-# INLINE symbol #-}
colon :: Parser ()
colon :: Parser ()
colon = Word8 -> Parser ()
symbol COLON
{-# INLINE colon #-}
at :: Parser ()
at :: Parser ()
at = Word8 -> Parser ()
symbol Word8
AT
{-# INLINE at #-}
equal :: Parser ()
equal :: Parser ()
equal = Word8 -> Parser ()
symbol EQUAL
{-# INLINE equal #-}
pipe :: Parser a -> Parser [a]
pipe :: forall a. Parser a -> Parser [a]
pipe Parser a
x = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser ()
symbol PIPE) *> Parser a
(x `sepBy1` symbol PIPE)
{-# INLINE pipe #-}
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = 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)
{-# INLINE parens #-}
braces :: Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = 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)
{-# INLINE braces #-}
brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = 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)
{-# INLINE brackets #-}
name :: Parser AST.Token
name :: Parser Token
name =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Name" forall a b. (a -> b) -> a -> b
$
ByteString -> Token
fromLBS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing forall {a}. (Ord a, Num a) => a -> Bool
isStartChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing forall {a}. (Ord a, Num a) => a -> Bool
isContinueChar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
where
isStartChar :: a -> Bool
isStartChar a
x =
(a
x forall a. Ord a => a -> a -> Bool
>= CHAR_a && x <= CHAR_z)
Bool -> Bool -> Bool
|| (a
x forall a. Ord a => a -> a -> Bool
>= CHAR_A && x <= CHAR_Z)
Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== UNDERSCORE
{-# INLINE isStartChar #-}
isContinueChar :: a -> Bool
isContinueChar a
x =
forall {a}. (Ord a, Num a) => a -> Bool
isStartChar a
x
Bool -> Bool -> Bool
|| (a
x forall a. Ord a => a -> a -> Bool
>= DIGIT_0 && x <= DIGIT_9)
{-# INLINE isContinueChar #-}
{-# INLINE name #-}
parseName :: Parser (Name t)
parseName :: forall (t :: NAME). Parser (Name t)
parseName = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token
name
{-# INLINE parseName #-}
parseTypeName :: Parser TypeName
parseTypeName :: Parser TypeName
parseTypeName = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token
name
{-# INLINE parseTypeName #-}
keyword :: ByteString -> Parser ()
keyword :: ByteString -> Parser ()
keyword ByteString
x = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string ByteString
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens1
{-# INLINE keyword #-}
varName :: Parser FieldName
varName :: Parser FieldName
varName = Word8 -> Parser ()
symbol DOLLAR *> parseName <* ignoredTokens
{-# INLINE varName #-}
variable :: Parser (Ref FieldName)
variable :: Parser (Ref FieldName)
variable =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"variable" forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall name. name -> Position -> Ref name
Ref
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Position
getLocation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FieldName
varName
{-# INLINE variable #-}
optDescription :: Parser (Maybe Description)
optDescription :: Parser (Maybe Token)
optDescription = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Token
parseString
{-# INLINE optDescription #-}
parseString :: Parser AST.Token
parseString :: Parser Token
parseString = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"String" forall a b. (a -> b) -> a -> b
$ ByteString -> Token
fromLBS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult ByteString
parseStringBS
{-# INLINE parseString #-}
sepByAnd :: Parser a -> Parser [a]
sepByAnd :: forall a. Parser a -> Parser [a]
sepByAnd Parser a
entry = Parser a
entry forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser ()
symbol AMPERSAND) *> ignoredTokens)
{-# INLINE sepByAnd #-}
collection :: Parser a -> Parser [a]
collection :: forall a. Parser a -> Parser [a]
collection Parser a
entry = forall a. Parser a -> Parser a
braces (Parser a
entry forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` Parser ()
ignoredTokens)
{-# INLINE collection #-}
setOf :: (FromList GQLResult map k a, KeyOf k a) => Parser a -> Parser (map k a)
setOf :: forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf = forall a. Parser a -> Parser [a]
collection forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
{-# INLINE setOf #-}
optionalCollection :: (Empty c) => Parser c -> Parser c
optionalCollection :: forall c. Empty c => Parser c -> Parser c
optionalCollection Parser c
x = Parser c
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall coll. Empty coll => coll
empty
{-# INLINE optionalCollection #-}
parseNonNull :: Parser Bool
parseNonNull :: Parser Bool
parseNonNull = (Word8 -> Parser ()
symbol BANG $> True) <|> pure False
{-# INLINE parseNonNull #-}
uniqTuple :: (FromList GQLResult map k a, KeyOf k a) => Parser a -> Parser (map k a)
uniqTuple :: forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTuple Parser a
parser =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Tuple" forall a b. (a -> b) -> a -> b
$
forall a. Parser a -> Parser a
parens
(Parser a
parser forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parser ()
ignoredTokens forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"empty Tuple value!")
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
{-# INLINE uniqTuple #-}
uniqTupleOpt ::
( FromList GQLResult map k a,
Empty (map k a),
KeyOf k a
) =>
Parser a ->
Parser (map k a)
uniqTupleOpt :: forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, Empty (map k a), KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTupleOpt Parser a
x = forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTuple Parser a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall coll. Empty coll => coll
empty
{-# INLINE uniqTupleOpt #-}
parseTypeCondition :: Parser TypeName
parseTypeCondition :: Parser TypeName
parseTypeCondition = ByteString -> Parser ()
keyword ByteString
"on" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TypeName
parseTypeName
{-# INLINE parseTypeCondition #-}
spreadLiteral :: Parser Position
spreadLiteral :: Parser Position
spreadLiteral = Parser Position
getLocation forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"..." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINE spreadLiteral #-}
parseAlias :: Parser (Maybe FieldName)
parseAlias :: Parser (Maybe FieldName)
parseAlias = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (t :: NAME). Parser (Name t)
alias) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
where
alias :: ParsecT MyError ByteString GQLResult (Name t)
alias = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"alias" (forall (t :: NAME). Parser (Name t)
parseName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon)
{-# INLINE parseAlias #-}
parseType :: Parser TypeRef
parseType :: Parser TypeRef
parseType = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TypeName -> TypeWrapper -> TypeRef
TypeRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
unwrapped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
wrapped)
where
unwrapped :: Parser (TypeName, TypeWrapper)
unwrapped :: ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
unwrapped = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
parseTypeName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> TypeWrapper
BaseType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseNonNull)
{-# INLINE unwrapped #-}
wrapped :: Parser (TypeName, TypeWrapper)
wrapped :: ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
wrapped = do
(TypeName
typename, TypeWrapper
wrapper) <- forall a. Parser a -> Parser a
brackets (ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
unwrapped forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
wrapped)
Bool
isRequired <- Parser Bool
parseNonNull
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeName
typename, TypeWrapper -> Bool -> TypeWrapper
TypeList TypeWrapper
wrapper Bool
isRequired)
{-# INLINE wrapped #-}
{-# INLINE parseType #-}