{-# 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