{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.CodeGen.Server.Interpreting.Directive ( getDirs, getNamespaceDirs, dirRename, ) where import Data.Char (isUpper) import Data.Morpheus.CodeGen.Internal.AST ( getFullName, ) import Data.Morpheus.CodeGen.Server.Internal.AST (ServerDirectiveUsage (..), TypeValue (..), unpackName) import Data.Morpheus.CodeGen.Server.Interpreting.Utils ( CodeGenT, TypeContext (..), getEnumName, getFieldName, inType, lookupFieldType, ) 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 (..), FieldDefinition (..), FieldName, FieldsDefinition, Name, ObjectEntry (..), TypeContent (..), TypeDefinition (..), TypeName, TypeRef (..), ) import qualified Data.Morpheus.Types.Internal.AST as AST import Data.Text (head) import Relude hiding (ByteString, get, head) getNamespaceDirs :: MonadReader (TypeContext s) m => Text -> m [ServerDirectiveUsage] getNamespaceDirs :: forall (s :: Stage) (m :: * -> *). MonadReader (TypeContext s) m => Text -> m [ServerDirectiveUsage] getNamespaceDirs Text genTypeName = do Bool namespaces <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall (s :: Stage). TypeContext s -> Bool hasNamespace forall (f :: * -> *) a. Applicative f => a -> f a pure [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 :: MonadFail m => a -> CodeGenT m [ServerDirectiveUsage] instance (Meta a) => Meta (Maybe a) where getDirs :: forall (m :: * -> *). MonadFail m => Maybe a -> CodeGenT m [ServerDirectiveUsage] getDirs (Just a x) = forall a (m :: * -> *). (Meta a, MonadFail m) => a -> CodeGenT 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 :: * -> *). MonadFail m => TypeDefinition c CONST -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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 {m :: * -> *}. MonadFail m => Directive CONST -> ReaderT (TypeContext CONST) m 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 -> ReaderT (TypeContext CONST) m ServerDirectiveUsage transform Directive CONST v = TypeValue -> ServerDirectiveUsage TypeDirectiveUsage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). MonadFail m => Directive CONST -> CodeGenT m TypeValue directiveTypeValue Directive CONST v instance Meta (TypeContent a c CONST) where getDirs :: forall (m :: * -> *). MonadFail m => TypeContent a c CONST -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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 :: * -> *). MonadFail m => DataEnumValue CONST -> CodeGenT 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 :: * -> *). MonadFail m => Directive CONST -> CodeGenT 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 (s :: Stage) (m :: * -> *). MonadReader (TypeContext s) 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 :: * -> *). MonadFail m => FieldsDefinition c CONST -> CodeGenT 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, MonadFail m) => a -> CodeGenT 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 :: * -> *). MonadFail m => FieldDefinition c CONST -> CodeGenT m [ServerDirectiveUsage] getDirs FieldDefinition {FieldName fieldName :: forall (cat :: TypeCategory) (s :: Stage). FieldDefinition cat s -> FieldName fieldName :: 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 :: * -> *). MonadFail m => Directive CONST -> CodeGenT m TypeValue directiveTypeValue (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Directives CONST fieldDirectives) FieldName name <- forall (m :: * -> *). Monad m => FieldName -> CodeGenT 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 :: MonadFail m => Directive CONST -> CodeGenT m TypeValue directiveTypeValue :: forall (m :: * -> *). MonadFail m => Directive CONST -> CodeGenT 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 (s :: Stage) (m :: * -> *) a. MonadReader (TypeContext s) m => Maybe TypeName -> m a -> m a inType Maybe TypeName typeContext forall a b. (a -> b) -> a -> b $ do DirectiveDefinition CONST dirs <- forall (m :: * -> *). (MonadReader (TypeContext CONST) m, MonadFail 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, MonadFail m) => c (Argument CONST) -> ArgumentDefinition s -> ReaderT (TypeContext CONST) 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 :: (MonadReader (TypeContext CONST) m, MonadFail m) => FieldName -> m (DirectiveDefinition CONST) getDirective :: forall (m :: * -> *). (MonadReader (TypeContext CONST) m, MonadFail m) => FieldName -> m (DirectiveDefinition CONST) getDirective FieldName directiveName = do [DirectiveDefinition CONST] dirs <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall (s :: Stage). TypeContext s -> [DirectiveDefinition s] 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, MonadFail m) => c (Argument CONST) -> ArgumentDefinition s -> ReaderT (TypeContext CONST) m (FieldName, TypeValue) renderArgumentValue :: forall (c :: * -> *) (m :: * -> *) (s :: Stage). (IsMap FieldName c, MonadFail m) => c (Argument CONST) -> ArgumentDefinition s -> ReaderT (TypeContext CONST) 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 :: * -> *). MonadFail m => TypeRef -> Value CONST -> CodeGenT 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 :: * -> *). Monad m => FieldName -> CodeGenT m FieldName getFieldName FieldName dirName forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldName fName, TypeValue typeValue) mapWrappedValue :: MonadFail m => TypeRef -> AST.Value CONST -> CodeGenT m TypeValue mapWrappedValue :: forall (m :: * -> *). MonadFail m => TypeRef -> Value CONST -> CodeGenT m TypeValue mapWrappedValue (TypeRef TypeName name (AST.BaseType Bool isRequired)) Value CONST value | Bool isRequired = forall (m :: * -> *). MonadFail m => TypeName -> Value CONST -> CodeGenT 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 :: * -> *). MonadFail m => TypeName -> Value CONST -> CodeGenT 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 :: * -> *). MonadFail m => TypeRef -> Value CONST -> CodeGenT m TypeValue mapWrappedValue (TypeName -> TypeWrapper -> TypeRef TypeRef TypeName name TypeWrapper elems)) [Value CONST] xs Value CONST value -> forall (m :: * -> *). MonadFail m => String -> Value CONST -> CodeGenT m TypeValue expected String "list" Value CONST value mapValue :: MonadFail m => TypeName -> AST.Value CONST -> CodeGenT m TypeValue mapValue :: forall (m :: * -> *). MonadFail m => TypeName -> Value CONST -> CodeGenT 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 :: * -> *). MonadFail m => TypeName -> Value CONST -> CodeGenT 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 :: * -> *). MonadFail m => TypeName -> ObjectEntry CONST -> CodeGenT 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 :: * -> *). MonadFail m => ScalarValue -> CodeGenT m TypeValue mapScalarValue ScalarValue x mapValue TypeName t Value CONST v = forall (m :: * -> *). MonadFail m => String -> Value CONST -> CodeGenT m TypeValue expected (forall b a. (Show a, IsString b) => a -> b show TypeName t) Value CONST v mapScalarValue :: MonadFail m => AST.ScalarValue -> CodeGenT m TypeValue mapScalarValue :: forall (m :: * -> *). MonadFail m => ScalarValue -> CodeGenT 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 -> CodeGenT m TypeValue expected :: forall (m :: * -> *). MonadFail m => String -> Value CONST -> CodeGenT 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 :: MonadFail m => TypeName -> ObjectEntry CONST -> CodeGenT m (FieldName, TypeValue) mapField :: forall (m :: * -> *). MonadFail m => TypeName -> ObjectEntry CONST -> CodeGenT 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 :: * -> *). MonadFail m => TypeName -> FieldName -> CodeGenT m TypeRef lookupFieldType TypeName tName FieldName entryName TypeValue value <- forall (m :: * -> *). MonadFail m => TypeRef -> Value CONST -> CodeGenT m TypeValue mapWrappedValue TypeRef t Value CONST entryValue forall (f :: * -> *) a. Applicative f => a -> f a pure (FieldName entryName, TypeValue value)