{-# 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,
    equal,
    fieldNameColon,
    ignoredTokens,
    parseNegativeSign,
    parseString,
    parseTypeName,
    setOf,
    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)

valueNull :: Parser (Value a)
valueNull :: Parser (Value a)
valueNull = Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"null" ParsecT MyError ByteString Eventless 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

booleanValue :: Parser (Value a)
booleanValue :: Parser (Value a)
booleanValue = Parser (Value a)
forall (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
boolTrue Parser (Value a) -> Parser (Value a) -> Parser (Value a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value a)
forall (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
boolFalse
  where
    boolTrue :: ParsecT MyError ByteString Eventless (Value stage)
boolTrue = Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"true" ParsecT MyError ByteString Eventless (Tokens ByteString)
-> Value stage
-> ParsecT MyError ByteString Eventless (Value stage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ScalarValue -> Value stage
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (Bool -> ScalarValue
Boolean Bool
True)
    boolFalse :: ParsecT MyError ByteString Eventless (Value stage)
boolFalse = Tokens ByteString
-> ParsecT MyError ByteString Eventless (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"false" ParsecT MyError ByteString Eventless (Tokens ByteString)
-> Value stage
-> ParsecT MyError ByteString Eventless (Value stage)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ScalarValue -> Value stage
forall (stage :: Stage). ScalarValue -> Value stage
Scalar (Bool -> ScalarValue
Boolean Bool
False)

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 Eventless Scientific
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Scientific -> Scientific
forall p. Num p => Bool -> p -> p
signedNumber (Bool -> Scientific -> Scientific)
-> ParsecT MyError ByteString Eventless Bool
-> ParsecT MyError ByteString Eventless (Scientific -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Bool
parseNegativeSign ParsecT MyError ByteString Eventless (Scientific -> Scientific)
-> ParsecT MyError ByteString Eventless Scientific
-> ParsecT MyError ByteString Eventless Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT MyError ByteString Eventless Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
scientific)
  where
    signedNumber :: Bool -> p -> p
signedNumber Bool
isNegative p
number
      | Bool
isNegative = - p
number
      | Bool
otherwise = p
number

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 Eventless TypeName
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless TypeName
parseTypeName Parser (Value a)
-> ParsecT MyError ByteString Eventless () -> Parser (Value a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MyError ByteString Eventless ()
ignoredTokens

stringValue :: Parser (Value a)
stringValue :: Parser (Value a)
stringValue = String -> Parser (Value a) -> Parser (Value a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"stringValue" (Parser (Value a) -> Parser (Value a))
-> Parser (Value a) -> Parser (Value a)
forall a b. (a -> b) -> a -> b
$ 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 Eventless Text -> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Text
parseString

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 -> ParsecT MyError ByteString Eventless () -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` ParsecT MyError ByteString Eventless ()
ignoredTokens)

objectEntry :: Parser (Value a) -> Parser (ObjectEntry a)
objectEntry :: Parser (Value a) -> Parser (ObjectEntry a)
objectEntry Parser (Value a)
parser =
  String -> Parser (ObjectEntry a) -> Parser (ObjectEntry a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ObjectEntry" (Parser (ObjectEntry a) -> Parser (ObjectEntry a))
-> Parser (ObjectEntry a) -> Parser (ObjectEntry a)
forall a b. (a -> b) -> a -> b
$
    FieldName -> Value a -> ObjectEntry a
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry (FieldName -> Value a -> ObjectEntry a)
-> ParsecT MyError ByteString Eventless FieldName
-> ParsecT MyError ByteString Eventless (Value a -> ObjectEntry a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless FieldName
fieldNameColon ParsecT MyError ByteString Eventless (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

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 a coll k.
(FromElems Eventless a coll, KeyOf k a) =>
Parser a -> Parser coll
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

parsePrimitives :: Parser (Value a)
parsePrimitives :: Parser (Value a)
parsePrimitives =
  Parser (Value a)
forall (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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 (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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 (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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 (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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 (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
stringValue

parseDefaultValue :: Parser (Value s)
parseDefaultValue :: Parser (Value s)
parseDefaultValue = ParsecT MyError ByteString Eventless ()
equal ParsecT MyError ByteString Eventless ()
-> Parser (Value s) -> Parser (Value s)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Value s)
forall (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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)
structValue Parser (Value s)
forall (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
parseV

class Parse a where
  parse :: Parser a

instance Parse (Value RAW) where
  parse :: Parser (Value RAW)
parse = (Ref -> Value RAW
VariableValue (Ref -> Value RAW)
-> ParsecT MyError ByteString Eventless Ref -> Parser (Value RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT MyError ByteString Eventless Ref
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)
structValue 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)
structValue Parser (Value CONST)
forall a. Parse a => Parser a
parse

structValue :: Parser (Value a) -> Parser (Value a)
structValue :: Parser (Value a) -> Parser (Value a)
structValue 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 (stage :: Stage).
ParsecT MyError ByteString Eventless (Value stage)
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 Eventless (Object a)
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Value a) -> ParsecT MyError ByteString Eventless (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 Eventless [Value a]
-> Parser (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Value a) -> ParsecT MyError ByteString Eventless [Value a]
forall a. Parser a -> Parser [a]
listValue Parser (Value a)
parser)
    )
      Parser (Value a)
-> ParsecT MyError ByteString Eventless () -> Parser (Value a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT MyError ByteString Eventless ()
ignoredTokens