{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Parsing.Internal.Value
  ( enumValue,
    parseDefaultValue,
    Parse (..),
  )
where

import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
  )
import Data.Morpheus.Parsing.Internal.Terms
  ( brackets,
    colon,
    equal,
    ignoredTokens,
    parseName,
    parseString,
    parseTypeName,
    setOf,
    symbol,
    variable,
  )
import Data.Morpheus.Types.Internal.AST
  ( CONST,
    FieldName,
    ObjectEntry (..),
    OrdMap,
    RAW,
    ScalarValue (..),
    Value (..),
    decodeScientific,
  )
import Relude
import Text.Megaparsec
  ( label,
    sepBy,
  )
import Text.Megaparsec.Byte
  ( string,
  )
import Text.Megaparsec.Byte.Lexer (scientific)

-- '-'
#define MINUS 45

valueNull :: Parser (Value a)
valueNull :: Parser (Value a)
valueNull = Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"null" ParsecT MyError ByteString GQLResult ByteString
-> Value a -> Parser (Value a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value a
forall (stage :: Stage). Value stage
Null
{-# INLINE valueNull #-}

booleanValue :: Parser (Value a)
booleanValue :: Parser (Value a)
booleanValue =
  ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Bool -> ScalarValue) -> Bool -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean
    (Bool -> Value a)
-> ParsecT MyError ByteString GQLResult Bool -> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Tokens ByteString
-> ParsecT MyError ByteString GQLResult (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"true" ParsecT MyError ByteString GQLResult ByteString
-> Bool -> ParsecT MyError ByteString GQLResult Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
            ParsecT MyError ByteString GQLResult Bool
-> ParsecT MyError ByteString GQLResult Bool
-> ParsecT MyError ByteString GQLResult Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> 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
"false" ParsecT MyError ByteString GQLResult ByteString
-> Bool -> ParsecT MyError ByteString GQLResult Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
        )
{-# INLINE booleanValue #-}

valueNumber :: Parser (Value a)
valueNumber :: Parser (Value a)
valueNumber = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Scientific -> ScalarValue) -> Scientific -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> ScalarValue
decodeScientific (Scientific -> Value a)
-> ParsecT MyError ByteString GQLResult Scientific
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) (Scientific -> Scientific -> Scientific)
-> ParsecT MyError ByteString GQLResult Scientific
-> ParsecT MyError ByteString GQLResult (Scientific -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult Scientific
negation ParsecT MyError ByteString GQLResult (Scientific -> Scientific)
-> ParsecT MyError ByteString GQLResult Scientific
-> ParsecT MyError ByteString GQLResult Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString GQLResult Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
scientific)
  where
    negation :: ParsecT MyError ByteString GQLResult Scientific
negation = (Word8 -> Parser ()
symbol MINUS $> (-1) <* ignoredTokens) <|> pure 1
    {-# INLINE negation #-}
{-# INLINE valueNumber #-}

enumValue :: Parser (Value a)
enumValue :: Parser (Value a)
enumValue = TypeName -> Value a
forall (stage :: Stage). TypeName -> Value stage
Enum (TypeName -> Value a)
-> ParsecT MyError ByteString GQLResult TypeName
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult TypeName
parseTypeName Parser (Value a) -> Parser () -> Parser (Value a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINE enumValue #-}

stringValue :: Parser (Value a)
stringValue :: Parser (Value a)
stringValue = ScalarValue -> Value a
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (ScalarValue -> Value a)
-> (Text -> ScalarValue) -> Text -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ScalarValue
String (Text -> Value a)
-> ParsecT MyError ByteString GQLResult Text -> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult Text
parseString
{-# INLINE stringValue #-}

listValue :: Parser a -> Parser [a]
listValue :: Parser a -> Parser [a]
listValue Parser a
parser = String -> Parser [a] -> Parser [a]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"List" (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
brackets (Parser a
parser Parser a -> Parser () -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parser ()
ignoredTokens)
{-# INLINE listValue #-}

objectEntry :: Parser (Value a) -> Parser (ObjectEntry a)
objectEntry :: Parser (Value a) -> Parser (ObjectEntry a)
objectEntry Parser (Value a)
parser = FieldName -> Value a -> ObjectEntry a
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry (FieldName -> Value a -> ObjectEntry a)
-> ParsecT MyError ByteString GQLResult FieldName
-> ParsecT MyError ByteString GQLResult (Value a -> ObjectEntry a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT MyError ByteString GQLResult FieldName
forall (t :: NAME). Parser (Name t)
parseName ParsecT MyError ByteString GQLResult FieldName
-> Parser () -> ParsecT MyError ByteString GQLResult FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon) ParsecT MyError ByteString GQLResult (Value a -> ObjectEntry a)
-> Parser (Value a) -> Parser (ObjectEntry a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Value a)
parser
{-# INLINE objectEntry #-}

objectValue :: Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a))
objectValue :: Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a))
objectValue = String
-> Parser (OrdMap FieldName (ObjectEntry a))
-> Parser (OrdMap FieldName (ObjectEntry a))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ObjectValue" (Parser (OrdMap FieldName (ObjectEntry a))
 -> Parser (OrdMap FieldName (ObjectEntry a)))
-> (Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a)))
-> Parser (Value a)
-> Parser (OrdMap FieldName (ObjectEntry a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (ObjectEntry a) -> Parser (OrdMap FieldName (ObjectEntry a))
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf (Parser (ObjectEntry a)
 -> Parser (OrdMap FieldName (ObjectEntry a)))
-> (Parser (Value a) -> Parser (ObjectEntry a))
-> Parser (Value a)
-> Parser (OrdMap FieldName (ObjectEntry a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Value a) -> Parser (ObjectEntry a)
forall (a :: Stage). Parser (Value a) -> Parser (ObjectEntry a)
objectEntry
{-# INLINE objectValue #-}

parsePrimitives :: Parser (Value a)
parsePrimitives :: Parser (Value a)
parsePrimitives =
  Parser (Value a)
forall (a :: Stage). Parser (Value a)
valueNull
    Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value a)
forall (a :: Stage). Parser (Value a)
booleanValue
    Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value a)
forall (a :: Stage). Parser (Value a)
valueNumber
    Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value a)
forall (a :: Stage). Parser (Value a)
enumValue
    Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value a)
