{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} module Data.Morpheus.Server.Deriving.Internal.Schema.Enum ( buildEnumTypeContent, defineEnumUnit, ) where import Data.Morpheus.Server.Deriving.Internal.Schema.Directive ( UseDeriving, deriveEnumDirectives, visitEnumName, visitEnumValueDescription, ) import Data.Morpheus.Server.Deriving.Utils.Kinded ( CatType (..), ) import Data.Morpheus.Server.Types.SchemaT ( SchemaT, insertType, ) import Data.Morpheus.Types.Internal.AST ( CONST, DataEnumValue (..), LEAF, TRUE, TypeContent (..), TypeDefinition, TypeName, mkEnumContent, mkType, unitTypeName, ) buildEnumTypeContent :: gql a => UseDeriving gql args -> CatType kind a -> [TypeName] -> SchemaT k (TypeContent TRUE kind CONST) buildEnumTypeContent :: forall (gql :: * -> Constraint) a (args :: * -> Constraint) (kind :: TypeCategory) (k :: TypeCategory). gql a => UseDeriving gql args -> CatType kind a -> [TypeName] -> SchemaT k (TypeContent TRUE kind CONST) buildEnumTypeContent UseDeriving gql args options p :: CatType kind a p@CatType kind a InputType [TypeName] enumCons = forall (s :: Stage) (a :: TypeCategory). DataEnum s -> TypeContent (LEAF <=? a) a s DataEnum 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 (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *) (k :: TypeCategory). gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (DataEnumValue CONST) mkEnumValue UseDeriving gql args options CatType kind a p) [TypeName] enumCons buildEnumTypeContent UseDeriving gql args options p :: CatType kind a p@CatType kind a OutputType [TypeName] enumCons = forall (s :: Stage) (a :: TypeCategory). DataEnum s -> TypeContent (LEAF <=? a) a s DataEnum 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 (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *) (k :: TypeCategory). gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (DataEnumValue CONST) mkEnumValue UseDeriving gql args options CatType kind a p) [TypeName] enumCons mkEnumValue :: gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (DataEnumValue CONST) mkEnumValue :: forall (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *) (k :: TypeCategory). gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (DataEnumValue CONST) mkEnumValue UseDeriving gql args options f a proxy TypeName enumName = do Directives CONST enumDirectives <- forall (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *) (k :: TypeCategory). gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (Directives CONST) deriveEnumDirectives UseDeriving gql args options f a proxy TypeName enumName forall (f :: * -> *) a. Applicative f => a -> f a pure DataEnumValue { enumName :: TypeName enumName = forall (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *). gql a => UseDeriving gql args -> f a -> TypeName -> TypeName visitEnumName UseDeriving gql args options f a proxy TypeName enumName, enumDescription :: Maybe Description enumDescription = forall (gql :: * -> Constraint) a (args :: * -> Constraint) (f :: * -> *). gql a => UseDeriving gql args -> f a -> TypeName -> Maybe Description -> Maybe Description visitEnumValueDescription UseDeriving gql args options f a proxy TypeName enumName forall a. Maybe a Nothing, Directives CONST enumDirectives :: Directives CONST enumDirectives :: Directives CONST .. } defineEnumUnit :: SchemaT cat () defineEnumUnit :: forall (cat :: TypeCategory). SchemaT cat () defineEnumUnit = forall (cat :: TypeCategory) (cat' :: TypeCategory). TypeDefinition cat CONST -> SchemaT cat' () insertType ( forall (a :: TypeCategory) (s :: Stage). TypeName -> TypeContent TRUE a s -> TypeDefinition a s mkType TypeName unitTypeName (forall (a :: TypeCategory) (s :: Stage). (LEAF <=! a) => [TypeName] -> TypeContent TRUE a s mkEnumContent [TypeName unitTypeName]) :: TypeDefinition LEAF CONST )