{-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} module Data.Morpheus.Server.Deriving.Schema.Enum ( buildEnumTypeContent, defineEnumUnit, ) where import Data.Morpheus.Server.Deriving.Schema.Directive ( deriveEnumDirectives, visitEnumName, visitEnumValueDescription, ) import Data.Morpheus.Server.Deriving.Schema.Internal ( lookupDescription, ) import Data.Morpheus.Server.Deriving.Utils.Kinded ( KindedType (..), ) import Data.Morpheus.Server.Types.GQLType ( GQLType, ) import Data.Morpheus.Server.Types.SchemaT ( SchemaT, insertType, ) import Data.Morpheus.Types.Internal.AST ( CONST, DataEnumValue (..), LEAF, TRUE, TypeContent (..), TypeDefinition, TypeName, mkEnumContent, mkType, unitTypeName, unpackName, ) buildEnumTypeContent :: GQLType a => KindedType kind a -> [TypeName] -> SchemaT c (TypeContent TRUE kind CONST) buildEnumTypeContent :: forall a (kind :: TypeCategory) (c :: TypeCategory). GQLType a => KindedType kind a -> [TypeName] -> SchemaT c (TypeContent TRUE kind CONST) buildEnumTypeContent p :: KindedType kind a p@KindedType 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 a (f :: * -> *) (c :: TypeCategory). GQLType a => f a -> TypeName -> SchemaT c (DataEnumValue CONST) mkEnumValue KindedType kind a p) [TypeName] enumCons buildEnumTypeContent p :: KindedType kind a p@KindedType 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 a (f :: * -> *) (c :: TypeCategory). GQLType a => f a -> TypeName -> SchemaT c (DataEnumValue CONST) mkEnumValue KindedType kind a p) [TypeName] enumCons mkEnumValue :: GQLType a => f a -> TypeName -> SchemaT c (DataEnumValue CONST) mkEnumValue :: forall a (f :: * -> *) (c :: TypeCategory). GQLType a => f a -> TypeName -> SchemaT c (DataEnumValue CONST) mkEnumValue f a proxy TypeName enumName = do Directives CONST enumDirectives <- forall a (f :: * -> *) (c :: TypeCategory). GQLType a => f a -> TypeName -> SchemaT c (Directives CONST) deriveEnumDirectives f a proxy TypeName enumName let desc :: Maybe Text desc = forall a (f :: * -> *). GQLType a => f a -> Text -> Maybe Text lookupDescription f a proxy (forall a (t :: NAME). NamePacking a => Name t -> a unpackName TypeName enumName) forall (f :: * -> *) a. Applicative f => a -> f a pure DataEnumValue { enumName :: TypeName enumName = forall a (f :: * -> *). GQLType a => f a -> TypeName -> TypeName visitEnumName f a proxy TypeName enumName, enumDescription :: Maybe Text enumDescription = forall a (f :: * -> *). GQLType a => f a -> TypeName -> Maybe Text -> Maybe Text visitEnumValueDescription f a proxy TypeName enumName Maybe Text desc, 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 )