{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.TypeSystem
( ScalarDefinition (..),
DataEnum,
DataUnion,
TypeContent (..),
TypeDefinition (..),
Schema (..),
DataEnumValue (..),
TypeLib,
TypeCategory,
DataInputUnion,
mkEnumContent,
mkUnionContent,
mkType,
createScalarType,
mkInputUnionFields,
initTypeLib,
kindOf,
isEntNode,
lookupWith,
__inputname,
UnionMember (..),
mkUnionMember,
RawTypeDefinition (..),
RootOperationTypeDefinition (..),
SchemaDefinition (..),
buildSchema,
Typed (Typed),
untyped,
typed,
possibleTypes,
possibleInterfaceTypes,
safeDefineType,
defineSchemaWith,
)
where
import Control.Monad (foldM)
import Data.Morpheus.Error.NameCollision
( NameCollision (..),
)
import Data.Morpheus.Ext.OrdMap
( OrdMap,
)
import Data.Morpheus.Ext.SafeHashMap
( SafeHashMap,
insert,
)
import Data.Morpheus.Ext.SemigroupM
( (<:>),
SemigroupM (..),
)
import Data.Morpheus.Internal.Utils
( Collection (..),
Elems (..),
Failure (..),
FromElems (..),
KeyOf (..),
Selectable (..),
)
import Data.Morpheus.Rendering.RenderGQL
( RenderGQL (..),
Rendering,
intercalate,
newline,
renderEntry,
renderMembers,
renderObject,
)
import Data.Morpheus.Types.Internal.AST.Base
( Description,
FieldName,
FieldName (..),
Msg (..),
OperationType (..),
TRUE,
Token,
TypeKind (..),
TypeName,
TypeRef (..),
TypeWrapper (..),
ValidationError,
ValidationErrors,
isNotSystemTypeName,
mkTypeRef,
msg,
msgValidation,
toFieldName,
toOperationType,
)
import Data.Morpheus.Types.Internal.AST.Fields
( Directive,
DirectiveDefinition (..),
Directives,
FieldDefinition (..),
FieldsDefinition,
unsafeFromFields,
)
import Data.Morpheus.Types.Internal.AST.Stage
( CONST,
Stage,
VALID,
)
import Data.Morpheus.Types.Internal.AST.TypeCategory
( ANY,
ELEM,
FromCategory (..),
IMPLEMENTABLE,
IN,
LEAF,
OBJECT,
OUT,
ToCategory (..),
TypeCategory,
fromAny,
toAny,
)
import Data.Morpheus.Types.Internal.AST.Value
( Value (..),
)
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude hiding
( empty,
intercalate,
show,
)
import Prelude (Show (..))
type DataEnum s = [DataEnumValue s]
typed :: (a c s -> b) -> a c s -> Typed c s b
typed :: (a c s -> b) -> a c s -> Typed c s b
typed a c s -> b
f = b -> Typed c s b
forall (cat :: TypeCategory) (s :: Stage) a. a -> Typed cat s a
Typed (b -> Typed c s b) -> (a c s -> b) -> a c s -> Typed c s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a c s -> b
f
untyped :: (a -> b) -> Typed c s a -> b
untyped :: (a -> b) -> Typed c s a -> b
untyped a -> b
f = a -> b
f (a -> b) -> (Typed c s a -> a) -> Typed c s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typed c s a -> a
forall (cat :: TypeCategory) (s :: Stage) a. Typed cat s a -> a
_untyped
newtype Typed (cat :: TypeCategory) (s :: Stage) a = Typed
{ Typed cat s a -> a
_untyped :: a
}
mkUnionMember :: TypeName -> UnionMember cat s
mkUnionMember :: TypeName -> UnionMember cat s
mkUnionMember TypeName
name = TypeName -> Bool -> UnionMember cat s
forall (cat :: TypeCategory) (s :: Stage).
TypeName -> Bool -> UnionMember cat s
UnionMember TypeName
name Bool
True
data UnionMember (cat :: TypeCategory) (s :: Stage) = UnionMember
{ UnionMember cat s -> TypeName
memberName :: TypeName,
UnionMember cat s -> Bool
visibility :: Bool
}
deriving (Int -> UnionMember cat s -> ShowS
[UnionMember cat s] -> ShowS
UnionMember cat s -> String
(Int -> UnionMember cat s -> ShowS)
-> (UnionMember cat s -> String)
-> ([UnionMember cat s] -> ShowS)
-> Show (UnionMember cat s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (cat :: TypeCategory) (s :: Stage).
Int -> UnionMember cat s -> ShowS
forall (cat :: TypeCategory) (s :: Stage).
[UnionMember cat s] -> ShowS
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> String
showList :: [UnionMember cat s] -> ShowS
$cshowList :: forall (cat :: TypeCategory) (s :: Stage).
[UnionMember cat s] -> ShowS
show :: UnionMember cat s -> String
$cshow :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> String
showsPrec :: Int -> UnionMember cat s -> ShowS
$cshowsPrec :: forall (cat :: TypeCategory) (s :: Stage).
Int -> UnionMember cat s -> ShowS
Show, UnionMember cat s -> Q Exp
UnionMember cat s -> Q (TExp (UnionMember cat s))
(UnionMember cat s -> Q Exp)
-> (UnionMember cat s -> Q (TExp (UnionMember cat s)))
-> Lift (UnionMember cat s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Q Exp
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Q (TExp (UnionMember cat s))
liftTyped :: UnionMember cat s -> Q (TExp (UnionMember cat s))
$cliftTyped :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Q (TExp (UnionMember cat s))
lift :: UnionMember cat s -> Q Exp
$clift :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Q Exp
Lift, UnionMember cat s -> UnionMember cat s -> Bool
(UnionMember cat s -> UnionMember cat s -> Bool)
-> (UnionMember cat s -> UnionMember cat s -> Bool)
-> Eq (UnionMember cat s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> UnionMember cat s -> Bool
/= :: UnionMember cat s -> UnionMember cat s -> Bool
$c/= :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> UnionMember cat s -> Bool
== :: UnionMember cat s -> UnionMember cat s -> Bool
$c== :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> UnionMember cat s -> Bool
Eq)
type DataUnion s = [UnionMember OUT s]
type DataInputUnion s = [UnionMember IN s]
instance RenderGQL (UnionMember cat s) where
render :: UnionMember cat s -> Rendering
render = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render (TypeName -> Rendering)
-> (UnionMember cat s -> TypeName)
-> UnionMember cat s
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMember cat s -> TypeName
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName
instance Msg (UnionMember cat s) where
msg :: UnionMember cat s -> Message
msg = TypeName -> Message
forall a. Msg a => a -> Message
msg (TypeName -> Message)
-> (UnionMember cat s -> TypeName) -> UnionMember cat s -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMember cat s -> TypeName
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName
instance KeyOf TypeName (UnionMember cat s) where
keyOf :: UnionMember cat s -> TypeName
keyOf = UnionMember cat s -> TypeName
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName
newtype ScalarDefinition = ScalarDefinition
{ScalarDefinition -> Value VALID -> Either Text (Value VALID)
validateValue :: Value VALID -> Either Token (Value VALID)}
instance Show ScalarDefinition where
show :: ScalarDefinition -> String
show ScalarDefinition
_ = String
"ScalarDefinition"
instance Lift ScalarDefinition where
lift :: ScalarDefinition -> Q Exp
lift ScalarDefinition
_ = [|ScalarDefinition pure|]
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped :: ScalarDefinition -> Q (TExp ScalarDefinition)
liftTyped ScalarDefinition
_ = [||ScalarDefinition pure||]
#endif
data DataEnumValue s = DataEnumValue
{ DataEnumValue s -> Maybe Text
enumDescription :: Maybe Description,
DataEnumValue s -> TypeName
enumName :: TypeName,
DataEnumValue s -> [Directive s]
enumDirectives :: [Directive s]
}
deriving (Int -> DataEnumValue s -> ShowS
[DataEnumValue s] -> ShowS
DataEnumValue s -> String
(Int -> DataEnumValue s -> ShowS)
-> (DataEnumValue s -> String)
-> ([DataEnumValue s] -> ShowS)
-> Show (DataEnumValue s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> DataEnumValue s -> ShowS
forall (s :: Stage). [DataEnumValue s] -> ShowS
forall (s :: Stage). DataEnumValue s -> String
showList :: [DataEnumValue s] -> ShowS
$cshowList :: forall (s :: Stage). [DataEnumValue s] -> ShowS
show :: DataEnumValue s -> String
$cshow :: forall (s :: Stage). DataEnumValue s -> String
showsPrec :: Int -> DataEnumValue s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> DataEnumValue s -> ShowS
Show, DataEnumValue s -> Q Exp
DataEnumValue s -> Q (TExp (DataEnumValue s))
(DataEnumValue s -> Q Exp)
-> (DataEnumValue s -> Q (TExp (DataEnumValue s)))
-> Lift (DataEnumValue s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). DataEnumValue s -> Q Exp
forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
liftTyped :: DataEnumValue s -> Q (TExp (DataEnumValue s))
$cliftTyped :: forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
lift :: DataEnumValue s -> Q Exp
$clift :: forall (s :: Stage). DataEnumValue s -> Q Exp
Lift)
instance RenderGQL (DataEnumValue s) where
render :: DataEnumValue s -> Rendering
render DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName} = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
enumName
data Schema (s :: Stage) = Schema
{ Schema s -> TypeLib s
types :: TypeLib s,
Schema s -> TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s,
Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s),
Schema s -> Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s),
Schema s -> [DirectiveDefinition s]
directiveDefinitions :: [DirectiveDefinition s]
}
deriving (Int -> Schema s -> ShowS
[Schema s] -> ShowS
Schema s -> String
(Int -> Schema s -> ShowS)
-> (Schema s -> String) -> ([Schema s] -> ShowS) -> Show (Schema s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> Schema s -> ShowS
forall (s :: Stage). [Schema s] -> ShowS
forall (s :: Stage). Schema s -> String
showList :: [Schema s] -> ShowS
$cshowList :: forall (s :: Stage). [Schema s] -> ShowS
show :: Schema s -> String
$cshow :: forall (s :: Stage). Schema s -> String
showsPrec :: Int -> Schema s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> Schema s -> ShowS
Show, Schema s -> Q Exp
Schema s -> Q (TExp (Schema s))
(Schema s -> Q Exp)
-> (Schema s -> Q (TExp (Schema s))) -> Lift (Schema s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). Schema s -> Q Exp
forall (s :: Stage). Schema s -> Q (TExp (Schema s))
liftTyped :: Schema s -> Q (TExp (Schema s))
$cliftTyped :: forall (s :: Stage). Schema s -> Q (TExp (Schema s))
lift :: Schema s -> Q Exp
$clift :: forall (s :: Stage). Schema s -> Q Exp
Lift)
instance
( Monad m,
Failure ValidationErrors m
) =>
SemigroupM
m
(Schema s)
where
mergeM :: [Ref] -> Schema s -> Schema s -> m (Schema s)
mergeM [Ref]
_ Schema s
s1 Schema s
s2 =
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
(TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s)
-> m (TypeLib s)
-> m (TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema s -> TypeLib s
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
s1 TypeLib s -> TypeLib s -> m (TypeLib s)
forall (m :: * -> *) a. SemigroupM m a => a -> a -> m a
<:> Schema s -> TypeLib s
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
s2)
m (TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s)
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s1) (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s2)
m (Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s] -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s2)
m (Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s] -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m ([DirectiveDefinition s] -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s2)
m ([DirectiveDefinition s] -> Schema s)
-> m [DirectiveDefinition s] -> m (Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [DirectiveDefinition s] -> m [DirectiveDefinition s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema s -> [DirectiveDefinition s]
forall (s :: Stage). Schema s -> [DirectiveDefinition s]
directiveDefinitions Schema s
s1 [DirectiveDefinition s]
-> [DirectiveDefinition s] -> [DirectiveDefinition s]
forall a. Semigroup a => a -> a -> a
<> Schema s -> [DirectiveDefinition s]
forall (s :: Stage). Schema s -> [DirectiveDefinition s]
directiveDefinitions Schema s
s2)
mergeOptional ::
(Monad m, Failure ValidationErrors m) =>
Maybe (TypeDefinition OBJECT s) ->
Maybe (TypeDefinition OBJECT s) ->
m (Maybe (TypeDefinition OBJECT s))
mergeOptional :: Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional Maybe (TypeDefinition OBJECT s)
Nothing Maybe (TypeDefinition OBJECT s)
y = Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
y
mergeOptional (Just TypeDefinition OBJECT s
x) Maybe (TypeDefinition OBJECT s)
Nothing = Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
x)
mergeOptional (Just TypeDefinition OBJECT s
x) (Just TypeDefinition OBJECT s
y) = TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation TypeDefinition OBJECT s
x TypeDefinition OBJECT s
y
mergeOperation ::
(Monad m, Failure ValidationErrors m) =>
TypeDefinition OBJECT s ->
TypeDefinition OBJECT s ->
m (TypeDefinition OBJECT s)
mergeOperation :: TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation
TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i1 FieldsDefinition OUT s
fields1}
TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i2 FieldsDefinition OUT s
fields2, Directives s
Maybe Text
TypeName
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Text
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
..} =
do
FieldsDefinition OUT s
fields <- FieldsDefinition OUT s
fields1 FieldsDefinition OUT s
-> FieldsDefinition OUT s -> m (FieldsDefinition OUT s)
forall (m :: * -> *) a. SemigroupM m a => a -> a -> m a
<:> FieldsDefinition OUT s
fields2
TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall a b. (a -> b) -> a -> b
$ TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Text
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE OBJECT s
typeContent = [TypeName]
-> FieldsDefinition OUT s
-> TypeContent (ELEM OBJECT OBJECT) OBJECT s
forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject ([TypeName]
i1 [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName]
i2) FieldsDefinition OUT s
fields, Directives s
Maybe Text
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
..}
data SchemaDefinition = SchemaDefinition
{ SchemaDefinition -> Directives CONST
schemaDirectives :: Directives CONST,
SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
}
deriving (Int -> SchemaDefinition -> ShowS
[SchemaDefinition] -> ShowS
SchemaDefinition -> String
(Int -> SchemaDefinition -> ShowS)
-> (SchemaDefinition -> String)
-> ([SchemaDefinition] -> ShowS)
-> Show SchemaDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefinition] -> ShowS
$cshowList :: [SchemaDefinition] -> ShowS
show :: SchemaDefinition -> String
$cshow :: SchemaDefinition -> String
showsPrec :: Int -> SchemaDefinition -> ShowS
$cshowsPrec :: Int -> SchemaDefinition -> ShowS
Show)
instance RenderGQL SchemaDefinition where
render :: SchemaDefinition -> Rendering
render = [RootOperationTypeDefinition] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderSchemaDefinition ([RootOperationTypeDefinition] -> Rendering)
-> (SchemaDefinition -> [RootOperationTypeDefinition])
-> SchemaDefinition
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdMap OperationType RootOperationTypeDefinition
-> [RootOperationTypeDefinition]
forall a coll. Elems a coll => coll -> [a]
elems (OrdMap OperationType RootOperationTypeDefinition
-> [RootOperationTypeDefinition])
-> (SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition)
-> SchemaDefinition
-> [RootOperationTypeDefinition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition
renderSchemaDefinition :: RenderGQL a => [a] -> Rendering
renderSchemaDefinition :: [a] -> Rendering
renderSchemaDefinition [a]
entries = Rendering
"schema" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [a] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject [a]
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline
instance Selectable OperationType RootOperationTypeDefinition SchemaDefinition where
selectOr :: d
-> (RootOperationTypeDefinition -> d)
-> OperationType
-> SchemaDefinition
-> d
selectOr d
fallback RootOperationTypeDefinition -> d
f OperationType
key SchemaDefinition {OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition} =
d
-> (RootOperationTypeDefinition -> d)
-> OperationType
-> OrdMap OperationType RootOperationTypeDefinition
-> d
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr d
fallback RootOperationTypeDefinition -> d
f OperationType
key OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition
instance NameCollision SchemaDefinition where
nameCollision :: SchemaDefinition -> ValidationError
nameCollision SchemaDefinition
_ = ValidationError
"There can Be only One SchemaDefinition."
instance KeyOf TypeName SchemaDefinition where
keyOf :: SchemaDefinition -> TypeName
keyOf SchemaDefinition
_ = TypeName
"schema"
data RawTypeDefinition
= RawSchemaDefinition SchemaDefinition
| RawTypeDefinition (TypeDefinition ANY CONST)
| RawDirectiveDefinition (DirectiveDefinition CONST)
deriving (Int -> RawTypeDefinition -> ShowS
[RawTypeDefinition] -> ShowS
RawTypeDefinition -> String
(Int -> RawTypeDefinition -> ShowS)
-> (RawTypeDefinition -> String)
-> ([RawTypeDefinition] -> ShowS)
-> Show RawTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawTypeDefinition] -> ShowS
$cshowList :: [RawTypeDefinition] -> ShowS
show :: RawTypeDefinition -> String
$cshow :: RawTypeDefinition -> String
showsPrec :: Int -> RawTypeDefinition -> ShowS
$cshowsPrec :: Int -> RawTypeDefinition -> ShowS
Show)
data RootOperationTypeDefinition = RootOperationTypeDefinition
{ RootOperationTypeDefinition -> OperationType
rootOperationType :: OperationType,
RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName :: TypeName
}
deriving (Int -> RootOperationTypeDefinition -> ShowS
[RootOperationTypeDefinition] -> ShowS
RootOperationTypeDefinition -> String
(Int -> RootOperationTypeDefinition -> ShowS)
-> (RootOperationTypeDefinition -> String)
-> ([RootOperationTypeDefinition] -> ShowS)
-> Show RootOperationTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootOperationTypeDefinition] -> ShowS
$cshowList :: [RootOperationTypeDefinition] -> ShowS
show :: RootOperationTypeDefinition -> String
$cshow :: RootOperationTypeDefinition -> String
showsPrec :: Int -> RootOperationTypeDefinition -> ShowS
$cshowsPrec :: Int -> RootOperationTypeDefinition -> ShowS
Show, RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
(RootOperationTypeDefinition
-> RootOperationTypeDefinition -> Bool)
-> (RootOperationTypeDefinition
-> RootOperationTypeDefinition -> Bool)
-> Eq RootOperationTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
$c/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
$c== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
Eq)
instance NameCollision RootOperationTypeDefinition where
nameCollision :: RootOperationTypeDefinition -> ValidationError
nameCollision RootOperationTypeDefinition {OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType} =
ValidationError
"There can Be only One TypeDefinition for schema." ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> OperationType -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation OperationType
rootOperationType
instance KeyOf OperationType RootOperationTypeDefinition where
keyOf :: RootOperationTypeDefinition -> OperationType
keyOf = RootOperationTypeDefinition -> OperationType
rootOperationType
instance RenderGQL RootOperationTypeDefinition where
render :: RootOperationTypeDefinition -> Rendering
render
RootOperationTypeDefinition
{ OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType,
TypeName
rootOperationTypeDefinitionName :: TypeName
rootOperationTypeDefinitionName :: RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName
} = OperationType -> TypeName -> Rendering
forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry OperationType
rootOperationType TypeName
rootOperationTypeDefinitionName
type TypeLib s = SafeHashMap TypeName (TypeDefinition ANY s)
instance Selectable TypeName (TypeDefinition ANY s) (Schema s) where
selectOr :: d -> (TypeDefinition ANY s -> d) -> TypeName -> Schema s -> d
selectOr d
fb TypeDefinition ANY s -> d
f TypeName
name Schema s
lib = d
-> (TypeDefinition ANY s -> d) -> Maybe (TypeDefinition ANY s) -> d
forall b a. b -> (a -> b) -> Maybe a -> b
maybe d
fb TypeDefinition ANY s -> d
f (TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name Schema s
lib)
instance Elems (TypeDefinition ANY s) (Schema s) where
elems :: Schema s -> [TypeDefinition ANY s]
elems Schema {[DirectiveDefinition s]
Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
directiveDefinitions :: [DirectiveDefinition s]
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
directiveDefinitions :: forall (s :: Stage). Schema s -> [DirectiveDefinition s]
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeLib s
..} =
TypeLib s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems TypeLib s
types
[TypeDefinition ANY s]
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Semigroup a => a -> a -> a
<> (Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s])
-> [Maybe (TypeDefinition OBJECT s)] -> [TypeDefinition ANY s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
forall (s :: Stage).
Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription]
instance
( Monad m,
Failure ValidationErrors m
) =>
FromElems m (TypeDefinition ANY s) (Schema s)
where
fromElems :: [TypeDefinition ANY s] -> m (Schema s)
fromElems [TypeDefinition ANY s]
types =
(RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s)))
-> (RootOperationTypeDefinition, RootOperationTypeDefinition,
RootOperationTypeDefinition)
-> m (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3
([TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Applicative m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types)
( OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query TypeName
"Query",
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Mutation TypeName
"Mutation",
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Subscription TypeName
"Subscription"
)
m (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> ((Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s))
-> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TypeDefinition ANY s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s)
forall (f :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types
defineSchemaWith ::
( Monad f,
Failure ValidationErrors f
) =>
[TypeDefinition cat s] ->
( Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s)
) ->
f (Schema s)
defineSchemaWith :: [TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition cat s]
oTypes (Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription) = do
let types :: [TypeDefinition cat s]
types = [Maybe (TypeDefinition OBJECT s)]
-> [TypeDefinition cat s] -> [TypeDefinition cat s]
forall (c1 :: TypeCategory) (s :: Stage) (c2 :: TypeCategory).
[Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription] [TypeDefinition cat s]
oTypes
let schema :: Schema s
schema = (TypeDefinition OBJECT s -> Schema s
forall (s :: Stage). TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query) {Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription}
(Schema s -> TypeDefinition cat s -> f (Schema s))
-> Schema s -> [TypeDefinition cat s] -> f (Schema s)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((TypeDefinition cat s -> Schema s -> f (Schema s))
-> Schema s -> TypeDefinition cat s -> f (Schema s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeDefinition cat s -> Schema s -> f (Schema s)
forall (m :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
TypeDefinition cat s -> Schema s -> m (Schema s)
safeDefineType) Schema s
schema [TypeDefinition cat s]
types
defineSchemaWith [TypeDefinition cat s]
_ (Maybe (TypeDefinition OBJECT s)
Nothing, Maybe (TypeDefinition OBJECT s)
_, Maybe (TypeDefinition OBJECT s)
_) = ValidationErrors -> f (Schema s)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ValidationError
"Query root type must be provided." :: ValidationError]
excludeTypes :: [Maybe (TypeDefinition c1 s)] -> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes :: [Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [Maybe (TypeDefinition c1 s)]
exclusionTypes = (TypeDefinition c2 s -> Bool)
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [TypeName]
blacklist) (TypeName -> Bool)
-> (TypeDefinition c2 s -> TypeName) -> TypeDefinition c2 s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition c2 s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName)
where
blacklist :: [TypeName]
blacklist :: [TypeName]
blacklist = (TypeDefinition c1 s -> TypeName)
-> [TypeDefinition c1 s] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition c1 s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName ([Maybe (TypeDefinition c1 s)] -> [TypeDefinition c1 s]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (TypeDefinition c1 s)]
exclusionTypes)
withDirectives ::
[DirectiveDefinition s] ->
Schema s ->
Schema s
withDirectives :: [DirectiveDefinition s] -> Schema s -> Schema s
withDirectives [DirectiveDefinition s]
dirs Schema {[DirectiveDefinition s]
Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
directiveDefinitions :: [DirectiveDefinition s]
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
directiveDefinitions :: forall (s :: Stage). Schema s -> [DirectiveDefinition s]
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeLib s
..} =
Schema :: forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
{ directiveDefinitions :: [DirectiveDefinition s]
directiveDefinitions = [DirectiveDefinition s]
directiveDefinitions [DirectiveDefinition s]
-> [DirectiveDefinition s] -> [DirectiveDefinition s]
forall a. Semigroup a => a -> a -> a
<> [DirectiveDefinition s]
dirs,
Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
..
}
buildSchema ::
(Monad m, Failure ValidationErrors m) =>
( Maybe SchemaDefinition,
[TypeDefinition ANY s],
[DirectiveDefinition s]
) ->
m (Schema s)
buildSchema :: (Maybe SchemaDefinition, [TypeDefinition ANY s],
[DirectiveDefinition s])
-> m (Schema s)
buildSchema (Maybe SchemaDefinition
Nothing, [TypeDefinition ANY s]
types, [DirectiveDefinition s]
dirs) = [DirectiveDefinition s] -> Schema s -> Schema s
forall (s :: Stage).
[DirectiveDefinition s] -> Schema s -> Schema s
withDirectives [DirectiveDefinition s]
dirs (Schema s -> Schema s) -> m (Schema s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDefinition ANY s] -> m (Schema s)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems [TypeDefinition ANY s]
types
buildSchema (Just SchemaDefinition
schemaDef, [TypeDefinition ANY s]
types, [DirectiveDefinition s]
dirs) =
[DirectiveDefinition s] -> Schema s -> Schema s
forall (s :: Stage).
[DirectiveDefinition s] -> Schema s -> Schema s
withDirectives
[DirectiveDefinition s]
dirs
(Schema s -> Schema s) -> m (Schema s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (OperationType -> m (Maybe (TypeDefinition OBJECT s)))
-> (OperationType, OperationType, OperationType)
-> m (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp (OperationType
Query, OperationType
Mutation, OperationType
Subscription)
m (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> ((Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s))
-> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TypeDefinition ANY s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s)
forall (f :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types
)
where
selectOp :: OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp OperationType
op = SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition
schemaDef OperationType
op [TypeDefinition ANY s]
types
traverse3 :: Applicative t => (a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 :: (a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 a -> t b
f (a
a1, a
a2, a
a3) = (,,) (b -> b -> b -> (b, b, b)) -> t b -> t (b -> b -> (b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> t b
f a
a1 t (b -> b -> (b, b, b)) -> t b -> t (b -> (b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> t b
f a
a2 t (b -> (b, b, b)) -> t b -> t (b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> t b
f a
a3
typeReference ::
(Monad m, Failure ValidationErrors m) =>
[TypeDefinition ANY s] ->
RootOperationTypeDefinition ->
m (Maybe (TypeDefinition OBJECT s))
typeReference :: [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation =
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Applicative m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation
m (Maybe (TypeDefinition OBJECT s))
-> (Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)))
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe (TypeDefinition OBJECT s))
-> (TypeDefinition OBJECT s -> m (Maybe (TypeDefinition OBJECT s)))
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(ValidationErrors -> m (Maybe (TypeDefinition OBJECT s))
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ValidationError
"Unknown type " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName RootOperationTypeDefinition
rootOperation) ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."])
(Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)))
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s
-> m (Maybe (TypeDefinition OBJECT s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just)
selectOperation ::
( Monad f,
Failure ValidationErrors f
) =>
SchemaDefinition ->
OperationType ->
[TypeDefinition ANY s] ->
f (Maybe (TypeDefinition OBJECT s))
selectOperation :: SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition
schemaDef OperationType
operationType [TypeDefinition ANY s]
lib =
f (Maybe (TypeDefinition OBJECT s))
-> (RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s)))
-> OperationType
-> SchemaDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr (Maybe (TypeDefinition OBJECT s)
-> f (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing) ([TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
lib) OperationType
operationType SchemaDefinition
schemaDef
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query =
Schema :: forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
{ types :: TypeLib s
types = TypeLib s
forall a coll. Collection a coll => coll
empty,
query :: TypeDefinition OBJECT s
query = TypeDefinition OBJECT s
query,
mutation :: Maybe (TypeDefinition OBJECT s)
mutation = Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing,
subscription :: Maybe (TypeDefinition OBJECT s)
subscription = Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing,
directiveDefinitions :: [DirectiveDefinition s]
directiveDefinitions = [DirectiveDefinition s]
forall a coll. Collection a coll => coll
empty
}
isType :: TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType :: TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
x
| TypeName
name TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition OBJECT s
x = TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall a. a -> Maybe a
Just (TypeDefinition OBJECT s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT s
x)
| Bool
otherwise = Maybe (TypeDefinition ANY s)
forall a. Maybe a
Nothing
lookupDataType :: TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType :: TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name Schema {TypeLib s
types :: TypeLib s
types :: forall (s :: Stage). Schema s -> TypeLib s
types, TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription} =
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
query
Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
mutation Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
subscription Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (TypeDefinition ANY s)
-> (TypeDefinition ANY s -> Maybe (TypeDefinition ANY s))
-> TypeName
-> TypeLib s
-> Maybe (TypeDefinition ANY s)
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr Maybe (TypeDefinition ANY s)
forall a. Maybe a
Nothing TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall a. a -> Maybe a
Just TypeName
name TypeLib s
types
data TypeDefinition (a :: TypeCategory) (s :: Stage) = TypeDefinition
{ TypeDefinition a s -> Maybe Text
typeDescription :: Maybe Description,
TypeDefinition a s -> TypeName
typeName :: TypeName,
TypeDefinition a s -> Directives s
typeDirectives :: Directives s,
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
}
deriving (Int -> TypeDefinition a s -> ShowS
[TypeDefinition a s] -> ShowS
TypeDefinition a s -> String
(Int -> TypeDefinition a s -> ShowS)
-> (TypeDefinition a s -> String)
-> ([TypeDefinition a s] -> ShowS)
-> Show (TypeDefinition a s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: TypeCategory) (s :: Stage).
Int -> TypeDefinition a s -> ShowS
forall (a :: TypeCategory) (s :: Stage).
[TypeDefinition a s] -> ShowS
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> String
showList :: [TypeDefinition a s] -> ShowS
$cshowList :: forall (a :: TypeCategory) (s :: Stage).
[TypeDefinition a s] -> ShowS
show :: TypeDefinition a s -> String
$cshow :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> String
showsPrec :: Int -> TypeDefinition a s -> ShowS
$cshowsPrec :: forall (a :: TypeCategory) (s :: Stage).
Int -> TypeDefinition a s -> ShowS
Show, TypeDefinition a s -> Q Exp
TypeDefinition a s -> Q (TExp (TypeDefinition a s))
(TypeDefinition a s -> Q Exp)
-> (TypeDefinition a s -> Q (TExp (TypeDefinition a s)))
-> Lift (TypeDefinition a s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Q Exp
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Q (TExp (TypeDefinition a s))
liftTyped :: TypeDefinition a s -> Q (TExp (TypeDefinition a s))
$cliftTyped :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Q (TExp (TypeDefinition a s))
lift :: TypeDefinition a s -> Q Exp
$clift :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Q Exp
Lift)
instance KeyOf TypeName (TypeDefinition a s) where
keyOf :: TypeDefinition a s -> TypeName
keyOf = TypeDefinition a s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName
instance NameCollision (TypeDefinition cat s) where
nameCollision :: TypeDefinition cat s -> ValidationError
nameCollision TypeDefinition cat s
x = ValidationError
"There can Be only One TypeDefinition Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (TypeDefinition cat s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x) ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."
instance
ToCategory (TypeContent TRUE) cat cat' =>
ToCategory TypeDefinition cat cat'
where
toCategory :: TypeDefinition cat s -> TypeDefinition cat' s
toCategory TypeDefinition {TypeContent TRUE cat s
typeContent :: TypeContent TRUE cat s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Directives s
Maybe Text
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Text
..} =
TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Text
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
{ typeContent :: TypeContent TRUE cat' s
typeContent = TypeContent TRUE cat s -> TypeContent TRUE cat' s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory TypeContent TRUE cat s
typeContent,
Directives s
Maybe Text
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
..
}
possibleTypes :: TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes :: TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes
TypeDefinition
{ TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName,
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements}
}
Schema s'
_ = TypeName
typeName TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
objectImplements
possibleTypes TypeDefinition {typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName = TypeName
name, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface {}} Schema s'
schema =
TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: (TypeDefinition ANY s' -> TypeName)
-> [TypeDefinition ANY s'] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition ANY s' -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeName -> Schema s' -> [TypeDefinition ANY s']
forall (s :: Stage). TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
name Schema s'
schema)
possibleTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName} Schema s'
_ = [TypeName
typeName]
possibleInterfaceTypes ::
TypeName ->
Schema s ->
[TypeDefinition ANY s]
possibleInterfaceTypes :: TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
name Schema s
schema = (TypeDefinition ANY s -> Maybe (TypeDefinition ANY s))
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TypeName -> TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall (c :: TypeCategory) (s :: Stage).
TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name) (Schema s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems Schema s
schema)
isPossibleInterfaceType ::
TypeName ->
TypeDefinition c s ->
Maybe (TypeDefinition c s)
isPossibleInterfaceType :: TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name typeDef :: TypeDefinition c s
typeDef@TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: [TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements}}
| TypeName
name TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (TypeName
typeName TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
objectImplements) = TypeDefinition c s -> Maybe (TypeDefinition c s)
forall a. a -> Maybe a
Just TypeDefinition c s
typeDef
isPossibleInterfaceType TypeName
_ TypeDefinition c s
_ = Maybe (TypeDefinition c s)
forall a. Maybe a
Nothing
instance
(FromCategory (TypeContent TRUE) cat cat') =>
FromCategory TypeDefinition cat cat'
where
fromCategory :: TypeDefinition cat s -> Maybe (TypeDefinition cat' s)
fromCategory TypeDefinition {TypeContent TRUE cat s
typeContent :: TypeContent TRUE cat s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Directives s
Maybe Text
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Text
..} = TypeContent TRUE cat' s -> TypeDefinition cat' s
bla (TypeContent TRUE cat' s -> TypeDefinition cat' s)
-> Maybe (TypeContent TRUE cat' s) -> Maybe (TypeDefinition cat' s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeContent TRUE cat s -> Maybe (TypeContent TRUE cat' s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
FromCategory a k k' =>
a k s -> Maybe (a k' s)
fromCategory TypeContent TRUE cat s
typeContent
where
bla :: TypeContent TRUE cat' s -> TypeDefinition cat' s
bla TypeContent TRUE cat' s
x = TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Text
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE cat' s
typeContent = TypeContent TRUE cat' s
x, Directives s
Maybe Text
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Text
..}
data
TypeContent
(b :: Bool)
(a :: TypeCategory)
(s :: Stage)
where
DataScalar ::
{ TypeContent (ELEM LEAF a) a s -> ScalarDefinition
dataScalar :: ScalarDefinition
} ->
TypeContent (ELEM LEAF a) a s
DataEnum ::
{ TypeContent (ELEM LEAF a) a s -> DataEnum s
enumMembers :: DataEnum s
} ->
TypeContent (ELEM LEAF a) a s
DataInputObject ::
{ TypeContent (ELEM IN a) a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
} ->
TypeContent (ELEM IN a) a s
DataInputUnion ::
{ TypeContent (ELEM IN a) a s -> DataInputUnion s
inputUnionMembers :: DataInputUnion s
} ->
TypeContent (ELEM IN a) a s
DataObject ::
{ TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements :: [TypeName],
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
} ->
TypeContent (ELEM OBJECT a) a s
DataUnion ::
{ TypeContent (ELEM OUT a) a s -> DataUnion s
unionMembers :: DataUnion s
} ->
TypeContent (ELEM OUT a) a s
DataInterface ::
{ TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
} ->
TypeContent (ELEM IMPLEMENTABLE a) a s
deriving instance Show (TypeContent a b s)
deriving instance Lift (TypeContent a b s)
instance ToCategory (TypeContent TRUE) a ANY where
toCategory :: TypeContent TRUE a s -> TypeContent TRUE ANY s
toCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> ScalarDefinition
..} = DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (ELEM LEAF a) a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
toCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> DataEnum s
..} = DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (ELEM LEAF a) a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> FieldsDefinition IN s
..} = DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (ELEM IN a) a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
toCategory DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> DataInputUnion s
..} = DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
DataInputUnion s -> TypeContent (ELEM IN a) a s
DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: DataInputUnion s
..}
toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
toCategory DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OUT a) a s -> DataUnion s
..} = DataUnion :: forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> TypeContent (ELEM OUT a) a s
DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: DataUnion s
..}
toCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
..} = DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (ELEM IMPLEMENTABLE a) a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
instance ToCategory (TypeContent TRUE) OBJECT IMPLEMENTABLE where
toCategory :: TypeContent TRUE OBJECT s -> TypeContent TRUE IMPLEMENTABLE s
toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
instance FromCategory (TypeContent TRUE) ANY IN where
fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE IN s)
fromCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> ScalarDefinition
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (ELEM LEAF a) a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> DataEnum s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (ELEM LEAF a) a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
fromCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> FieldsDefinition IN s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> TypeContent (ELEM IN a) a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
fromCategory DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IN a) a s -> DataInputUnion s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
DataInputUnion s -> TypeContent (ELEM IN a) a s
DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: DataInputUnion s
..}
fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE IN s)
forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY OUT where
fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OUT s)
fromCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> ScalarDefinition
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (ELEM LEAF a) a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM LEAF a) a s -> DataEnum s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (ELEM LEAF a) a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
fromCategory DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OUT a) a s -> DataUnion s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataUnion :: forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> TypeContent (ELEM OUT a) a s
DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: DataUnion s
..}
fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (ELEM IMPLEMENTABLE a) a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE OUT s)
forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY OBJECT where
fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OBJECT s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
..} = TypeContent TRUE OBJECT s -> Maybe (TypeContent TRUE OBJECT s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE OBJECT s)
forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY IMPLEMENTABLE where
fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE IMPLEMENTABLE s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
..} = TypeContent TRUE IMPLEMENTABLE s
-> Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
..} = TypeContent TRUE IMPLEMENTABLE s
-> Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. a -> Maybe a
Just DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (ELEM IMPLEMENTABLE a) a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. Maybe a
Nothing
mkType :: TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType :: TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName TypeContent TRUE a s
typeContent =
TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Text
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
{ TypeName
typeName :: TypeName
typeName :: TypeName
typeName,
typeDescription :: Maybe Text
typeDescription = Maybe Text
forall a. Maybe a
Nothing,
typeDirectives :: Directives s
typeDirectives = [],
TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent
}
createScalarType :: ELEM LEAF a ~ TRUE => TypeName -> TypeDefinition a s
createScalarType :: TypeName -> TypeDefinition a s
createScalarType TypeName
typeName = TypeName -> TypeContent TRUE a s -> TypeDefinition a s
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE a s -> TypeDefinition a s)
-> TypeContent TRUE a s -> TypeDefinition a s
forall a b. (a -> b) -> a -> b
$ ScalarDefinition -> TypeContent (ELEM LEAF a) a s
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> TypeContent (ELEM LEAF a) a s
DataScalar ((Value VALID -> Either Text (Value VALID)) -> ScalarDefinition
ScalarDefinition Value VALID -> Either Text (Value VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
mkEnumContent :: ELEM LEAF a ~ TRUE => [TypeName] -> TypeContent TRUE a s
mkEnumContent :: [TypeName] -> TypeContent TRUE a s
mkEnumContent [TypeName]
typeData = DataEnum s -> TypeContent (ELEM LEAF a) a s
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> TypeContent (ELEM LEAF a) a s
DataEnum ((TypeName -> DataEnumValue s) -> [TypeName] -> DataEnum s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeName -> DataEnumValue s
forall (s :: Stage). TypeName -> DataEnumValue s
mkEnumValue [TypeName]
typeData)
mkUnionContent :: [TypeName] -> TypeContent TRUE OUT s
mkUnionContent :: [TypeName] -> TypeContent TRUE OUT s
mkUnionContent [TypeName]
typeData = DataUnion s -> TypeContent (ELEM OUT OUT) OUT s
forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> TypeContent (ELEM OUT a) a s
DataUnion (DataUnion s -> TypeContent (ELEM OUT OUT) OUT s)
-> DataUnion s -> TypeContent (ELEM OUT OUT) OUT s
forall a b. (a -> b) -> a -> b
$ (TypeName -> UnionMember OUT s) -> [TypeName] -> DataUnion s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeName -> UnionMember OUT s
forall (cat :: TypeCategory) (s :: Stage).
TypeName -> UnionMember cat s
mkUnionMember [TypeName]
typeData
mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue TypeName
enumName =
DataEnumValue :: forall (s :: Stage).
Maybe Text -> TypeName -> [Directive s] -> DataEnumValue s
DataEnumValue
{ TypeName
enumName :: TypeName
enumName :: TypeName
enumName,
enumDescription :: Maybe Text
enumDescription = Maybe Text
forall a. Maybe a
Nothing,
enumDirectives :: [Directive s]
enumDirectives = []
}
isEntNode :: TypeContent TRUE a s -> Bool
isEntNode :: TypeContent TRUE a s -> Bool
isEntNode DataScalar {} = Bool
True
isEntNode DataEnum {} = Bool
True
isEntNode TypeContent TRUE a s
_ = Bool
False
kindOf :: TypeDefinition a s -> TypeKind
kindOf :: TypeDefinition a s -> TypeKind
kindOf TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE a s -> TypeKind
__kind TypeContent TRUE a s
typeContent
where
__kind :: TypeContent TRUE a s -> TypeKind
__kind DataScalar {} = TypeKind
KindScalar
__kind DataEnum {} = TypeKind
KindEnum
__kind DataInputObject {} = TypeKind
KindInputObject
__kind DataObject {} = Maybe OperationType -> TypeKind
KindObject (TypeName -> Maybe OperationType
toOperationType TypeName
typeName)
__kind DataUnion {} = TypeKind
KindUnion
__kind DataInputUnion {} = TypeKind
KindInputUnion
__kind DataInterface {} = TypeKind
KindInterface
fromOperation :: Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation :: Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation (Just TypeDefinition OBJECT s
datatype) = [TypeDefinition OBJECT s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT s
datatype]
fromOperation Maybe (TypeDefinition OBJECT s)
Nothing = []
safeDefineType ::
( Monad m,
Failure ValidationErrors m
) =>
TypeDefinition cat s ->
Schema s ->
m (Schema s)
safeDefineType :: TypeDefinition cat s -> Schema s -> m (Schema s)
safeDefineType dt :: TypeDefinition cat s
dt@TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInputUnion DataInputUnion s
enumKeys} Schema s
lib = do
SafeHashMap TypeName (TypeDefinition ANY s)
types <- TypeDefinition ANY s
-> SafeHashMap TypeName (TypeDefinition ANY s)
-> m (SafeHashMap TypeName (TypeDefinition ANY s))
forall a k (m :: * -> *).
(NameCollision a, KeyOf k a, Monad m,
Failure ValidationErrors m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert TypeDefinition ANY s
unionTags (Schema s -> SafeHashMap TypeName (TypeDefinition ANY s)
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
lib) m (SafeHashMap TypeName (TypeDefinition ANY s))
-> (SafeHashMap TypeName (TypeDefinition ANY s)
-> m (SafeHashMap TypeName (TypeDefinition ANY s)))
-> m (SafeHashMap TypeName (TypeDefinition ANY s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeDefinition ANY s
-> SafeHashMap TypeName (TypeDefinition ANY s)
-> m (SafeHashMap TypeName (TypeDefinition ANY s))
forall a k (m :: * -> *).
(NameCollision a, KeyOf k a, Monad m,
Failure ValidationErrors m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (TypeDefinition cat s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition cat s
dt)
Schema s -> m (Schema s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema s
lib {SafeHashMap TypeName (TypeDefinition ANY s)
types :: SafeHashMap TypeName (TypeDefinition ANY s)
types :: SafeHashMap TypeName (TypeDefinition ANY s)
types}
where
unionTags :: TypeDefinition ANY s
unionTags =
TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Text
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
{ typeName :: TypeName
typeName = TypeName
typeName TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
"Tags",
typeDescription :: Maybe Text
typeDescription = Maybe Text
forall a. Maybe a
Nothing,
typeDirectives :: Directives s
typeDirectives = [],
typeContent :: TypeContent TRUE ANY s
typeContent = [TypeName] -> TypeContent TRUE ANY s
forall (a :: TypeCategory) (s :: Stage).
(ELEM LEAF a ~ TRUE) =>
[TypeName] -> TypeContent TRUE a s
mkEnumContent ((UnionMember IN s -> TypeName) -> DataInputUnion s -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnionMember IN s -> TypeName
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName DataInputUnion s
enumKeys)
}
safeDefineType TypeDefinition cat s
datatype Schema s
lib = do
SafeHashMap TypeName (TypeDefinition ANY s)
types <- TypeDefinition ANY s
-> SafeHashMap TypeName (TypeDefinition ANY s)
-> m (SafeHashMap TypeName (TypeDefinition ANY s))
forall a k (m :: * -> *).
(NameCollision a, KeyOf k a, Monad m,
Failure ValidationErrors m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (TypeDefinition cat s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition cat s
datatype) (Schema s -> SafeHashMap TypeName (TypeDefinition ANY s)
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
lib)
Schema s -> m (Schema s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema s
lib {SafeHashMap TypeName (TypeDefinition ANY s)
types :: SafeHashMap TypeName (TypeDefinition ANY s)
types :: SafeHashMap TypeName (TypeDefinition ANY s)
types}
lookupWith :: Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith :: (a -> k) -> k -> [a] -> Maybe a
lookupWith a -> k
f k
key = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key) (k -> Bool) -> (a -> k) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> k
f)
popByKey ::
(Applicative m, Failure ValidationErrors m) =>
[TypeDefinition ANY s] ->
RootOperationTypeDefinition ->
m (Maybe (TypeDefinition OBJECT s))
popByKey :: [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types (RootOperationTypeDefinition OperationType
opType TypeName
name) = case (TypeDefinition ANY s -> TypeName)
-> TypeName
-> [TypeDefinition ANY s]
-> Maybe (TypeDefinition ANY s)
forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeName
name [TypeDefinition ANY s]
types of
Just dt :: TypeDefinition ANY s
dt@TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {}} ->
Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition ANY s -> Maybe (TypeDefinition OBJECT s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
FromCategory a ANY k =>
a ANY s -> Maybe (a k s)
fromAny TypeDefinition ANY s
dt)
Just {} ->
ValidationErrors -> m (Maybe (TypeDefinition OBJECT s))
forall error (f :: * -> *) v. Failure error f => error -> f v
failure
[ String -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (OperationType -> String
forall a. Show a => a -> String
show OperationType
opType)
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" root type must be Object type if provided, it cannot be "
ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeName
name
]
Maybe (TypeDefinition ANY s)
_ -> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing
__inputname :: FieldName
__inputname :: FieldName
__inputname = FieldName
"inputname"
mkInputUnionFields :: TypeName -> [UnionMember IN s] -> FieldsDefinition IN s
mkInputUnionFields :: TypeName -> [UnionMember IN s] -> FieldsDefinition IN s
mkInputUnionFields TypeName
name [UnionMember IN s]
members = [FieldDefinition IN s] -> FieldsDefinition IN s
forall (cat :: TypeCategory) (s :: Stage).
[FieldDefinition cat s] -> FieldsDefinition cat s
unsafeFromFields ([FieldDefinition IN s] -> FieldsDefinition IN s)
-> [FieldDefinition IN s] -> FieldsDefinition IN s
forall a b. (a -> b) -> a -> b
$ FieldDefinition IN s
fieldTag FieldDefinition IN s
-> [FieldDefinition IN s] -> [FieldDefinition IN s]
forall a. a -> [a] -> [a]
: (UnionMember IN s -> FieldDefinition IN s)
-> [UnionMember IN s] -> [FieldDefinition IN s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnionMember IN s -> FieldDefinition IN s
forall (s :: Stage). UnionMember IN s -> FieldDefinition IN s
mkUnionField [UnionMember IN s]
members
where
fieldTag :: FieldDefinition IN s
fieldTag =
FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Text
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> [Directive s]
-> FieldDefinition cat s
FieldDefinition
{ fieldName :: FieldName
fieldName = FieldName
__inputname,
fieldDescription :: Maybe Text
fieldDescription = Maybe Text
forall a. Maybe a
Nothing,
fieldContent :: Maybe (FieldContent TRUE IN s)
fieldContent = Maybe (FieldContent TRUE IN s)
forall a. Maybe a
Nothing,
fieldType :: TypeRef
fieldType = TypeName -> TypeRef
mkTypeRef (TypeName
name TypeName -> TypeName -> TypeName
forall a. Semigroup a => a -> a -> a
<> TypeName
"Tags"),
fieldDirectives :: [Directive s]
fieldDirectives = []
}
mkUnionField :: UnionMember IN s -> FieldDefinition IN s
mkUnionField :: UnionMember IN s -> FieldDefinition IN s
mkUnionField UnionMember {TypeName
memberName :: TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName} =
FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Text
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> [Directive s]
-> FieldDefinition cat s
FieldDefinition
{ fieldName :: FieldName
fieldName = TypeName -> FieldName
toFieldName TypeName
memberName,
fieldDescription :: Maybe Text
fieldDescription = Maybe Text
forall a. Maybe a
Nothing,
fieldContent :: Maybe (FieldContent TRUE IN s)
fieldContent = Maybe (FieldContent TRUE IN s)
forall a. Maybe a
Nothing,
fieldType :: TypeRef
fieldType =
TypeRef :: TypeName -> Maybe String -> [TypeWrapper] -> TypeRef
TypeRef
{ typeConName :: TypeName
typeConName = TypeName
memberName,
typeWrappers :: [TypeWrapper]
typeWrappers = [TypeWrapper
TypeMaybe],
typeArgs :: Maybe String
typeArgs = Maybe String
forall a. Maybe a
Nothing
},
fieldDirectives :: [Directive s]
fieldDirectives = []
}
instance RenderGQL (Schema s) where
render :: Schema s -> Rendering
render Schema s
schema =
Rendering -> [Rendering] -> Rendering
intercalate Rendering
newline ((TypeDefinition ANY s -> Rendering)
-> [TypeDefinition ANY s] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition ANY s -> Rendering
forall a. RenderGQL a => a -> Rendering
render [TypeDefinition ANY s]
visibleTypes [Rendering] -> [Rendering] -> [Rendering]
forall a. Semigroup a => a -> a -> a
<> [[RootOperationTypeDefinition] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderSchemaDefinition [RootOperationTypeDefinition]
entries])
where
entries :: [RootOperationTypeDefinition]
entries =
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query (TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s -> TypeName
forall a b. (a -> b) -> a -> b
$ Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
schema)
RootOperationTypeDefinition
-> [RootOperationTypeDefinition] -> [RootOperationTypeDefinition]
forall a. a -> [a] -> [a]
: [Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
[ OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Mutation (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
schema,
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Subscription (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
schema
]
visibleTypes :: [TypeDefinition ANY s]
visibleTypes = (TypeDefinition ANY s -> Bool)
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeName -> Bool
isNotSystemTypeName (TypeName -> Bool)
-> (TypeDefinition ANY s -> TypeName)
-> TypeDefinition ANY s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName) (Schema s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems Schema s
schema)
instance RenderGQL (TypeDefinition a s) where
render :: TypeDefinition a s -> Rendering
render TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE a s -> Rendering
__render TypeContent TRUE a s
typeContent Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline
where
__render :: TypeContent TRUE a s -> Rendering
__render DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM IMPLEMENTABLE a) a s -> FieldsDefinition OUT s
interfaceFields} = Rendering
"interface " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldsDefinition OUT s
interfaceFields
__render DataScalar {} = Rendering
"scalar " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName
__render (DataEnum DataEnum s
tags) = Rendering
"enum " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> DataEnum s -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject DataEnum s
tags
__render (DataUnion DataUnion s
members) =
Rendering
"union "
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" = "
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> DataUnion s -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderMembers DataUnion s
members
__render (DataInputObject FieldsDefinition IN s
fields) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldsDefinition IN s
fields
__render (DataInputUnion DataInputUnion s
members) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldsDefinition IN s
fields
where
fields :: FieldsDefinition IN s
fields = TypeName -> DataInputUnion s -> FieldsDefinition IN s
forall (s :: Stage).
TypeName -> [UnionMember IN s] -> FieldsDefinition IN s
mkInputUnionFields TypeName
typeName DataInputUnion s
members
__render DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields} = Rendering
"type " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
render TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
render FieldsDefinition OUT s
objectFields