{-# 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,
defineDirective,
)
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,
render,
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,
addDirectives,
)
import Data.Morpheus.Types.Internal.AST.Name
( TypeName,
isNotSystemTypeName,
)
import Data.Morpheus.Types.Internal.AST.OperationType
( OperationType (..),
isOperationType,
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 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 :: forall (a :: TypeCategory -> Stage -> *) (c :: TypeCategory)
(s :: Stage) b.
(a c s -> b) -> a c s -> Typed c s b
typed a c s -> b
f = forall (cat :: TypeCategory) (s :: Stage) a. a -> Typed cat s a
Typed forall b c a. (b -> c) -> (a -> b) -> a -> c
. a c s -> b
f
untyped :: (a -> b) -> Typed c s a -> b
untyped :: forall a b (c :: TypeCategory) (s :: Stage).
(a -> b) -> Typed c s a -> b
untyped a -> b
f = a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) (s :: Stage) a. Typed cat s a -> a
_untyped
newtype Typed (cat :: TypeCategory) (s :: Stage) a = Typed
{ forall (cat :: TypeCategory) (s :: Stage) a. 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 :: forall (m :: * -> *). Quote m => ScalarDefinition -> m Exp
lift ScalarDefinition
_ = [|ScalarDefinition pure|]
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped :: forall (m :: * -> *).
Quote m =>
ScalarDefinition -> Code m ScalarDefinition
liftTyped ScalarDefinition
_ = [||ScalarDefinition pure||]
#endif
data DataEnumValue s = DataEnumValue
{ forall (s :: Stage). DataEnumValue s -> Maybe Token
enumDescription :: Maybe Description,
forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName,
forall (s :: Stage). DataEnumValue s -> Directives s
enumDirectives :: Directives s
}
deriving (Int -> DataEnumValue s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
forall (m :: * -> *). Quote m => DataEnumValue s -> m Exp
forall (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
liftTyped :: forall (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
lift :: forall (m :: * -> *). Quote m => DataEnumValue s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> m Exp
Lift, DataEnumValue s -> DataEnumValue s -> Bool
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 {Maybe Token
Directives s
TypeName
enumDirectives :: Directives s
enumName :: TypeName
enumDescription :: Maybe Token
enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Token
..} = forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
enumName forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
enumDirectives
data Schema (s :: Stage) = Schema
{ forall (s :: Stage). Schema s -> TypeDefinitions s
types :: TypeDefinitions s,
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s,
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s),
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s),
forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
}
deriving (Int -> Schema s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *). Quote m => Schema s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
Schema s -> Code m (Schema s)
forall (m :: * -> *). Quote m => Schema s -> m Exp
forall (m :: * -> *). Quote m => Schema s -> Code m (Schema s)
liftTyped :: forall (m :: * -> *). Quote m => Schema s -> Code m (Schema s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
Schema s -> Code m (Schema s)
lift :: forall (m :: * -> *). Quote m => Schema s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *). Quote m => Schema s -> m Exp
Lift)
instance
( Monad m,
MonadError GQLError m
) =>
Merge m (Schema s)
where
merge :: Monad m => Schema s -> Schema s -> m (Schema s)
merge Schema s
s1 Schema s
s2 =
forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s1) (forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation (forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s1) (forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s1) (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s1) (forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s1
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> 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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional Maybe (TypeDefinition OBJECT s)
Nothing Maybe (TypeDefinition OBJECT s)
y = 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just TypeDefinition OBJECT s
x)
mergeOptional (Just TypeDefinition OBJECT s
x) (Just TypeDefinition OBJECT s
y) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
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 <- forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge FieldsDefinition OUT s
fields1 FieldsDefinition OUT s
fields2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TypeDefinition {typeContent :: TypeContent TRUE OBJECT s
typeContent = forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject ([TypeName]
i1 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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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" forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => [a] -> Rendering
renderObject [RootOperationTypeDefinition]
entries 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
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
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
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." forall a. Semigroup a => a -> a -> a
<> 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
} = 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 :: forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
DirectivesDefinition 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
..} = forall k a. SafeHashMap k a -> HashMap k a
toHashMap TypeDefinitions s
types forall a. Semigroup a => a -> a -> a
<> 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 = forall a b. (a -> b) -> [a] -> [b]
map forall k a. KeyOf k a => a -> (k, a)
toPair forall a b. (a -> b) -> a -> b
$ forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema s
schema
rootTypeDefinitions :: Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions :: forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema {Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
DirectivesDefinition 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
..} = forall a b. (a -> b) -> [a] -> [b]
map forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s] -> m (Schema s)
mkSchema [TypeDefinition ANY s]
types =
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3
(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
OPERATION_QUERY TypeName
"Query",
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_MUTATION TypeName
"Mutation",
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_SUBSCRIPTION TypeName
"Subscription"
)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: 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 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 = forall (c1 :: TypeCategory) (s :: Stage) (c2 :: TypeCategory).
[Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [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 = (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}
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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)
_) = 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 :: forall (c1 :: TypeCategory) (s :: Stage) (c2 :: TypeCategory).
[Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [Maybe (TypeDefinition c1 s)]
exclusionTypes = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [TypeName]
blacklist) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName)
where
blacklist :: [TypeName]
blacklist :: [TypeName]
blacklist = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs Schema {Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
DirectivesDefinition 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 forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> DirectivesDefinition s
dirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
(Maybe SchemaDefinition, [TypeDefinition ANY s],
DirectivesDefinition s)
-> m (Schema s)
buildSchema (Maybe SchemaDefinition
Nothing, [TypeDefinition ANY s]
types, DirectivesDefinition s
dirs) = forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s] -> m (Schema s)
mkSchema [TypeDefinition ANY s]
types forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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) =
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
OPERATION_QUERY, OperationType
OPERATION_MUTATION, OperationType
OPERATION_SUBSCRIPTION)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = 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 :: forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 a -> t b
f (a
a1, a
a2, a
a3) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> t b
f a
a1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> t b
f a
a2 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 :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation =
forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ GQLError
"Unknown type " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName RootOperationTypeDefinition
rootOperation) forall a. Semigroup a => a -> a -> a
<> GQLError
".")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
selectOperation ::
( Monad f,
MonadError GQLError f
) =>
SchemaDefinition ->
OperationType ->
[TypeDefinition ANY s] ->
f (Maybe (TypeDefinition OBJECT s))
selectOperation :: forall (f :: * -> *) (s :: Stage).
(Monad f, MonadError GQLError f) =>
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 =
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (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 :: forall (s :: Stage). TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query =
Schema
{ types :: TypeDefinitions s
types = forall coll. Empty coll => coll
empty,
query :: TypeDefinition OBJECT s
query = TypeDefinition OBJECT s
query,
mutation :: Maybe (TypeDefinition OBJECT s)
mutation = forall a. Maybe a
Nothing,
subscription :: Maybe (TypeDefinition OBJECT s)
subscription = forall a. Maybe a
Nothing,
directiveDefinitions :: DirectivesDefinition s
directiveDefinitions = forall coll. Empty coll => coll
empty
}
isType :: TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType :: forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
x
| TypeName
name forall a. Eq a => a -> a -> Bool
== forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition OBJECT s
x = forall a. a -> Maybe a
Just (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 = forall a. Maybe a
Nothing
lookupDataType :: TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType :: forall (s :: Stage).
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} =
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
query
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
mutation forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
subscription forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
{ forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
typeDescription :: Maybe Description,
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName,
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives :: Directives s,
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
}
deriving (Int -> TypeDefinition a s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> m Exp
forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
forall (m :: * -> *). Quote m => TypeDefinition a s -> m Exp
forall (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
liftTyped :: forall (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
$cliftTyped :: forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
lift :: forall (m :: * -> *). Quote m => TypeDefinition a s -> m Exp
$clift :: forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> m Exp
Lift, TypeDefinition a s -> TypeDefinition a s -> Bool
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 =
forall a. Ord a => a -> a -> Ordering
compare (forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
a) (forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
b)
forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition k s
a) (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 = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName
instance Strictness (TypeDefinition k s) where
isResolverType :: TypeDefinition k s -> Bool
isResolverType = forall t. Strictness t => t -> Bool
isResolverType forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x) forall a. Semigroup a => a -> a -> a
<> GQLError
"."
instance
ToCategory (TypeContent TRUE) cat cat' =>
ToCategory TypeDefinition cat cat'
where
toCategory :: forall (s :: Stage). 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
{ typeContent :: TypeContent TRUE cat' s
typeContent = 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 :: forall (a :: TypeCategory) (s :: Stage) (s' :: Stage).
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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements}
}
Schema s'
_ = 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 forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (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 :: forall (s :: Stage). TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
name Schema s
schema =
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(forall (c :: TypeCategory) (s :: Stage).
TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name)
(forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions Schema s
schema)
isPossibleInterfaceType ::
TypeName ->
TypeDefinition c s ->
Maybe (TypeDefinition c s)
isPossibleInterfaceType :: forall (c :: TypeCategory) (s :: Stage).
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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements}}
| TypeName
name forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (TypeName
typeName forall a. a -> [a] -> [a]
: [TypeName]
objectImplements) = forall a. a -> Maybe a
Just TypeDefinition c s
typeDef
isPossibleInterfaceType TypeName
_ TypeDefinition c s
_ = forall a. Maybe a
Nothing
instance
(FromCategory (TypeContent TRUE) cat cat') =>
FromCategory TypeDefinition cat cat'
where
fromCategory :: forall (s :: Stage).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 {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 ::
{ forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
dataScalar :: ScalarDefinition
} ->
CondTypeContent LEAF a s
DataEnum ::
{ forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum s
} ->
CondTypeContent LEAF a s
DataInputObject ::
{ forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
} ->
CondTypeContent INPUT_OBJECT a s
DataInputUnion ::
{ forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
} ->
CondTypeContent IN a s
DataObject ::
{ forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName],
forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
} ->
CondTypeContent OBJECT a s
DataUnion ::
{ forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
} ->
CondTypeContent OUT a s
DataInterface ::
{ forall (s :: Stage) (a :: TypeCategory).
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 :: forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
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 :: forall (s :: Stage). 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 {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
toCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
..} = DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
toCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IN a s -> UnionTypeDefinition IN 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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
..} = 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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
toCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
instance ToCategory (TypeContent TRUE) OBJECT IMPLEMENTABLE where
toCategory :: forall (s :: Stage).
TypeContent TRUE OBJECT s -> TypeContent TRUE IMPLEMENTABLE s
toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
..} = 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 :: forall (s :: Stage).
TypeContent TRUE INPUT_OBJECT s -> TypeContent TRUE IN s
toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
instance FromCategory (TypeContent TRUE) ANY IN where
fromCategory :: forall (s :: Stage).
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
..} = forall a. a -> Maybe a
Just DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
..} = forall a. a -> Maybe a
Just DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
fromCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = forall a. a -> Maybe a
Just DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
fromCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IN a s -> UnionTypeDefinition IN s
..} = forall a. a -> Maybe a
Just DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
..}
fromCategory TypeContent TRUE ANY s
_ = forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY OUT where
fromCategory :: forall (s :: Stage).
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
..} = forall a. a -> Maybe a
Just DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent LEAF a s -> DataEnum s
..} = forall a. a -> Maybe a
Just DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
..} = forall a. a -> Maybe a
Just 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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = forall a. a -> Maybe a
Just DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = forall a. a -> Maybe a
Just DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
fromCategory TypeContent TRUE ANY s
_ = forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY OBJECT where
fromCategory :: forall (s :: Stage).
TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OBJECT s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
..} = forall a. a -> Maybe a
Just DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
fromCategory TypeContent TRUE ANY s
_ = forall a. Maybe a
Nothing
instance FromCategory (TypeContent TRUE) ANY IMPLEMENTABLE where
fromCategory :: forall (s :: Stage).
TypeContent TRUE ANY s -> Maybe (TypeContent TRUE IMPLEMENTABLE s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
..} = forall a. a -> Maybe a
Just 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 (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = forall a. a -> Maybe a
Just DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
fromCategory TypeContent TRUE ANY s
_ = forall a. Maybe a
Nothing
mkType :: TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType :: forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName TypeContent TRUE a s
typeContent =
TypeDefinition
{ TypeName
typeName :: TypeName
typeName :: TypeName
typeName,
typeDescription :: Maybe Token
typeDescription = forall a. Maybe a
Nothing,
typeDirectives :: Directives s
typeDirectives = 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 :: forall (a :: TypeCategory) (s :: Stage).
(LEAF <=! a) =>
TypeName -> TypeDefinition a s
createScalarType TypeName
typeName = forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar ((Value VALID -> Either Token (Value VALID)) -> ScalarDefinition
ScalarDefinition forall (f :: * -> *) a. Applicative f => a -> f a
pure)
mkEnumContent :: (LEAF <=! a) => [TypeName] -> TypeContent TRUE a s
mkEnumContent :: forall (a :: TypeCategory) (s :: Stage).
(LEAF <=! a) =>
[TypeName] -> TypeContent TRUE a s
mkEnumContent [TypeName]
typeData = forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage). TypeName -> DataEnumValue s
mkEnumValue [TypeName]
typeData)
mkUnionContent :: [TypeName] -> TypeContent TRUE OUT s
mkUnionContent :: forall (s :: Stage). [TypeName] -> TypeContent TRUE OUT s
mkUnionContent [TypeName]
typeData = forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall k a. KeyOf k a => a -> (k, a)
toPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) (s :: Stage).
TypeName -> UnionMember cat s
mkUnionMember) [TypeName]
typeData
mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue :: forall (s :: Stage). TypeName -> DataEnumValue s
mkEnumValue TypeName
enumName =
DataEnumValue
{ TypeName
enumName :: TypeName
enumName :: TypeName
enumName,
enumDescription :: Maybe Token
enumDescription = forall a. Maybe a
Nothing,
enumDirectives :: Directives s
enumDirectives = forall coll. Empty coll => coll
empty
}
isLeaf :: TypeContent TRUE a s -> Bool
isLeaf :: forall (k :: TypeCategory) (s :: Stage).
TypeContent TRUE k s -> Bool
isLeaf DataScalar {} = Bool
True
isLeaf DataEnum {} = Bool
True
isLeaf TypeContent TRUE a s
_ = Bool
False
kindOf :: TypeDefinition a s -> TypeKind
kindOf :: forall (a :: TypeCategory) (s :: Stage).
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
KIND_SCALAR
__kind DataEnum {} = TypeKind
KIND_ENUM
__kind DataInputObject {} = TypeKind
KIND_INPUT_OBJECT
__kind DataObject {} = Maybe OperationType -> TypeKind
KIND_OBJECT (TypeName -> Maybe OperationType
toOperationType TypeName
typeName)
__kind DataUnion {} = TypeKind
KIND_UNION
__kind DataInputUnion {} = TypeKind
KIND_INPUT_UNION
__kind DataInterface {} = TypeKind
KIND_INTERFACE
defineType ::
( Monad m,
MonadError GQLError m
) =>
TypeDefinition k s ->
Schema s ->
m (Schema s)
defineType :: forall (m :: * -> *) (k :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition k s -> Schema s -> m (Schema s)
defineType TypeDefinition k s
datatype Schema s
lib = TypeDefinitions s -> Schema s
updateTypes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, MonadError e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition k s
datatype) (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}
defineDirective ::
( Monad m,
MonadError GQLError m
) =>
Schema s ->
DirectiveDefinition s ->
m (Schema s)
defineDirective :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Schema s -> DirectiveDefinition s -> m (Schema s)
defineDirective Schema s
schema DirectiveDefinition s
directive = DirectivesDefinition s -> Schema s
updateTypes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, MonadError e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert DirectiveDefinition s
directive (forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
schema)
where
updateTypes :: DirectivesDefinition s -> Schema s
updateTypes DirectivesDefinition s
directiveDefinitions = Schema s
schema {DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
directiveDefinitions}
lookupWith :: Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith :: forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith a -> k
f k
key = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== k
key) 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 :: forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types (RootOperationTypeDefinition OperationType
opType TypeName
name) = case forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith 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 {}} ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 {} ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
forall a. Msg a => a -> GQLError
msg (forall a. RenderGQL a => a -> ByteString
render OperationType
opType)
forall a. Semigroup a => a -> a -> a
<> GQLError
" root type must be Object type if provided, it cannot be "
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
name
Maybe (TypeDefinition ANY s)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 -> TypeName -> Bool
isOperationType OperationType
rootOperationType TypeName
name
instance RenderGQL (Schema s) where
renderGQL :: Schema s -> Rendering
renderGQL schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
DirectivesDefinition 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 ([Rendering]
directives forall a. Semigroup a => a -> a -> a
<> [Rendering]
visibleTypes forall a. Semigroup a => a -> a -> a
<> [Rendering]
schemaDefinition)
where
directives :: [Rendering]
directives = forall a. RenderGQL a => a -> Rendering
renderGQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList DirectivesDefinition s
directiveDefinitions
schemaDefinition :: [Rendering]
schemaDefinition
| 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 =
forall a. [Maybe a] -> [a]
catMaybes
[ OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_QUERY forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query,
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_MUTATION forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeDefinition OBJECT s)
mutation,
OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
OPERATION_SUBSCRIPTION forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeDefinition OBJECT s)
subscription
]
visibleTypes :: [Rendering]
visibleTypes =
forall a. RenderGQL a => a -> Rendering
renderGQL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall a. (a -> Bool) -> [a] -> [a]
filter
(TypeName -> Bool
isNotSystemTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName)
(forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList TypeDefinitions s
types)
forall a. Semigroup a => a -> a -> a
<> 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 {Maybe Token
Directives s
TypeName
TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
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 :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
..} = TypeContent TRUE a s -> Rendering
__render TypeContent TRUE a s
typeContent forall a. Semigroup a => a -> a -> a
<> Rendering
newline
where
name :: Rendering
name = forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
typeDirectives
__render :: TypeContent TRUE a s -> Rendering
__render DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields} = Rendering
"interface " forall a. Semigroup a => a -> a -> a
<> Rendering
name forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition OUT s
interfaceFields
__render DataScalar {} = Rendering
"scalar " forall a. Semigroup a => a -> a -> a
<> Rendering
name
__render (DataEnum DataEnum s
tags) = Rendering
"enum " forall a. Semigroup a => a -> a -> a
<> Rendering
name forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => [a] -> Rendering
renderObject DataEnum s
tags
__render (DataUnion UnionTypeDefinition OUT s
members) =
Rendering
"union "
forall a. Semigroup a => a -> a -> a
<> Rendering
name
forall a. Semigroup a => a -> a -> a
<> Rendering
" = "
forall a. Semigroup a => a -> a -> a
<> forall a (t :: * -> *).
(RenderGQL a, Foldable t) =>
t a -> Rendering
renderMembers UnionTypeDefinition OUT s
members
__render (DataInputObject FieldsDefinition IN s
fields) = Rendering
"input " forall a. Semigroup a => a -> a -> a
<> Rendering
name forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
__render (DataInputUnion UnionTypeDefinition IN s
members) = Rendering
"input " forall a. Semigroup a => a -> a -> a
<> Rendering
name forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
where
fields :: FieldsDefinition IN s
fields = 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 (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields} = Rendering
"type " forall a. Semigroup a => a -> a -> a
<> Rendering
name forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition OUT s
objectFields