{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.CodeGen.Server.Interpreting.Directive ( getDirectives, getNamespaceDirs, getDefaultValueDir, getRenameDir, ) where import Data.Char (isUpper) import Data.Morpheus.CodeGen.Internal.AST ( PrintableValue (..), getFullName, ) import Data.Morpheus.CodeGen.Server.Internal.AST (ServerDirectiveUsage (..), TypeValue (..), unpackName) import Data.Morpheus.CodeGen.Server.Interpreting.Utils ( CodeGenM, ServerCodeGenContext (..), getEnumName, getFieldName, inType, lookupFieldType, ) import Data.Morpheus.CodeGen.Utils (langExtension) import Data.Morpheus.Core (internalSchema, render) import Data.Morpheus.Internal.Utils (IsMap, selectOr) import Data.Morpheus.Types.Internal.AST ( Argument (..), ArgumentDefinition (..), CONST, DataEnumValue (..), Description, Directive (Directive, directiveArgs, directiveName), DirectiveDefinition (..), FieldContent (..), FieldDefinition (..), FieldName, FieldsDefinition, Name, ObjectEntry (..), TypeContent (..), TypeDefinition (..), TypeName, TypeRef (..), Value, ) import qualified Data.Morpheus.Types.Internal.AST as AST import Data.Text (head) import Relude hiding (ByteString, get, head) withDir :: CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir :: forall (m :: * -> *). CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir [ServerDirectiveUsage] xs | forall (t :: * -> *) a. Foldable t => t a -> Bool null [ServerDirectiveUsage] xs = forall (f :: * -> *) a. Applicative f => a -> f a pure [] | Bool otherwise = forall (m :: * -> *). MonadState Flags m => Text -> m () langExtension Text "OverloadedStrings" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (f :: * -> *) a. Applicative f => a -> f a pure [ServerDirectiveUsage] xs getRenameDir :: CodeGenM m => Name t -> Name t -> m [ServerDirectiveUsage] getRenameDir :: forall (m :: * -> *) (t :: NAME). CodeGenM m => Name t -> Name t -> m [ServerDirectiveUsage] getRenameDir Name t originalTypeName Name t hsTypeName = forall (m :: * -> *). CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir [TypeValue -> ServerDirectiveUsage TypeDirectiveUsage (forall (t :: NAME). Name t -> TypeValue dirRename Name t originalTypeName) | Name t originalTypeName forall a. Eq a => a -> a -> Bool /= Name t hsTypeName] getDirectives :: (CodeGenM m, Meta a) => a -> m [ServerDirectiveUsage] getDirectives :: forall (m :: * -> *) a. (CodeGenM m, Meta a) => a -> m [ServerDirectiveUsage] getDirectives = forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall (m :: * -> *). CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir getDefaultValueDir :: (CodeGenM m) => FieldDefinition c CONST -> m [ServerDirectiveUsage] getDefaultValueDir :: forall (m :: * -> *) (c :: TypeCategory). CodeGenM m => FieldDefinition c CONST -> m [ServerDirectiveUsage] getDefaultValueDir FieldDefinition { FieldName fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldName :: FieldName fieldName, fieldContent :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe (FieldContent TRUE cat s) fieldContent = Just DefaultInputValue {Value CONST defaultInputValue :: forall (s :: Stage) (cat :: TypeCategory). FieldContent (IN <=? cat) cat s -> Value s defaultInputValue :: Value CONST defaultInputValue} } = do FieldName name <- forall (m :: * -> *). CodeGenM m => FieldName -> m FieldName getFieldName FieldName fieldName forall (m :: * -> *). CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir [FieldName -> TypeValue -> ServerDirectiveUsage FieldDirectiveUsage FieldName name (Value CONST -> TypeValue defValDirective Value CONST defaultInputValue)] getDefaultValueDir FieldDefinition c CONST _ = forall (f :: * -> *) a. Applicative f => a -> f a pure [] defValDirective :: Value CONST -> TypeValue defValDirective :: Value CONST -> TypeValue defValDirective Value CONST desc = TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName "DefaultValue" [(FieldName "defaultValue", PrintableValue -> TypeValue PrintableTypeValue forall a b. (a -> b) -> a -> b $ forall a. (Show a, Lift a) => a -> PrintableValue PrintableValue Value CONST desc)] getNamespaceDirs :: CodeGenM m => Text -> m [ServerDirectiveUsage] getNamespaceDirs :: forall (m :: * -> *). CodeGenM m => Text -> m [ServerDirectiveUsage] getNamespaceDirs Text genTypeName = do Bool namespaces <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServerCodeGenContext -> Bool hasNamespace forall (m :: * -> *). CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir [TypeValue -> ServerDirectiveUsage TypeDirectiveUsage (Text -> TypeValue dirDropNamespace Text genTypeName) | Bool namespaces] descDirective :: Maybe Description -> [TypeValue] descDirective :: Maybe Text -> [TypeValue] descDirective Maybe Text desc = forall a b. (a -> b) -> [a] -> [b] map Text -> TypeValue describe (forall a. Maybe a -> [a] maybeToList Maybe Text desc) where describe :: Text -> TypeValue describe Text x = TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName "Describe" [(FieldName "text", Text -> TypeValue TypeValueString Text x)] dirDropNamespace :: Text -> TypeValue dirDropNamespace :: Text -> TypeValue dirDropNamespace Text name = TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName "DropNamespace" [(FieldName "dropNamespace", Text -> TypeValue TypeValueString Text name)] dirRename :: Name t -> TypeValue dirRename :: forall (t :: NAME). Name t -> TypeValue dirRename Name t name = TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName "Rename" [(FieldName "newName", Text -> TypeValue TypeValueString (forall a (t :: NAME). NamePacking a => Name t -> a unpackName Name t name))] class Meta a where getDirs :: CodeGenM m => a -> m [ServerDirectiveUsage] instance (Meta a) => Meta (Maybe a) where getDirs :: forall (m :: * -> *). CodeGenM m => Maybe a -> m [ServerDirectiveUsage] getDirs (Just a x) = forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs a x getDirs Maybe a _ = forall (f :: * -> *) a. Applicative f => a -> f a pure [] instance Meta (TypeDefinition c CONST) where getDirs :: forall (m :: * -> *). CodeGenM m => TypeDefinition c CONST -> m [ServerDirectiveUsage] getDirs TypeDefinition {TypeContent TRUE c CONST typeContent :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeContent TRUE a s typeContent :: TypeContent TRUE c CONST typeContent, Directives CONST typeDirectives :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> Directives s typeDirectives :: Directives CONST typeDirectives, Maybe Text typeDescription :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> Maybe Text typeDescription :: Maybe Text typeDescription} = do [ServerDirectiveUsage] contentD <- forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs TypeContent TRUE c CONST typeContent [ServerDirectiveUsage] typeD <- forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall {f :: * -> *}. CodeGenM f => Directive CONST -> f ServerDirectiveUsage transform (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Directives CONST typeDirectives) forall (f :: * -> *) a. Applicative f => a -> f a pure ([ServerDirectiveUsage] contentD forall a. Semigroup a => a -> a -> a <> [ServerDirectiveUsage] typeD forall a. Semigroup a => a -> a -> a <> forall a b. (a -> b) -> [a] -> [b] map TypeValue -> ServerDirectiveUsage TypeDirectiveUsage (Maybe Text -> [TypeValue] descDirective Maybe Text typeDescription)) where transform :: Directive CONST -> f ServerDirectiveUsage transform Directive CONST v = TypeValue -> ServerDirectiveUsage TypeDirectiveUsage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). CodeGenM m => Directive CONST -> m TypeValue directiveTypeValue Directive CONST v instance Meta (TypeContent a c CONST) where getDirs :: forall (m :: * -> *). CodeGenM m => TypeContent a c CONST -> m [ServerDirectiveUsage] getDirs DataObject {FieldsDefinition OUT CONST objectFields :: forall (s :: Stage) (a :: TypeCategory). CondTypeContent OBJECT a s -> FieldsDefinition OUT s objectFields :: FieldsDefinition OUT CONST objectFields} = forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs FieldsDefinition OUT CONST objectFields getDirs DataInputObject {FieldsDefinition IN CONST inputObjectFields :: forall (s :: Stage) (a :: TypeCategory). CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s inputObjectFields :: FieldsDefinition IN CONST inputObjectFields} = forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs FieldsDefinition IN CONST inputObjectFields getDirs DataInterface {FieldsDefinition OUT CONST interfaceFields :: forall (s :: Stage) (a :: TypeCategory). CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s interfaceFields :: FieldsDefinition OUT CONST interfaceFields} = forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs FieldsDefinition OUT CONST interfaceFields getDirs DataEnum {DataEnum CONST enumMembers :: forall (s :: Stage) (a :: TypeCategory). CondTypeContent LEAF a s -> DataEnum s enumMembers :: DataEnum CONST enumMembers} = forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs DataEnum CONST enumMembers getDirs TypeContent a c CONST _ = forall (f :: * -> *) a. Applicative f => a -> f a pure [] instance Meta (DataEnumValue CONST) where getDirs :: forall (m :: * -> *). CodeGenM m => DataEnumValue CONST -> m [ServerDirectiveUsage] getDirs DataEnumValue {TypeName enumName :: forall (s :: Stage). DataEnumValue s -> TypeName enumName :: TypeName enumName, Directives CONST enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s enumDirectives :: Directives CONST enumDirectives, Maybe Text enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Text enumDescription :: Maybe Text enumDescription} = do [TypeValue] dirs <- forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall (m :: * -> *). CodeGenM m => Directive CONST -> m TypeValue directiveTypeValue (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Directives CONST enumDirectives) TypeName name <- CodeGenTypeName -> TypeName getFullName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). MonadReader ServerCodeGenContext m => TypeName -> m CodeGenTypeName getEnumName TypeName enumName let renameEnum :: [ServerDirectiveUsage] renameEnum = [TypeName -> TypeValue -> ServerDirectiveUsage EnumDirectiveUsage TypeName name (forall (t :: NAME). Name t -> TypeValue dirRename TypeName enumName) | Bool -> Bool not (forall (t :: NAME). Name t -> Bool isUpperCase TypeName enumName)] forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ [ServerDirectiveUsage] renameEnum forall a. Semigroup a => a -> a -> a <> forall a b. (a -> b) -> [a] -> [b] map (TypeName -> TypeValue -> ServerDirectiveUsage EnumDirectiveUsage TypeName name) ([TypeValue] dirs forall a. Semigroup a => a -> a -> a <> Maybe Text -> [TypeValue] descDirective Maybe Text enumDescription) instance Meta (FieldsDefinition c CONST) where getDirs :: forall (m :: * -> *). CodeGenM m => FieldsDefinition c CONST -> m [ServerDirectiveUsage] getDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall a (m :: * -> *). (Meta a, CodeGenM m) => a -> m [ServerDirectiveUsage] getDirs forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) a. Foldable t => t a -> [a] toList instance Meta (FieldDefinition c CONST) where getDirs :: forall (m :: * -> *). CodeGenM m => FieldDefinition c CONST -> m [ServerDirectiveUsage] getDirs FieldDefinition {FieldName fieldName :: FieldName fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldName, Directives CONST fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Directives s fieldDirectives :: Directives CONST fieldDirectives, Maybe Text fieldDescription :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> Maybe Text fieldDescription :: Maybe Text fieldDescription} = do [TypeValue] dirs <- forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall (m :: * -> *). CodeGenM m => Directive CONST -> m TypeValue directiveTypeValue (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Directives CONST fieldDirectives) FieldName name <- forall (m :: * -> *). CodeGenM m => FieldName -> m FieldName getFieldName FieldName fieldName let renameField :: [ServerDirectiveUsage] renameField = [FieldName -> TypeValue -> ServerDirectiveUsage FieldDirectiveUsage FieldName name (forall (t :: NAME). Name t -> TypeValue dirRename FieldName fieldName) | forall (t :: NAME). Name t -> Bool isUpperCase FieldName fieldName] forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ [ServerDirectiveUsage] renameField forall a. Semigroup a => a -> a -> a <> forall a b. (a -> b) -> [a] -> [b] map (FieldName -> TypeValue -> ServerDirectiveUsage FieldDirectiveUsage FieldName name) ([TypeValue] dirs forall a. Semigroup a => a -> a -> a <> Maybe Text -> [TypeValue] descDirective Maybe Text fieldDescription) directiveTypeValue :: CodeGenM m => Directive CONST -> m TypeValue directiveTypeValue :: forall (m :: * -> *). CodeGenM m => Directive CONST -> m TypeValue directiveTypeValue Directive {FieldName Position Arguments CONST directivePosition :: forall (s :: Stage). Directive s -> Position directiveArgs :: Arguments CONST directiveName :: FieldName directivePosition :: Position directiveName :: forall (s :: Stage). Directive s -> FieldName directiveArgs :: forall (s :: Stage). Directive s -> Arguments s ..} = forall (m :: * -> *) a. MonadReader ServerCodeGenContext m => Maybe TypeName -> m a -> m a inType Maybe TypeName typeContext forall a b. (a -> b) -> a -> b $ do DirectiveDefinition CONST dirs <- forall (m :: * -> *). CodeGenM m => FieldName -> m (DirectiveDefinition CONST) getDirective FieldName directiveName TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName typename forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (c :: * -> *) (m :: * -> *) (s :: Stage). (IsMap FieldName c, CodeGenM m) => c (Argument CONST) -> ArgumentDefinition s -> m (FieldName, TypeValue) renderArgumentValue Arguments CONST directiveArgs) (forall (t :: * -> *) a. Foldable t => t a -> [a] toList forall a b. (a -> b) -> a -> b $ forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s directiveDefinitionArgs DirectiveDefinition CONST dirs) where (Maybe TypeName typeContext, TypeName typename) = FieldName -> (Maybe TypeName, TypeName) renderDirectiveTypeName FieldName directiveName nativeDirectives :: AST.DirectivesDefinition CONST nativeDirectives :: DirectivesDefinition CONST nativeDirectives = forall (s :: Stage). Schema s -> DirectivesDefinition s AST.directiveDefinitions forall (s :: Stage). Schema s internalSchema isUpperCase :: Name t -> Bool isUpperCase :: forall (t :: NAME). Name t -> Bool isUpperCase = Char -> Bool isUpper forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Char head forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a (t :: NAME). NamePacking a => Name t -> a unpackName getDirective :: (CodeGenM m) => FieldName -> m (DirectiveDefinition CONST) getDirective :: forall (m :: * -> *). CodeGenM m => FieldName -> m (DirectiveDefinition CONST) getDirective FieldName directiveName = do [DirectiveDefinition CONST] dirs <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ServerCodeGenContext -> [DirectiveDefinition CONST] directiveDefinitions case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find (\DirectiveDefinition {FieldName directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName directiveDefinitionName :: FieldName directiveDefinitionName} -> FieldName directiveDefinitionName forall a. Eq a => a -> a -> Bool == FieldName directiveName) [DirectiveDefinition CONST] dirs of Just DirectiveDefinition CONST dir -> forall (f :: * -> *) a. Applicative f => a -> f a pure DirectiveDefinition CONST dir Maybe (DirectiveDefinition CONST) _ -> forall k (c :: * -> *) d a. IsMap k c => d -> (a -> d) -> k -> c a -> d selectOr (forall (m :: * -> *) a. MonadFail m => String -> m a fail forall a b. (a -> b) -> a -> b $ String "unknown directive" forall a. Semigroup a => a -> a -> a <> forall b a. (Show a, IsString b) => a -> b show FieldName directiveName) forall (f :: * -> *) a. Applicative f => a -> f a pure FieldName directiveName DirectivesDefinition CONST nativeDirectives renderDirectiveTypeName :: FieldName -> (Maybe TypeName, TypeName) renderDirectiveTypeName :: FieldName -> (Maybe TypeName, TypeName) renderDirectiveTypeName FieldName "deprecated" = (forall a. Maybe a Nothing, TypeName "Deprecated") renderDirectiveTypeName FieldName name = (forall a. a -> Maybe a Just (coerce :: forall a b. Coercible a b => a -> b coerce FieldName name), coerce :: forall a b. Coercible a b => a -> b coerce FieldName name) renderArgumentValue :: (IsMap FieldName c, CodeGenM m) => c (Argument CONST) -> ArgumentDefinition s -> m (FieldName, TypeValue) renderArgumentValue :: forall (c :: * -> *) (m :: * -> *) (s :: Stage). (IsMap FieldName c, CodeGenM m) => c (Argument CONST) -> ArgumentDefinition s -> m (FieldName, TypeValue) renderArgumentValue c (Argument CONST) args ArgumentDefinition {FieldDefinition IN s argument :: forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s argument :: FieldDefinition IN s ..} = do let dirName :: FieldName dirName = forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName AST.fieldName FieldDefinition IN s argument Value CONST gqlValue <- forall k (c :: * -> *) d a. IsMap k c => d -> (a -> d) -> k -> c a -> d selectOr (forall (f :: * -> *) a. Applicative f => a -> f a pure forall (stage :: Stage). Value stage AST.Null) (forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (valid :: Stage). Argument valid -> Value valid argumentValue) FieldName dirName c (Argument CONST) args TypeValue typeValue <- forall (m :: * -> *). CodeGenM m => TypeRef -> Value CONST -> m TypeValue mapWrappedValue (forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> TypeRef AST.fieldType FieldDefinition IN s argument) Value CONST gqlValue FieldName fName <- forall (m :: * -> *). CodeGenM m => FieldName -> m FieldName getFieldName FieldName dirName forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldName fName, TypeValue typeValue) mapWrappedValue :: CodeGenM m => TypeRef -> AST.Value CONST -> m TypeValue mapWrappedValue :: forall (m :: * -> *). CodeGenM m => TypeRef -> Value CONST -> m TypeValue mapWrappedValue (TypeRef TypeName name (AST.BaseType Bool isRequired)) Value CONST value | Bool isRequired = forall (m :: * -> *). CodeGenM m => TypeName -> Value CONST -> m TypeValue mapValue TypeName name Value CONST value | Value CONST value forall a. Eq a => a -> a -> Bool == forall (stage :: Stage). Value stage AST.Null = forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe TypeValue -> TypeValue TypedValueMaybe forall a. Maybe a Nothing) | Bool otherwise = Maybe TypeValue -> TypeValue TypedValueMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. a -> Maybe a Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). CodeGenM m => TypeName -> Value CONST -> m TypeValue mapValue TypeName name Value CONST value mapWrappedValue (TypeRef TypeName name (AST.TypeList TypeWrapper elems Bool isRequired)) Value CONST d = case Value CONST d of Value CONST AST.Null | Bool -> Bool not Bool isRequired -> forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe TypeValue -> TypeValue TypedValueMaybe forall a. Maybe a Nothing) (AST.List [Value CONST] xs) -> Maybe TypeValue -> TypeValue TypedValueMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . [TypeValue] -> TypeValue TypeValueList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (m :: * -> *). CodeGenM m => TypeRef -> Value CONST -> m TypeValue mapWrappedValue (TypeName -> TypeWrapper -> TypeRef TypeRef TypeName name TypeWrapper elems)) [Value CONST] xs Value CONST value -> forall (m :: * -> *). MonadFail m => String -> Value CONST -> m TypeValue expected String "list" Value CONST value mapValue :: CodeGenM m => TypeName -> AST.Value CONST -> m TypeValue mapValue :: forall (m :: * -> *). CodeGenM m => TypeName -> Value CONST -> m TypeValue mapValue TypeName name (AST.List [Value CONST] xs) = [TypeValue] -> TypeValue TypeValueList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (m :: * -> *). CodeGenM m => TypeName -> Value CONST -> m TypeValue mapValue TypeName name) [Value CONST] xs mapValue TypeName _ (AST.Enum TypeName name) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName name [] mapValue TypeName name (AST.Object Object CONST fields) = TypeName -> [(FieldName, TypeValue)] -> TypeValue TypeValueObject TypeName name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (m :: * -> *). CodeGenM m => TypeName -> ObjectEntry CONST -> m (FieldName, TypeValue) mapField TypeName name) (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Object CONST fields) mapValue TypeName _ (AST.Scalar ScalarValue x) = forall (m :: * -> *). CodeGenM m => ScalarValue -> m TypeValue mapScalarValue ScalarValue x mapValue TypeName t Value CONST v = forall (m :: * -> *). MonadFail m => String -> Value CONST -> m TypeValue expected (forall b a. (Show a, IsString b) => a -> b show TypeName t) Value CONST v mapScalarValue :: CodeGenM m => AST.ScalarValue -> m TypeValue mapScalarValue :: forall (m :: * -> *). CodeGenM m => ScalarValue -> m TypeValue mapScalarValue (AST.Int Int x) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Double -> TypeValue TypeValueNumber (forall a b. (Integral a, Num b) => a -> b fromIntegral Int x) mapScalarValue (AST.Float Double x) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Double -> TypeValue TypeValueNumber Double x mapScalarValue (AST.String Text x) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Text -> TypeValue TypeValueString Text x mapScalarValue (AST.Boolean Bool x) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Bool -> TypeValue TypeValueBool Bool x mapScalarValue (AST.Value Value _) = forall (m :: * -> *) a. MonadFail m => String -> m a fail String "JSON objects are not supported!" expected :: MonadFail m => String -> AST.Value CONST -> m TypeValue expected :: forall (m :: * -> *). MonadFail m => String -> Value CONST -> m TypeValue expected String typ Value CONST value = forall (m :: * -> *) a. MonadFail m => String -> m a fail (String "expected " forall a. Semigroup a => a -> a -> a <> String typ forall a. Semigroup a => a -> a -> a <> String ", found " forall a. Semigroup a => a -> a -> a <> forall b a. (Show a, IsString b) => a -> b show (forall a. RenderGQL a => a -> ByteString render Value CONST value) forall a. Semigroup a => a -> a -> a <> String "!") mapField :: CodeGenM m => TypeName -> ObjectEntry CONST -> m (FieldName, TypeValue) mapField :: forall (m :: * -> *). CodeGenM m => TypeName -> ObjectEntry CONST -> m (FieldName, TypeValue) mapField TypeName tName ObjectEntry {Value CONST FieldName entryName :: forall (s :: Stage). ObjectEntry s -> FieldName entryValue :: forall (s :: Stage). ObjectEntry s -> Value s entryValue :: Value CONST entryName :: FieldName ..} = do TypeRef t <- forall (m :: * -> *). CodeGenM m => TypeName -> FieldName -> m TypeRef lookupFieldType TypeName tName FieldName entryName TypeValue value <- forall (m :: * -> *). CodeGenM m => TypeRef -> Value CONST -> m TypeValue mapWrappedValue TypeRef t Value CONST entryValue forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldName entryName, TypeValue value)