{-# 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 :: forall (a :: Stage). Parser (Value a)
valueNull = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"null" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall (stage :: Stage). Value stage
Null
{-# INLINE valueNull #-}

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

valueNumber :: Parser (Value a)
valueNumber :: forall (a :: Stage). Parser (Value a)
valueNumber = forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> ScalarValue
decodeScientific forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a -> a
(*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString GQLResult Scientific
negation forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall (a :: Stage). Parser (Value a)
enumValue = forall (stage :: Stage). TypeName -> Value stage
Enum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeName
parseTypeName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINE enumValue #-}

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

listValue :: Parser a -> Parser [a]
listValue :: forall a. Parser a -> Parser [a]
listValue Parser a
parser = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"List" forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser a
brackets (Parser a
parser 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 :: forall (a :: Stage). Parser (Value a) -> Parser (ObjectEntry a)
objectEntry Parser (Value a)
parser = forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: NAME). Parser (Name t)
parseName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon) 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 :: forall (a :: Stage).
Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a))
objectValue = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ObjectValue" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Stage). Parser (Value a) -> Parser (ObjectEntry a)
objectEntry
{-# INLINE objectValue #-}

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

parseDefaultValue :: Parser (Value s)
parseDefaultValue :: forall (a :: Stage). Parser (Value a)
parseDefaultValue = Parser ()
equal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (a :: Stage). Parser (Value a)
parseV
  where
    parseV :: Parser (Value s)
    parseV :: forall (a :: Stage). Parser (Value a)
parseV = forall (a :: Stage). Parser (Value a) -> Parser (Value a)
compoundValue 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Ref FieldName)
variable) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Stage). Parser (Value a) -> Parser (Value a)
compoundValue forall a. Parse a => Parser a
parse

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

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