{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} module Data.Morpheus.Server.Deriving.Schema.Enum ( buildEnumTypeContent, defineEnumUnit, ) where import Data.Morpheus.Server.Deriving.Schema.Internal ( lookupDescription, lookupDirectives, ) 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 :: KindedType kind a -> [TypeName] -> SchemaT c (TypeContent TRUE kind CONST) buildEnumTypeContent p :: KindedType kind a p@KindedType kind a InputType [TypeName] enumCons = TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST) forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST)) -> TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST) forall a b. (a -> b) -> a -> b $ DataEnum CONST -> TypeContent (LEAF <=? 'IN) 'IN CONST forall (s :: Stage) (a :: TypeCategory). DataEnum s -> TypeContent (LEAF <=? a) a s DataEnum (DataEnum CONST -> TypeContent (LEAF <=? 'IN) 'IN CONST) -> DataEnum CONST -> TypeContent (LEAF <=? 'IN) 'IN CONST forall a b. (a -> b) -> a -> b $ (TypeName -> DataEnumValue CONST) -> [TypeName] -> DataEnum CONST forall a b. (a -> b) -> [a] -> [b] map (KindedType kind a -> TypeName -> DataEnumValue CONST forall a (f :: * -> *). GQLType a => f a -> TypeName -> DataEnumValue CONST mkEnumValue KindedType kind a p) [TypeName] enumCons buildEnumTypeContent p :: KindedType kind a p@KindedType kind a OutputType [TypeName] enumCons = TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST) forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST)) -> TypeContent TRUE kind CONST -> SchemaT c (TypeContent TRUE kind CONST) forall a b. (a -> b) -> a -> b $ DataEnum CONST -> TypeContent (LEAF <=? 'OUT) 'OUT CONST forall (s :: Stage) (a :: TypeCategory). DataEnum s -> TypeContent (LEAF <=? a) a s DataEnum (DataEnum CONST -> TypeContent (LEAF <=? 'OUT) 'OUT CONST) -> DataEnum CONST -> TypeContent (LEAF <=? 'OUT) 'OUT CONST forall a b. (a -> b) -> a -> b $ (TypeName -> DataEnumValue CONST) -> [TypeName] -> DataEnum CONST forall a b. (a -> b) -> [a] -> [b] map (KindedType kind a -> TypeName -> DataEnumValue CONST forall a (f :: * -> *). GQLType a => f a -> TypeName -> DataEnumValue CONST mkEnumValue KindedType kind a p) [TypeName] enumCons mkEnumValue :: GQLType a => f a -> TypeName -> DataEnumValue CONST mkEnumValue :: f a -> TypeName -> DataEnumValue CONST mkEnumValue f a proxy TypeName enumName = DataEnumValue :: forall (s :: Stage). Maybe Description -> TypeName -> Directives s -> DataEnumValue s DataEnumValue { TypeName enumName :: TypeName enumName :: TypeName enumName, enumDescription :: Maybe Description enumDescription = f a -> Description -> Maybe Description forall a (f :: * -> *). GQLType a => f a -> Description -> Maybe Description lookupDescription f a proxy (TypeName -> Description forall a (t :: NAME). NamePacking a => Name t -> a unpackName TypeName enumName), enumDirectives :: Directives CONST enumDirectives = f a -> Description -> Directives CONST forall a (f :: * -> *). GQLType a => f a -> Description -> Directives CONST lookupDirectives f a proxy (TypeName -> Description forall a (t :: NAME). NamePacking a => Name t -> a unpackName TypeName enumName) } defineEnumUnit :: SchemaT cat () defineEnumUnit :: SchemaT cat () defineEnumUnit = TypeDefinition LEAF CONST -> SchemaT cat () forall (cat :: TypeCategory) (cat' :: TypeCategory). TypeDefinition cat CONST -> SchemaT cat' () insertType ( TypeName -> TypeContent TRUE LEAF CONST -> TypeDefinition LEAF CONST forall (a :: TypeCategory) (s :: Stage). TypeName -> TypeContent TRUE a s -> TypeDefinition a s mkType TypeName unitTypeName ([TypeName] -> TypeContent TRUE LEAF CONST forall (a :: TypeCategory) (s :: Stage). (LEAF <=! a) => [TypeName] -> TypeContent TRUE a s mkEnumContent [TypeName unitTypeName]) :: TypeDefinition LEAF CONST )