forall (a :: Stage). Parser (Value a)
stringValue
{-# INLINE parsePrimitives #-}

parseDefaultValue :: Parser (Value s)
parseDefaultValue :: Parser (Value s)
parseDefaultValue = Parser ()
equal Parser () -> Parser (Value s) -> Parser (Value s)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Value s)
forall (a :: Stage). Parser (Value a)
parseV
  where
    parseV :: Parser (Value s)
    parseV :: Parser (Value s)
parseV = Parser (Value s) -> Parser (Value s)
forall (a :: Stage). Parser (Value a) -> Parser (Value a)
compoundValue Parser (Value s)
forall (a :: Stage). Parser (Value a)
parseV

class Parse a where
  parse :: Parser a

instance Parse (Value RAW) where
  parse :: Parser (Value RAW)
parse = (Ref FieldName -> Value RAW
VariableValue (Ref FieldName -> Value RAW)
-> ParsecT MyError ByteString GQLResult (Ref FieldName)
-> Parser (Value RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult (Ref FieldName)
variable) Parser (Value RAW) -> Parser (Value RAW) -> Parser (Value RAW)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value RAW) -> Parser (Value RAW)
forall (a :: Stage). Parser (Value a) -> Parser (Value a)
compoundValue Parser (Value RAW)
forall a. Parse a => Parser a
parse

instance Parse (Value CONST) where
  parse :: Parser (Value CONST)
parse = Parser (Value CONST) -> Parser (Value CONST)
forall (a :: Stage). Parser (Value a) -> Parser (Value a)
compoundValue Parser (Value CONST)
forall a. Parse a => Parser a
parse

compoundValue :: Parser (Value a) -> Parser (Value a)
compoundValue :: Parser (Value a) -> Parser (Value a)
compoundValue Parser (Value a)
parser =
  String -> Parser (Value a) -> Parser (Value a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Value" (Parser (Value a) -> Parser (Value a))
-> Parser (Value a) -> Parser (Value a)
forall a b. (a -> b) -> a -> b
$
    ( Parser (Value a)
forall (a :: Stage). Parser (Value a)
parsePrimitives
        Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object a -> Value a
forall (stage :: Stage). Object stage -> Value stage
Object (Object a -> Value a)
-> ParsecT MyError ByteString GQLResult (Object a)
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Value a) -> ParsecT MyError ByteString GQLResult (Object a)
forall (a :: Stage).
Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a))
objectValue Parser (Value a)
parser)
        Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Value a] -> Value a
forall (stage :: Stage). [Value stage] -> Value stage
List ([Value a] -> Value a)
-> ParsecT MyError ByteString GQLResult [Value a]
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Value a) -> ParsecT MyError ByteString GQLResult [Value a]
forall a. Parser a -> Parser [a]
listValue Parser (Value a)
parser)
    )
      Parser (Value a) -> Parser () -> Parser (Value a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens