{-# 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 : '()'
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: {}
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: []
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 #-}

-- 2.1.9 Names
-- https://spec.graphql.org/draft/#Name
-- Name
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) -- digit
    {-# 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 : https://graphql.github.io/graphql-spec/June2018/#Variable
--
-- Variable :  $Name
--
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 #-}

-- Descriptions: https://graphql.github.io/graphql-spec/June2018/#Description
--
-- Description:
--   StringValue
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 #-}

-- 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" 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 #-}

-- Field Alias : https://graphql.github.io/graphql-spec/June2018/#sec-Field-Alias
-- Alias
--  Name:
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 #-}