{-# 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 TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.TypeSystem
( ScalarDefinition (..),
DataEnum,
UnionTypeDefinition,
TypeContent (..),
TypeDefinition (..),
Schema (..),
DataEnumValue (..),
TypeDefinitions,
TypeCategory,
mkEnumContent,
mkUnionContent,
mkType,
createScalarType,
initTypeLib,
kindOf,
isLeaf,
lookupWith,
RawTypeDefinition (..),
RootOperationTypeDefinition (..),
SchemaDefinition (..),
buildSchema,
Typed (Typed),
untyped,
typed,
possibleTypes,
possibleInterfaceTypes,
defineSchemaWith,
isPossibleInterfaceType,
typeDefinitions,
lookupDataType,
)
where
import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Lazy as HM
import Data.Mergeable
( Merge (..),
NameCollision (..),
OrdMap,
)
import Data.Mergeable.SafeHashMap
( SafeHashMap,
toHashMap,
)
import Data.Morpheus.Internal.Utils
( Empty (..),
IsMap (..),
KeyOf (..),
insert,
selectOr,
toPair,
unsafeFromList,
(<:>),
)
import Data.Morpheus.Rendering.RenderGQL
( RenderGQL (..),
Rendering,
intercalate,
newline,
renderEntry,
renderMembers,
renderObject,
)
import Data.Morpheus.Types.Internal.AST.Base
( Description,
TRUE,
Token,
)
import Data.Morpheus.Types.Internal.AST.Error
( GQLError,
msg,
)
import Data.Morpheus.Types.Internal.AST.Fields
( DirectiveDefinition (..),
Directives,
DirectivesDefinition,
FieldsDefinition,
)
import Data.Morpheus.Types.Internal.AST.Name
( TypeName,
isNotSystemTypeName,
unpackName,
)
import Data.Morpheus.Types.Internal.AST.OperationType
( OperationType (..),
toOperationType,
)
import Data.Morpheus.Types.Internal.AST.Stage
( CONST,
Stage,
VALID,
)
import Data.Morpheus.Types.Internal.AST.Type
( Strictness (..),
TypeKind (..),
)
import Data.Morpheus.Types.Internal.AST.TypeCategory
( ANY,
FromCategory (..),
IMPLEMENTABLE,
IN,
INPUT_OBJECT,
LEAF,
OBJECT,
OUT,
ToCategory (..),
TypeCategory,
fromAny,
toAny,
type (<=!),
type (<=?),
)
import Data.Morpheus.Types.Internal.AST.Union
( UnionTypeDefinition,
mkInputUnionFields,
mkUnionMember,
)
import Data.Morpheus.Types.Internal.AST.Value
( Value (..),
)
import qualified Data.Text as T
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
}
newtype ScalarDefinition = ScalarDefinition
{ScalarDefinition -> Value VALID -> Either Token (Value VALID)
validateValue :: Value VALID -> Either Token (Value VALID)}
instance Eq ScalarDefinition where
ScalarDefinition
_ == :: ScalarDefinition -> ScalarDefinition -> Bool
== ScalarDefinition
_ = Bool
False
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 Token
enumDescription :: Maybe Description,
DataEnumValue s -> TypeName
enumName :: TypeName,
DataEnumValue s -> Directives s
enumDirectives :: Directives 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, DataEnumValue s -> DataEnumValue s -> Bool
(DataEnumValue s -> DataEnumValue s -> Bool)
-> (DataEnumValue s -> DataEnumValue s -> Bool)
-> Eq (DataEnumValue s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
/= :: DataEnumValue s -> DataEnumValue s -> Bool
$c/= :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
== :: DataEnumValue s -> DataEnumValue s -> Bool
$c== :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
Eq)
instance RenderGQL (DataEnumValue s) where
renderGQL :: DataEnumValue s -> Rendering
renderGQL DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName} = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
enumName
data Schema (s :: Stage) = Schema
{ Schema s -> TypeDefinitions s
types :: TypeDefinitions 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 -> DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition 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,
MonadError GQLError m
) =>
Merge m (Schema s)
where
merge :: Schema s -> Schema s -> m (Schema s)
merge Schema s
s1 Schema s
s2 =
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
(TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s)
-> m (TypeDefinitions s)
-> m (TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinitions s -> TypeDefinitions s -> m (TypeDefinitions s)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s1) (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s2)
m (TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s)
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition 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, MonadError GQLError 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)
-> DirectivesDefinition s
-> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition 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, MonadError GQLError 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)
-> DirectivesDefinition s -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (DirectivesDefinition 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, MonadError GQLError 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 (DirectivesDefinition s -> Schema s)
-> m (DirectivesDefinition s) -> m (Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Schema s -> DirectivesDefinition s
forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s1 DirectivesDefinition s
-> DirectivesDefinition s -> m (DirectivesDefinition s)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> Schema s -> DirectivesDefinition s
forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s2
mergeOptional ::
(Monad m, MonadError GQLError 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, MonadError GQLError m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation TypeDefinition OBJECT s
x TypeDefinition OBJECT s
y
mergeOperation ::
(Monad m, MonadError GQLError 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, Maybe Token
Directives s
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 Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..} =
do
FieldsDefinition OUT s
fields <- FieldsDefinition OUT s
-> FieldsDefinition OUT s -> m (FieldsDefinition OUT s)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge FieldsDefinition OUT s
fields1 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 Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE OBJECT s
typeContent = [TypeName]
-> FieldsDefinition OUT s -> CondTypeContent OBJECT OBJECT s
forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject ([TypeName]
i1 [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName]
i2) FieldsDefinition OUT s
fields, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..}
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
renderGQL :: SchemaDefinition -> Rendering
renderGQL = [RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition ([RootOperationTypeDefinition] -> Rendering)
-> (SchemaDefinition -> [RootOperationTypeDefinition])
-> SchemaDefinition
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdMap OperationType RootOperationTypeDefinition
-> [RootOperationTypeDefinition]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (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 :: [RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition :: [RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition [RootOperationTypeDefinition]
entries = Rendering
"schema" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [RootOperationTypeDefinition] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject [RootOperationTypeDefinition]
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline
instance NameCollision GQLError SchemaDefinition where
nameCollision :: SchemaDefinition -> GQLError
nameCollision SchemaDefinition
_ = GQLError
"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 GQLError RootOperationTypeDefinition where
nameCollision :: RootOperationTypeDefinition -> GQLError
nameCollision RootOperationTypeDefinition {OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType} =
GQLError
"There can Be only One TypeDefinition for schema." GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> OperationType -> GQLError
forall a. Msg a => a -> GQLError
msg OperationType
rootOperationType
instance KeyOf OperationType RootOperationTypeDefinition where
keyOf :: RootOperationTypeDefinition -> OperationType
keyOf = RootOperationTypeDefinition -> OperationType
rootOperationType
instance RenderGQL RootOperationTypeDefinition where
renderGQL :: RootOperationTypeDefinition -> Rendering
renderGQL
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 TypeDefinitions s = SafeHashMap TypeName (TypeDefinition ANY s)
typeDefinitions :: Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions :: Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition 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 -> TypeDefinitions s
..} = TypeDefinitions s -> HashMap TypeName (TypeDefinition ANY s)
forall k a. SafeHashMap k a -> HashMap k a
toHashMap TypeDefinitions s
types HashMap TypeName (TypeDefinition ANY s)
-> HashMap TypeName (TypeDefinition ANY s)
-> HashMap TypeName (TypeDefinition ANY s)
forall a. Semigroup a => a -> a -> a
<> [(TypeName, TypeDefinition ANY s)]
-> HashMap TypeName (TypeDefinition ANY s)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(TypeName, TypeDefinition ANY s)]
operations
where
operations :: [(TypeName, TypeDefinition ANY s)]
operations = (TypeDefinition ANY s -> (TypeName, TypeDefinition ANY s))
-> [TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)]
forall a b. (a -> b) -> [a] -> [b]
map TypeDefinition ANY s -> (TypeName, TypeDefinition ANY s)
forall k a. KeyOf k a => a -> (k, a)
toPair ([TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)])
-> [TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)]
forall a b. (a -> b) -> a -> b
$ Schema s -> [TypeDefinition ANY s]
forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema s
schema
rootTypeDefinitions :: Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions :: Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition 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 -> TypeDefinitions s
..} = (TypeDefinition OBJECT s -> TypeDefinition ANY s)
-> [TypeDefinition OBJECT s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> [a] -> [b]
map 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] -> [TypeDefinition ANY s])
-> [TypeDefinition OBJECT s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ [Maybe (TypeDefinition OBJECT s)] -> [TypeDefinition OBJECT s]
forall a. [Maybe a] -> [a]
catMaybes [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]
mkSchema :: (Monad m, MonadError GQLError m) => [TypeDefinition ANY s] -> m (Schema s)
mkSchema :: [TypeDefinition ANY s] -> m (Schema s)
mkSchema [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).
MonadError GQLError 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, MonadError GQLError 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,
MonadError GQLError 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
foldlM ((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 :: * -> *) (k :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition k s -> Schema s -> m (Schema s)
defineType) Schema s
schema [TypeDefinition cat s]
types
defineSchemaWith [TypeDefinition cat s]
_ (Maybe (TypeDefinition OBJECT s)
Nothing, Maybe (TypeDefinition OBJECT s)
_, Maybe (TypeDefinition OBJECT s)
_) = GQLError -> f (Schema s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"Query root type must be provided."
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 ::
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s ->
Schema s ->
m (Schema s)
withDirectives :: DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition 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 -> TypeDefinitions s
..} = do
DirectivesDefinition s
dirs' <- DirectivesDefinition s
directiveDefinitions DirectivesDefinition s
-> DirectivesDefinition s -> m (DirectivesDefinition s)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> DirectivesDefinition s
dirs
Schema s -> m (Schema s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema s -> m (Schema s)) -> Schema s -> m (Schema s)
forall a b. (a -> b) -> a -> b
$
Schema :: forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
{ directiveDefinitions :: DirectivesDefinition s
directiveDefinitions = DirectivesDefinition s
dirs',
Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
TypeDefinition OBJECT s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
..
}
buildSchema ::
(Monad m, MonadError GQLError m) =>
( Maybe SchemaDefinition,
[TypeDefinition ANY s],
DirectivesDefinition s
) ->
m (Schema s)
buildSchema :: (Maybe SchemaDefinition, [TypeDefinition ANY s],
DirectivesDefinition s)
-> m (Schema s)
buildSchema (Maybe SchemaDefinition
Nothing, [TypeDefinition ANY s]
types, DirectivesDefinition s
dirs) = [TypeDefinition ANY s] -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s] -> m (Schema s)
mkSchema [TypeDefinition ANY s]
types m (Schema s) -> (Schema s -> m (Schema s)) -> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DirectivesDefinition s -> Schema s -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs
buildSchema (Just SchemaDefinition
schemaDef, [TypeDefinition ANY s]
types, DirectivesDefinition s
dirs) =
(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, MonadError GQLError f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types
m (Schema s) -> (Schema s -> m (Schema s)) -> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DirectivesDefinition s -> Schema s -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs
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, MonadError GQLError 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, MonadError GQLError 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).
MonadError GQLError 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
(GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> m (Maybe (TypeDefinition OBJECT s)))
-> GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall a b. (a -> b) -> a -> b
$ GQLError
"Unknown type " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName RootOperationTypeDefinition
rootOperation) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
".")
(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,
MonadError GQLError f
) =>
SchemaDefinition ->
OperationType ->
[TypeDefinition ANY s] ->
f (Maybe (TypeDefinition OBJECT s))
selectOperation :: SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition {OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition} OperationType
operationType [TypeDefinition ANY s]
lib =
f (Maybe (TypeDefinition OBJECT s))
-> (RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s)))
-> OperationType
-> OrdMap OperationType RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> 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, MonadError GQLError m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
lib) OperationType
operationType OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query =
Schema :: forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
{ types :: TypeDefinitions s
types = TypeDefinitions s
forall coll. Empty 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 :: DirectivesDefinition s
directiveDefinitions = DirectivesDefinition s
forall coll. Empty 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 {TypeDefinitions s
types :: TypeDefinitions s
types :: forall (s :: Stage). Schema s -> TypeDefinitions 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
<|> TypeName -> TypeDefinitions s -> Maybe (TypeDefinition ANY s)
forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
lookup TypeName
name TypeDefinitions s
types
data TypeDefinition (a :: TypeCategory) (s :: Stage) = TypeDefinition
{ TypeDefinition a s -> Maybe Token
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, TypeDefinition a s -> TypeDefinition a s -> Bool
(TypeDefinition a s -> TypeDefinition a s -> Bool)
-> (TypeDefinition a s -> TypeDefinition a s -> Bool)
-> Eq (TypeDefinition a s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
/= :: TypeDefinition a s -> TypeDefinition a s -> Bool
$c/= :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
== :: TypeDefinition a s -> TypeDefinition a s -> Bool
$c== :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
Eq)
instance Ord (TypeDefinition k s) where
compare :: TypeDefinition k s -> TypeDefinition k s -> Ordering
compare TypeDefinition k s
a TypeDefinition k s
b =
Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeContent TRUE k s -> Int
forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf (TypeContent TRUE k s -> Int) -> TypeContent TRUE k s -> Int
forall a b. (a -> b) -> a -> b
$ TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
a) (TypeContent TRUE k s -> Int
forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf (TypeContent TRUE k s -> Int) -> TypeContent TRUE k s -> Int
forall a b. (a -> b) -> a -> b
$ TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
b)
Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> TypeName -> TypeName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeDefinition k s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition k s
a) (TypeDefinition k s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition k s
b)
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 Strictness (TypeDefinition k s) where
isResolverType :: TypeDefinition k s -> Bool
isResolverType = TypeContent TRUE k s -> Bool
forall t. Strictness t => t -> Bool
isResolverType (TypeContent TRUE k s -> Bool)
-> (TypeDefinition k s -> TypeContent TRUE k s)
-> TypeDefinition k s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent
instance NameCollision GQLError (TypeDefinition cat s) where
nameCollision :: TypeDefinition cat s -> GQLError
nameCollision TypeDefinition cat s
x =
GQLError
"There can Be only One TypeDefinition Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeDefinition cat s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."
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, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
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 Token
..} =
TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Token
-> 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,
Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..
}
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).
CondTypeContent OBJECT 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)
(HashMap TypeName (TypeDefinition ANY s) -> [TypeDefinition ANY s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (HashMap TypeName (TypeDefinition ANY s) -> [TypeDefinition ANY s])
-> HashMap TypeName (TypeDefinition ANY s)
-> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ Schema s -> HashMap TypeName (TypeDefinition ANY s)
forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions 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).
CondTypeContent OBJECT 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, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
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 Token
..} = 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 Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE cat' s
typeContent = TypeContent TRUE cat' s
x, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..}
type CondTypeContent r a s = TypeContent (r <=? a) a s
data
TypeContent
(b :: Bool)
(a :: TypeCategory)
(s :: Stage)
where
DataScalar ::
{ CondTypeContent LEAF a s -> ScalarDefinition
dataScalar :: ScalarDefinition
} ->
CondTypeContent LEAF a s
DataEnum ::
{ CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum s
} ->
CondTypeContent LEAF a s
DataInputObject ::
{ CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
} ->
CondTypeContent INPUT_OBJECT a s
DataInputUnion ::
{ CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
} ->
CondTypeContent IN a s
DataObject ::
{ CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName],
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
} ->
CondTypeContent OBJECT a s
DataUnion ::
{ CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
} ->
CondTypeContent OUT a s
DataInterface ::
{ CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
} ->
CondTypeContent IMPLEMENTABLE a s
deriving instance Show (TypeContent a b s)
deriving instance Eq (TypeContent a b s)
deriving instance Lift (TypeContent a b s)
indexOf :: TypeContent b a s -> Int
indexOf :: TypeContent b a s -> Int
indexOf DataScalar {} = Int
0
indexOf DataEnum {} = Int
1
indexOf DataInputObject {} = Int
2
indexOf DataInputUnion {} = Int
3
indexOf DataInterface {} = Int
4
indexOf DataObject {} = Int
5
indexOf DataUnion {} = Int
6
instance Strictness (TypeContent TRUE k s) where
isResolverType :: TypeContent TRUE k s -> Bool
isResolverType DataObject {} = Bool
True
isResolverType DataUnion {} = Bool
True
isResolverType DataInterface {} = Bool
True
isResolverType TypeContent TRUE k s
_ = Bool
False
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).
CondTypeContent LEAF a s -> ScalarDefinition
..} = DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
toCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
..} = DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF 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).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
toCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> UnionTypeDefinition IN s
..} = DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> CondTypeContent IN a s
DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
..}
toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
toCategory DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = DataUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
toCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE 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).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
instance ToCategory (TypeContent TRUE) INPUT_OBJECT IN where
toCategory :: TypeContent TRUE INPUT_OBJECT s -> TypeContent TRUE IN s
toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
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).
CondTypeContent LEAF 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 -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF 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 -> CondTypeContent LEAF 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).
CondTypeContent INPUT_OBJECT 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 -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
fromCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> UnionTypeDefinition IN s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> CondTypeContent IN a s
DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN 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).
CondTypeContent LEAF 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 -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF 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 -> CondTypeContent LEAF 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).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT 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 -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
fromCategory DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE 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 -> CondTypeContent IMPLEMENTABLE 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).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT 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 -> CondTypeContent OBJECT 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).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT 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 -> CondTypeContent OBJECT 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).
CondTypeContent IMPLEMENTABLE 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 -> CondTypeContent IMPLEMENTABLE 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 Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
{ TypeName
typeName :: TypeName
typeName :: TypeName
typeName,
typeDescription :: Maybe Token
typeDescription = Maybe Token
forall a. Maybe a
Nothing,
typeDirectives :: Directives s
typeDirectives = Directives s
forall coll. Empty coll => coll
empty,
TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent
}
createScalarType :: (LEAF <=! a) => 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 -> CondTypeContent LEAF a s
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar ((Value VALID -> Either Token (Value VALID)) -> ScalarDefinition
ScalarDefinition Value VALID -> Either Token (Value VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
mkEnumContent :: (LEAF <=! a) => [TypeName] -> TypeContent TRUE a s
mkEnumContent :: [TypeName] -> TypeContent TRUE a s
mkEnumContent [TypeName]
typeData = DataEnum s -> CondTypeContent LEAF a s
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF 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 = UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion (UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s)
-> UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s
forall a b. (a -> b) -> a -> b
$ [(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList ([(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s)
-> [(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s
forall a b. (a -> b) -> a -> b
$ (TypeName -> (TypeName, UnionMember OUT s))
-> [TypeName] -> [(TypeName, UnionMember OUT s)]
forall a b. (a -> b) -> [a] -> [b]
map (UnionMember OUT s -> (TypeName, UnionMember OUT s)
forall k a. KeyOf k a => a -> (k, a)
toPair (UnionMember OUT s -> (TypeName, UnionMember OUT s))
-> (TypeName -> UnionMember OUT s)
-> TypeName
-> (TypeName, UnionMember OUT s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 Token -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue
{ TypeName
enumName :: TypeName
enumName :: TypeName
enumName,
enumDescription :: Maybe Token
enumDescription = Maybe Token
forall a. Maybe a
Nothing,
enumDirectives :: Directives s
enumDirectives = Directives s
forall coll. Empty coll => coll
empty
}
isLeaf :: TypeContent TRUE a s -> Bool
isLeaf :: TypeContent TRUE a s -> Bool
isLeaf DataScalar {} = Bool
True
isLeaf DataEnum {} = Bool
True
isLeaf 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
defineType ::
( Monad m,
MonadError GQLError m
) =>
TypeDefinition k s ->
Schema s ->
m (Schema s)
defineType :: TypeDefinition k s -> Schema s -> m (Schema s)
defineType TypeDefinition k s
datatype Schema s
lib = TypeDefinitions s -> Schema s
updateTypes (TypeDefinitions s -> Schema s)
-> m (TypeDefinitions s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition ANY s -> TypeDefinitions s -> m (TypeDefinitions s)
forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, Failure e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (TypeDefinition k s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition k s
datatype) (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
lib)
where
updateTypes :: TypeDefinitions s -> Schema s
updateTypes TypeDefinitions s
types = Schema s
lib {TypeDefinitions s
types :: TypeDefinitions s
types :: TypeDefinitions 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 ::
(MonadError GQLError 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 {} ->
GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> m (Maybe (TypeDefinition OBJECT s)))
-> GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall a b. (a -> b) -> a -> b
$
String -> GQLError
forall a. Msg a => a -> GQLError
msg (OperationType -> String
forall a. Show a => a -> String
show OperationType
opType)
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" root type must be Object type if provided, it cannot be "
GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg 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
hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName
RootOperationTypeDefinition
{ OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType,
rootOperationTypeDefinitionName :: RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName = TypeName
name
} = OperationType -> String
forall a. Show a => a -> String
show OperationType
rootOperationType String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> String
T.unpack (TypeName -> Token
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name)
instance RenderGQL (Schema s) where
renderGQL :: Schema s -> Rendering
renderGQL schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition 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 -> TypeDefinitions s
..} =
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
renderGQL [TypeDefinition ANY s]
visibleTypes [Rendering] -> [Rendering] -> [Rendering]
forall a. Semigroup a => a -> a -> a
<> [Rendering]
schemaDefinition)
where
schemaDefinition :: [Rendering]
schemaDefinition
| (RootOperationTypeDefinition -> Bool)
-> [RootOperationTypeDefinition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RootOperationTypeDefinition -> Bool
hasDefaultOperationName [RootOperationTypeDefinition]
entries = []
| Bool
otherwise = [[RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition [RootOperationTypeDefinition]
entries]
entries :: [RootOperationTypeDefinition]
entries =
[Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
[ OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query (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
<$> TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query,
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
<$> Maybe (TypeDefinition OBJECT s)
mutation,
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
<$> Maybe (TypeDefinition OBJECT s)
subscription
]
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)
([TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Ord a => [a] -> [a]
sort ([TypeDefinition ANY s] -> [TypeDefinition ANY s])
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ TypeDefinitions s -> [TypeDefinition ANY s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList TypeDefinitions s
types)
[TypeDefinition ANY s]
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Semigroup a => a -> a -> a
<> Schema s -> [TypeDefinition ANY s]
forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema s
schema
instance RenderGQL (TypeDefinition a s) where
renderGQL :: TypeDefinition a s -> Rendering
renderGQL 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).
CondTypeContent IMPLEMENTABLE 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
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL 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
renderGQL 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
renderGQL 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 UnionTypeDefinition OUT s
members) =
Rendering
"union "
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" = "
Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> UnionTypeDefinition OUT s -> Rendering
forall a (t :: * -> *).
(RenderGQL a, Foldable t) =>
t a -> Rendering
renderMembers UnionTypeDefinition OUT 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
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
__render (DataInputUnion UnionTypeDefinition IN s
members) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
where
fields :: FieldsDefinition IN s
fields = UnionTypeDefinition IN s -> FieldsDefinition IN s
forall (t :: * -> *) (s :: Stage).
Foldable t =>
t (UnionMember IN s) -> FieldsDefinition IN s
mkInputUnionFields UnionTypeDefinition IN s
members
__render DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT 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
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition OUT s
objectFields