{-# 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,
    fromElems,
    fromLBS,
  )
import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
    Position,
    getLocation,
  )
import Data.Morpheus.Parsing.Internal.SourceText
  ( ignoredTokens,
    ignoredTokens1,
    parseStringBS,
  )
import qualified Data.Morpheus.Types.Internal.AST as AST
import Data.Morpheus.Types.Internal.AST
  ( Description,
    FieldName,
    Ref (..),
    TypeName,
    TypeRef (..),
    TypeWrapper (..),
    packName,
  )
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 = Token ByteString
-> ParsecT MyError ByteString GQLResult (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 GQLResult Word8
-> Parser () -> Parser ()
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 :: Parser a -> Parser [a]
pipe Parser a
x = Parser () -> ParsecT MyError ByteString GQLResult (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser ()
symbol PIPE) *> Parser a
(x `sepBy1` symbol PIPE)
{-# INLINE pipe #-}

-- 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)
{-# INLINE parens #-}

-- 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)
{-# INLINE braces #-}

-- 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)
{-# INLINE brackets #-}

-- 2.1.9 Names
-- https://spec.graphql.org/draft/#Name
-- Name
name :: Parser AST.Token
name :: Parser Token
name =
  String -> Parser Token -> Parser Token
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Name" (Parser Token -> Parser Token) -> Parser Token -> Parser Token
forall a b. (a -> b) -> a -> b
$
    ByteString -> Token
fromLBS (ByteString -> Token)
-> ParsecT MyError ByteString GQLResult ByteString -> Parser Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> ParsecT MyError ByteString GQLResult ByteString
-> ParsecT MyError ByteString GQLResult (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token ByteString -> Bool)
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Token ByteString -> Bool
forall a. (Ord a, Num a) => a -> Bool
isStartChar ParsecT MyError ByteString GQLResult (ByteString -> ByteString)
-> ParsecT MyError ByteString GQLResult ByteString
-> ParsecT MyError ByteString GQLResult ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
-> (Token ByteString -> Bool)
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing Token ByteString -> Bool
forall a. (Ord a, Num a) => a -> Bool
isContinueChar
      Parser Token -> Parser () -> Parser Token
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
  where
    isStartChar :: a -> Bool
isStartChar a
x =
      (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= CHAR_a && x <= CHAR_z)
        Bool -> Bool -> Bool
|| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= CHAR_A && x <= CHAR_Z)
        Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== UNDERSCORE
    {-# INLINE isStartChar #-}
    isContinueChar :: a -> Bool
isContinueChar a
x =
      a -> Bool
forall a. (Ord a, Num a) => a -> Bool
isStartChar a
x
        Bool -> Bool -> Bool
|| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= DIGIT_0 && x <= DIGIT_9) -- digit
    {-# INLINE isContinueChar #-}
{-# INLINE name #-}

parseName :: Parser (Name t)
parseName :: Parser (Name t)
parseName = Token -> Name t
forall a (t :: NAME). NamePacking a => a -> Name t
packName (Token -> Name t) -> Parser Token -> Parser (Name t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Token
name
{-# INLINE parseName #-}

parseTypeName :: Parser TypeName
parseTypeName :: Parser TypeName
parseTypeName = Token -> TypeName
forall a (t :: NAME). NamePacking a => a -> Name t
packName (Token -> TypeName) -> Parser Token -> Parser TypeName
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 = Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string ByteString
Tokens ByteString
x ParsecT MyError ByteString GQLResult ByteString
-> Parser () -> Parser ()
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 : https://graphql.github.io/graphql-spec/June2018/#Variable
--
-- Variable :  $Name
--
variable :: Parser (Ref FieldName)
variable :: Parser (Ref FieldName)
variable =
  String -> Parser (Ref FieldName) -> Parser (Ref FieldName)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"variable" (Parser (Ref FieldName) -> Parser (Ref FieldName))
-> Parser (Ref FieldName) -> Parser (Ref FieldName)
forall a b. (a -> b) -> a -> b
$
    (FieldName -> Position -> Ref FieldName)
-> Position -> FieldName -> Ref FieldName
forall a b c. (a -> b -> c) -> b -> a -> c
flip FieldName -> Position -> Ref FieldName
forall name. name -> Position -> Ref name
Ref
      (Position -> FieldName -> Ref FieldName)
-> ParsecT MyError ByteString GQLResult Position
-> ParsecT
     MyError ByteString GQLResult (FieldName -> Ref FieldName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult Position
getLocation
      ParsecT MyError ByteString GQLResult (FieldName -> Ref FieldName)
-> Parser FieldName -> Parser (Ref FieldName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FieldName
varName
{-# INLINE variable #-}

-- Descriptions: https://graphql.github.io/graphql-spec/June2018/#Description
--
-- Description:
--   StringValue
optDescription :: Parser (Maybe Description)
optDescription :: Parser (Maybe Token)
optDescription = Parser Token -> Parser (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Token
parseString
{-# INLINE optDescription #-}

parseString :: Parser AST.Token
parseString :: Parser Token
parseString = String -> Parser Token -> Parser Token
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"String" (Parser Token -> Parser Token) -> Parser Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
fromLBS (ByteString -> Token)
-> ParsecT MyError ByteString GQLResult ByteString -> Parser Token
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 :: Parser a -> Parser [a]
sepByAnd Parser a
entry = Parser a
entry Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` (Parser () -> ParsecT MyError ByteString GQLResult (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser ()
symbol AMPERSAND) *> ignoredTokens)
{-# INLINE sepByAnd #-}

-----------------------------
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 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 :: Parser a -> Parser (map k a)
setOf = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
collection (Parser a -> Parser [a])
-> ([a] -> Parser (map k a)) -> Parser a -> Parser (map k a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> GQLResult (map k a) -> Parser (map k a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GQLResult (map k a) -> Parser (map k a))
-> ([a] -> GQLResult (map k a)) -> [a] -> Parser (map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> GQLResult (map k a)
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 :: 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 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 :: Parser a -> Parser (map k a)
uniqTuple Parser a
parser =
  String -> Parser (map k a) -> Parser (map k a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Tuple" (Parser (map k a) -> Parser (map k a))
-> Parser (map k a) -> Parser (map k a)
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 sep. MonadPlus m => m a -> m sep -> 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 (map k a)) -> Parser (map k a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLResult (map k a) -> Parser (map k a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GQLResult (map k a) -> Parser (map k a))
-> ([a] -> GQLResult (map k a)) -> [a] -> Parser (map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> GQLResult (map k a)
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 :: Parser a -> Parser (map k a)
uniqTupleOpt Parser a
x = Parser a -> Parser (map k a)
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
uniqTuple Parser a
x Parser (map k a) -> Parser (map k a) -> Parser (map k a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> map k a -> Parser (map k a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure map k a
forall coll. Empty coll => coll
empty
{-# INLINE uniqTupleOpt #-}

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

spreadLiteral :: Parser Position
spreadLiteral :: ParsecT MyError ByteString GQLResult Position
spreadLiteral = ParsecT MyError ByteString GQLResult Position
getLocation ParsecT MyError ByteString GQLResult Position
-> ParsecT MyError ByteString GQLResult ByteString
-> ParsecT MyError ByteString GQLResult Position
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"..." ParsecT MyError ByteString GQLResult Position
-> Parser () -> ParsecT MyError ByteString GQLResult Position
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINE spreadLiteral #-}

-- 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
forall (t :: NAME). Parser (Name t)
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 :: ParsecT MyError ByteString GQLResult (Name t)
alias = String
-> ParsecT MyError ByteString GQLResult (Name t)
-> ParsecT MyError ByteString GQLResult (Name t)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"alias" (ParsecT MyError ByteString GQLResult (Name t)
forall (t :: NAME). Parser (Name t)
parseName ParsecT MyError ByteString GQLResult (Name t)
-> Parser () -> ParsecT MyError ByteString GQLResult (Name t)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon)
{-# INLINE parseAlias #-}

parseType :: Parser TypeRef
parseType :: Parser TypeRef
parseType = (TypeName -> TypeWrapper -> TypeRef)
-> (TypeName, TypeWrapper) -> TypeRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TypeName -> TypeWrapper -> TypeRef
TypeRef ((TypeName, TypeWrapper) -> TypeRef)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> Parser TypeRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
unwrapped ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
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 = (,) (TypeName -> TypeWrapper -> (TypeName, TypeWrapper))
-> Parser TypeName
-> ParsecT
     MyError
     ByteString
     GQLResult
     (TypeWrapper -> (TypeName, TypeWrapper))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
parseTypeName ParsecT
  MyError
  ByteString
  GQLResult
  (TypeWrapper -> (TypeName, TypeWrapper))
-> ParsecT MyError ByteString GQLResult TypeWrapper
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> TypeWrapper
BaseType (Bool -> TypeWrapper)
-> Parser Bool -> ParsecT MyError ByteString GQLResult TypeWrapper
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) <- ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
forall a. Parser a -> Parser a
brackets (ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
unwrapped ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
wrapped)
      Bool
isRequired <- Parser Bool
parseNonNull
      (TypeName, TypeWrapper)
-> ParsecT MyError ByteString GQLResult (TypeName, TypeWrapper)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeName
typename, TypeWrapper -> Bool -> TypeWrapper
TypeList TypeWrapper
wrapper Bool
isRequired)
    {-# INLINE wrapped #-}
{-# INLINE parseType #-}