{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.TypeSystem
  ( ScalarDefinition (..),
    DataEnum,
    DataUnion,
    TypeContent (..),
    TypeDefinition (..),
    Schema (..),
    DataEnumValue (..),
    TypeLib,
    TypeCategory,
    DataInputUnion,
    mkEnumContent,
    mkUnionContent,
    mkType,
    createScalarType,
    initTypeLib,
    kindOf,
    isLeaf,
    lookupWith,
    RawTypeDefinition (..),
    RootOperationTypeDefinition (..),
    SchemaDefinition (..),
    buildSchema,
    Typed (Typed),
    untyped,
    typed,
    possibleTypes,
    possibleInterfaceTypes,
    defineSchemaWith,
  )
where

-- MORPHEUS
import Data.Morpheus.Error.NameCollision
  ( NameCollision (..),
  )
import Data.Morpheus.Ext.OrdMap
  ( OrdMap,
  )
import Data.Morpheus.Ext.SafeHashMap
  ( SafeHashMap,
    insert,
  )
import Data.Morpheus.Ext.SemigroupM
  ( (<:>),
    SemigroupM (..),
  )
import Data.Morpheus.Internal.Utils
  ( Elems (..),
    Empty (..),
    Failure (..),
    FromElems (..),
    KeyOf (..),
    Selectable (..),
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    intercalate,
    newline,
    renderEntry,
    renderMembers,
    renderObject,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    OperationType (..),
    TRUE,
    Token,
    TypeName,
    ValidationError,
    ValidationErrors,
    isNotSystemTypeName,
    msgValidation,
    toOperationType,
  )
import Data.Morpheus.Types.Internal.AST.Fields
  ( Directive,
    DirectiveDefinition (..),
    Directives,
    FieldsDefinition,
  )
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
  ( DataInputUnion,
    DataUnion,
    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]

-- used for preserving type information from untyped values
-- e.g
-- unionType :: UnionMember IN VALID -> Typed IN VALID TypeName
-- unionType = typed memberName
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

-- | used for preserving type information from untyped values
-- see function typed
newtype Typed (cat :: TypeCategory) (s :: Stage) a = Typed
  { Typed cat s a -> a
_untyped :: a
  }

-- scalar
------------------------------------------------------------------
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

-- ENUM VALUE
data DataEnumValue s = DataEnumValue
  { DataEnumValue s -> Maybe Token
enumDescription :: Maybe Description,
    DataEnumValue s -> TypeName
enumName :: TypeName,
    DataEnumValue s -> [Directive s]
enumDirectives :: [Directive s]
  }
  deriving (Int -> DataEnumValue s -> ShowS
[DataEnumValue s] -> ShowS
DataEnumValue s -> String
(Int -> DataEnumValue s -> ShowS)
-> (DataEnumValue s -> String)
-> ([DataEnumValue s] -> ShowS)
-> Show (DataEnumValue s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> DataEnumValue s -> ShowS
forall (s :: Stage). [DataEnumValue s] -> ShowS
forall (s :: Stage). DataEnumValue s -> String
showList :: [DataEnumValue s] -> ShowS
$cshowList :: forall (s :: Stage). [DataEnumValue s] -> ShowS
show :: DataEnumValue s -> String
$cshow :: forall (s :: Stage). DataEnumValue s -> String
showsPrec :: Int -> DataEnumValue s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> DataEnumValue s -> ShowS
Show, DataEnumValue s -> Q Exp
DataEnumValue s -> Q (TExp (DataEnumValue s))
(DataEnumValue s -> Q Exp)
-> (DataEnumValue s -> Q (TExp (DataEnumValue s)))
-> Lift (DataEnumValue s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). DataEnumValue s -> Q Exp
forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
liftTyped :: DataEnumValue s -> Q (TExp (DataEnumValue s))
$cliftTyped :: forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
lift :: DataEnumValue s -> Q Exp
$clift :: forall (s :: Stage). DataEnumValue s -> Q Exp
Lift, 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

-- 3.2 Schema : https://graphql.github.io/graphql-spec/June2018/#sec-Schema
---------------------------------------------------------------------------
-- SchemaDefinition :
--    schema Directives[Const](opt) { RootOperationTypeDefinition(list)}
--
-- RootOperationTypeDefinition :
--    OperationType: NamedType

data Schema (s :: Stage) = Schema
  { Schema s -> TypeLib s
types :: TypeLib s,
    Schema s -> TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s,
    Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s),
    Schema s -> Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s),
    Schema s -> [DirectiveDefinition s]
directiveDefinitions :: [DirectiveDefinition s]
  }
  deriving (Int -> Schema s -> ShowS
[Schema s] -> ShowS
Schema s -> String
(Int -> Schema s -> ShowS)
-> (Schema s -> String) -> ([Schema s] -> ShowS) -> Show (Schema s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> Schema s -> ShowS
forall (s :: Stage). [Schema s] -> ShowS
forall (s :: Stage). Schema s -> String
showList :: [Schema s] -> ShowS
$cshowList :: forall (s :: Stage). [Schema s] -> ShowS
show :: Schema s -> String
$cshow :: forall (s :: Stage). Schema s -> String
showsPrec :: Int -> Schema s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> Schema s -> ShowS
Show, Schema s -> Q Exp
Schema s -> Q (TExp (Schema s))
(Schema s -> Q Exp)
-> (Schema s -> Q (TExp (Schema s))) -> Lift (Schema s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). Schema s -> Q Exp
forall (s :: Stage). Schema s -> Q (TExp (Schema s))
liftTyped :: Schema s -> Q (TExp (Schema s))
$cliftTyped :: forall (s :: Stage). Schema s -> Q (TExp (Schema s))
lift :: Schema s -> Q Exp
$clift :: forall (s :: Stage). Schema s -> Q Exp
Lift)

instance
  ( Monad m,
    Failure ValidationErrors m
  ) =>
  SemigroupM
    m
    (Schema s)
  where
  mergeM :: [Ref FieldName] -> Schema s -> Schema s -> m (Schema s)
mergeM [Ref FieldName]
_ Schema s
s1 Schema s
s2 =
    TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
      (TypeLib s
 -> TypeDefinition OBJECT s
 -> Maybe (TypeDefinition OBJECT s)
 -> Maybe (TypeDefinition OBJECT s)
 -> [DirectiveDefinition s]
 -> Schema s)
-> m (TypeLib s)
-> m (TypeDefinition OBJECT s
      -> Maybe (TypeDefinition OBJECT s)
      -> Maybe (TypeDefinition OBJECT s)
      -> [DirectiveDefinition s]
      -> Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema s -> TypeLib s
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
s1 TypeLib s -> TypeLib s -> m (TypeLib s)
forall (m :: * -> *) a. SemigroupM m a => a -> a -> m a
<:> Schema s -> TypeLib s
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
s2)
      m (TypeDefinition OBJECT s
   -> Maybe (TypeDefinition OBJECT s)
   -> Maybe (TypeDefinition OBJECT s)
   -> [DirectiveDefinition s]
   -> Schema s)
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)
      -> Maybe (TypeDefinition OBJECT s)
      -> [DirectiveDefinition s]
      -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s1) (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s2)
      m (Maybe (TypeDefinition OBJECT s)
   -> Maybe (TypeDefinition OBJECT s)
   -> [DirectiveDefinition s]
   -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (Maybe (TypeDefinition OBJECT s)
      -> [DirectiveDefinition s] -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s2)
      m (Maybe (TypeDefinition OBJECT s)
   -> [DirectiveDefinition s] -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m ([DirectiveDefinition s] -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s2)
      m ([DirectiveDefinition s] -> Schema s)
-> m [DirectiveDefinition s] -> m (Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [DirectiveDefinition s] -> m [DirectiveDefinition s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema s -> [DirectiveDefinition s]
forall (s :: Stage). Schema s -> [DirectiveDefinition s]
directiveDefinitions Schema s
s1 [DirectiveDefinition s]
-> [DirectiveDefinition s] -> [DirectiveDefinition s]
forall a. Semigroup a => a -> a -> a
<> Schema s -> [DirectiveDefinition s]
forall (s :: Stage). Schema s -> [DirectiveDefinition s]
directiveDefinitions Schema s
s2)

mergeOptional ::
  (Monad m, Failure ValidationErrors m) =>
  Maybe (TypeDefinition OBJECT s) ->
  Maybe (TypeDefinition OBJECT s) ->
  m (Maybe (TypeDefinition OBJECT s))
mergeOptional :: Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional Maybe (TypeDefinition OBJECT s)
Nothing Maybe (TypeDefinition OBJECT s)
y = Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
y
mergeOptional (Just TypeDefinition OBJECT s
x) Maybe (TypeDefinition OBJECT s)
Nothing = Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
x)
mergeOptional (Just TypeDefinition OBJECT s
x) (Just TypeDefinition OBJECT s
y) = TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation TypeDefinition OBJECT s
x TypeDefinition OBJECT s
y

mergeOperation ::
  (Monad m, Failure ValidationErrors m) =>
  TypeDefinition OBJECT s ->
  TypeDefinition OBJECT s ->
  m (TypeDefinition OBJECT s)
mergeOperation :: TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation
  TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i1 FieldsDefinition OUT s
fields1}
  TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i2 FieldsDefinition OUT s
fields2, Directives s
Maybe Token
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
fields1 FieldsDefinition OUT s
-> FieldsDefinition OUT s -> m (FieldsDefinition OUT s)
forall (m :: * -> *) a. SemigroupM m a => a -> a -> m a
<:> FieldsDefinition OUT s
fields2
      TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall a b. (a -> b) -> a -> b
$ TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe 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, Directives s
Maybe Token
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
forall a. RenderGQL a => [a] -> Rendering
renderSchemaDefinition ([RootOperationTypeDefinition] -> Rendering)
-> (SchemaDefinition -> [RootOperationTypeDefinition])
-> SchemaDefinition
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdMap OperationType RootOperationTypeDefinition
-> [RootOperationTypeDefinition]
forall a coll. Elems a coll => coll -> [a]
elems (OrdMap OperationType RootOperationTypeDefinition
 -> [RootOperationTypeDefinition])
-> (SchemaDefinition
    -> OrdMap OperationType RootOperationTypeDefinition)
-> SchemaDefinition
-> [RootOperationTypeDefinition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition

renderSchemaDefinition :: RenderGQL a => [a] -> Rendering
renderSchemaDefinition :: [a] -> Rendering
renderSchemaDefinition [a]
entries = Rendering
"schema" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> [a] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject [a]
entries Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline

instance Selectable OperationType RootOperationTypeDefinition SchemaDefinition where
  selectOr :: d
-> (RootOperationTypeDefinition -> d)
-> OperationType
-> SchemaDefinition
-> d
selectOr d
fallback RootOperationTypeDefinition -> d
f OperationType
key SchemaDefinition {OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition} =
    d
-> (RootOperationTypeDefinition -> d)
-> OperationType
-> OrdMap OperationType RootOperationTypeDefinition
-> d
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr d
fallback RootOperationTypeDefinition -> d
f OperationType
key OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition

instance NameCollision SchemaDefinition where
  nameCollision :: SchemaDefinition -> ValidationError
nameCollision SchemaDefinition
_ = ValidationError
"There can Be only One SchemaDefinition."

instance KeyOf TypeName SchemaDefinition where
  keyOf :: SchemaDefinition -> TypeName
keyOf SchemaDefinition
_ = TypeName
"schema"

data RawTypeDefinition
  = RawSchemaDefinition SchemaDefinition
  | RawTypeDefinition (TypeDefinition ANY CONST)
  | RawDirectiveDefinition (DirectiveDefinition CONST)
  deriving (Int -> RawTypeDefinition -> ShowS
[RawTypeDefinition] -> ShowS
RawTypeDefinition -> String
(Int -> RawTypeDefinition -> ShowS)
-> (RawTypeDefinition -> String)
-> ([RawTypeDefinition] -> ShowS)
-> Show RawTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawTypeDefinition] -> ShowS
$cshowList :: [RawTypeDefinition] -> ShowS
show :: RawTypeDefinition -> String
$cshow :: RawTypeDefinition -> String
showsPrec :: Int -> RawTypeDefinition -> ShowS
$cshowsPrec :: Int -> RawTypeDefinition -> ShowS
Show)

data RootOperationTypeDefinition = RootOperationTypeDefinition
  { RootOperationTypeDefinition -> OperationType
rootOperationType :: OperationType,
    RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName :: TypeName
  }
  deriving (Int -> RootOperationTypeDefinition -> ShowS
[RootOperationTypeDefinition] -> ShowS
RootOperationTypeDefinition -> String
(Int -> RootOperationTypeDefinition -> ShowS)
-> (RootOperationTypeDefinition -> String)
-> ([RootOperationTypeDefinition] -> ShowS)
-> Show RootOperationTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootOperationTypeDefinition] -> ShowS
$cshowList :: [RootOperationTypeDefinition] -> ShowS
show :: RootOperationTypeDefinition -> String
$cshow :: RootOperationTypeDefinition -> String
showsPrec :: Int -> RootOperationTypeDefinition -> ShowS
$cshowsPrec :: Int -> RootOperationTypeDefinition -> ShowS
Show, RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
(RootOperationTypeDefinition
 -> RootOperationTypeDefinition -> Bool)
-> (RootOperationTypeDefinition
    -> RootOperationTypeDefinition -> Bool)
-> Eq RootOperationTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
$c/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
$c== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
Eq)

instance NameCollision RootOperationTypeDefinition where
  nameCollision :: RootOperationTypeDefinition -> ValidationError
nameCollision RootOperationTypeDefinition {OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType} =
    ValidationError
"There can Be only One TypeDefinition for schema." ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> OperationType -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation OperationType
rootOperationType

instance KeyOf OperationType RootOperationTypeDefinition where
  keyOf :: RootOperationTypeDefinition -> OperationType
keyOf = RootOperationTypeDefinition -> OperationType
rootOperationType

instance RenderGQL RootOperationTypeDefinition where
  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 TypeLib s = SafeHashMap TypeName (TypeDefinition ANY s)

instance Selectable TypeName (TypeDefinition ANY s) (Schema s) where
  selectOr :: d -> (TypeDefinition ANY s -> d) -> TypeName -> Schema s -> d
selectOr d
fb TypeDefinition ANY s -> d
f TypeName
name Schema s
lib = d
-> (TypeDefinition ANY s -> d) -> Maybe (TypeDefinition ANY s) -> d
forall b a. b -> (a -> b) -> Maybe a -> b
maybe d
fb TypeDefinition ANY s -> d
f (TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name Schema s
lib)

instance Elems (TypeDefinition ANY s) (Schema s) where
  elems :: Schema s -> [TypeDefinition ANY s]
elems Schema {[DirectiveDefinition s]
Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
directiveDefinitions :: [DirectiveDefinition s]
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
directiveDefinitions :: forall (s :: Stage). Schema s -> [DirectiveDefinition s]
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeLib s
..} =
    TypeLib s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems TypeLib s
types
      [TypeDefinition ANY s]
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Semigroup a => a -> a -> a
<> (Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s])
-> [Maybe (TypeDefinition OBJECT s)] -> [TypeDefinition ANY s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
forall (s :: Stage).
Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription]

instance
  ( Monad m,
    Failure ValidationErrors m
  ) =>
  FromElems m (TypeDefinition ANY s) (Schema s)
  where
  fromElems :: [TypeDefinition ANY s] -> m (Schema s)
fromElems [TypeDefinition ANY s]
types =
    (RootOperationTypeDefinition
 -> m (Maybe (TypeDefinition OBJECT s)))
-> (RootOperationTypeDefinition, RootOperationTypeDefinition,
    RootOperationTypeDefinition)
-> m (Maybe (TypeDefinition OBJECT s),
      Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3
      ([TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Applicative m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types)
      ( OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query TypeName
"Query",
        OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Mutation TypeName
"Mutation",
        OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Subscription TypeName
"Subscription"
      )
      m (Maybe (TypeDefinition OBJECT s),
   Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> ((Maybe (TypeDefinition OBJECT s),
     Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
    -> m (Schema s))
-> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TypeDefinition ANY s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s)
forall (f :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types

defineSchemaWith ::
  ( Monad f,
    Failure ValidationErrors f
  ) =>
  [TypeDefinition cat s] ->
  ( Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s)
  ) ->
  f (Schema s)
defineSchemaWith :: [TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition cat s]
oTypes (Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription) = do
  let types :: [TypeDefinition cat s]
types = [Maybe (TypeDefinition OBJECT s)]
-> [TypeDefinition cat s] -> [TypeDefinition cat s]
forall (c1 :: TypeCategory) (s :: Stage) (c2 :: TypeCategory).
[Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription] [TypeDefinition cat s]
oTypes
  let schema :: Schema s
schema = (TypeDefinition OBJECT s -> Schema s
forall (s :: Stage). TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query) {Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription}
  (Schema s -> TypeDefinition cat s -> f (Schema s))
-> Schema s -> [TypeDefinition cat s] -> f (Schema s)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
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, Failure ValidationErrors 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)
_) = ValidationErrors -> f (Schema s)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ValidationError
"Query root type must be provided." :: ValidationError]

excludeTypes :: [Maybe (TypeDefinition c1 s)] -> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes :: [Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [Maybe (TypeDefinition c1 s)]
exclusionTypes = (TypeDefinition c2 s -> Bool)
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [TypeName]
blacklist) (TypeName -> Bool)
-> (TypeDefinition c2 s -> TypeName) -> TypeDefinition c2 s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition c2 s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName)
  where
    blacklist :: [TypeName]
    blacklist :: [TypeName]
blacklist = (TypeDefinition c1 s -> TypeName)
-> [TypeDefinition c1 s] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition c1 s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName ([Maybe (TypeDefinition c1 s)] -> [TypeDefinition c1 s]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (TypeDefinition c1 s)]
exclusionTypes)

withDirectives ::
  [DirectiveDefinition s] ->
  Schema s ->
  Schema s
withDirectives :: [DirectiveDefinition s] -> Schema s -> Schema s
withDirectives [DirectiveDefinition s]
dirs Schema {[DirectiveDefinition s]
Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
directiveDefinitions :: [DirectiveDefinition s]
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
directiveDefinitions :: forall (s :: Stage). Schema s -> [DirectiveDefinition s]
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeLib s
..} =
  Schema :: forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
    { directiveDefinitions :: [DirectiveDefinition s]
directiveDefinitions = [DirectiveDefinition s]
directiveDefinitions [DirectiveDefinition s]
-> [DirectiveDefinition s] -> [DirectiveDefinition s]
forall a. Semigroup a => a -> a -> a
<> [DirectiveDefinition s]
dirs,
      Maybe (TypeDefinition OBJECT s)
TypeLib s
TypeDefinition OBJECT s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeLib s
..
    }

buildSchema ::
  (Monad m, Failure ValidationErrors m) =>
  ( Maybe SchemaDefinition,
    [TypeDefinition ANY s],
    [DirectiveDefinition s]
  ) ->
  m (Schema s)
buildSchema :: (Maybe SchemaDefinition, [TypeDefinition ANY s],
 [DirectiveDefinition s])
-> m (Schema s)
buildSchema (Maybe SchemaDefinition
Nothing, [TypeDefinition ANY s]
types, [DirectiveDefinition s]
dirs) = [DirectiveDefinition s] -> Schema s -> Schema s
forall (s :: Stage).
[DirectiveDefinition s] -> Schema s -> Schema s
withDirectives [DirectiveDefinition s]
dirs (Schema s -> Schema s) -> m (Schema s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDefinition ANY s] -> m (Schema s)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems [TypeDefinition ANY s]
types
buildSchema (Just SchemaDefinition
schemaDef, [TypeDefinition ANY s]
types, [DirectiveDefinition s]
dirs) =
  [DirectiveDefinition s] -> Schema s -> Schema s
forall (s :: Stage).
[DirectiveDefinition s] -> Schema s -> Schema s
withDirectives
    [DirectiveDefinition s]
dirs
    (Schema s -> Schema s) -> m (Schema s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (OperationType -> m (Maybe (TypeDefinition OBJECT s)))
-> (OperationType, OperationType, OperationType)
-> m (Maybe (TypeDefinition OBJECT s),
      Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp (OperationType
Query, OperationType
Mutation, OperationType
Subscription)
            m (Maybe (TypeDefinition OBJECT s),
   Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> ((Maybe (TypeDefinition OBJECT s),
     Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
    -> m (Schema s))
-> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TypeDefinition ANY s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s)
forall (f :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types
        )
  where
    selectOp :: OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp OperationType
op = SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) (s :: Stage).
(Monad f, Failure ValidationErrors f) =>
SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition
schemaDef OperationType
op [TypeDefinition ANY s]
types

traverse3 :: Applicative t => (a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 :: (a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 a -> t b
f (a
a1, a
a2, a
a3) = (,,) (b -> b -> b -> (b, b, b)) -> t b -> t (b -> b -> (b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> t b
f a
a1 t (b -> b -> (b, b, b)) -> t b -> t (b -> (b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> t b
f a
a2 t (b -> (b, b, b)) -> t b -> t (b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> t b
f a
a3

typeReference ::
  (Monad m, Failure ValidationErrors m) =>
  [TypeDefinition ANY s] ->
  RootOperationTypeDefinition ->
  m (Maybe (TypeDefinition OBJECT s))
typeReference :: [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation =
  [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Applicative m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation
    m (Maybe (TypeDefinition OBJECT s))
-> (Maybe (TypeDefinition OBJECT s)
    -> m (Maybe (TypeDefinition OBJECT s)))
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe (TypeDefinition OBJECT s))
-> (TypeDefinition OBJECT s -> m (Maybe (TypeDefinition OBJECT s)))
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (ValidationErrors -> m (Maybe (TypeDefinition OBJECT s))
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [ValidationError
"Unknown type " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName RootOperationTypeDefinition
rootOperation) ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."])
      (Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TypeDefinition OBJECT s)
 -> m (Maybe (TypeDefinition OBJECT s)))
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s
-> m (Maybe (TypeDefinition OBJECT s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just)

selectOperation ::
  ( Monad f,
    Failure ValidationErrors f
  ) =>
  SchemaDefinition ->
  OperationType ->
  [TypeDefinition ANY s] ->
  f (Maybe (TypeDefinition OBJECT s))
selectOperation :: SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition
schemaDef OperationType
operationType [TypeDefinition ANY s]
lib =
  f (Maybe (TypeDefinition OBJECT s))
-> (RootOperationTypeDefinition
    -> f (Maybe (TypeDefinition OBJECT s)))
-> OperationType
-> SchemaDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr (Maybe (TypeDefinition OBJECT s)
-> f (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing) ([TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, Failure ValidationErrors m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
lib) OperationType
operationType SchemaDefinition
schemaDef

initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query =
  Schema :: forall (s :: Stage).
TypeLib s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> [DirectiveDefinition s]
-> Schema s
Schema
    { types :: TypeLib s
types = TypeLib s
forall 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 :: [DirectiveDefinition s]
directiveDefinitions = [DirectiveDefinition 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 {TypeLib s
types :: TypeLib s
types :: forall (s :: Stage). Schema s -> TypeLib s
types, TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription} =
  TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
query
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
mutation Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
subscription Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (TypeDefinition ANY s)
-> (TypeDefinition ANY s -> Maybe (TypeDefinition ANY s))
-> TypeName
-> TypeLib s
-> Maybe (TypeDefinition ANY s)
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr Maybe (TypeDefinition ANY s)
forall a. Maybe a
Nothing TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall a. a -> Maybe a
Just TypeName
name TypeLib s
types

-- 3.4 Types : https://graphql.github.io/graphql-spec/June2018/#sec-Types
-------------------------------------------------------------------------
-- TypeDefinition :
--   ScalarTypeDefinition
--   ObjectTypeDefinition
--   InterfaceTypeDefinition
--   UnionTypeDefinition
--   EnumTypeDefinition
--   InputObjectTypeDefinition

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 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 (TypeDefinition cat s) where
  nameCollision :: TypeDefinition cat s -> ValidationError
nameCollision TypeDefinition cat s
x = ValidationError
"There can Be only One TypeDefinition Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (TypeDefinition cat s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x) ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"."

instance
  ToCategory (TypeContent TRUE) cat cat' =>
  ToCategory TypeDefinition cat cat'
  where
  toCategory :: TypeDefinition cat s -> TypeDefinition cat' s
toCategory TypeDefinition {TypeContent TRUE cat s
typeContent :: TypeContent TRUE cat s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Directives s
Maybe Token
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,
        Directives s
Maybe Token
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) (Schema s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems Schema s
schema)

isPossibleInterfaceType ::
  TypeName ->
  TypeDefinition c s ->
  Maybe (TypeDefinition c s)
isPossibleInterfaceType :: TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name typeDef :: TypeDefinition c s
typeDef@TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: [TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
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, Directives s
Maybe Token
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, Directives s
Maybe Token
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 -> DataInputUnion s
inputUnionMembers :: DataInputUnion 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 -> DataUnion s
unionMembers :: DataUnion 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)

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 {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> DataInputUnion s
..} = DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
DataInputUnion s -> CondTypeContent IN a s
DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: DataInputUnion s
..}
  toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
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 {DataUnion s
unionMembers :: DataUnion s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> DataUnion s
..} = DataUnion :: forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> CondTypeContent OUT a s
DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: DataUnion s
..}
  toCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
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 {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> DataInputUnion s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
DataInputUnion s -> CondTypeContent IN a s
DataInputUnion {DataInputUnion s
inputUnionMembers :: DataInputUnion s
inputUnionMembers :: DataInputUnion s
..}
  fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE IN s)
forall a. Maybe a
Nothing

instance FromCategory (TypeContent TRUE) ANY OUT where
  fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OUT s)
fromCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
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 {DataUnion s
unionMembers :: DataUnion s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> DataUnion s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataUnion :: forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> CondTypeContent OUT a s
DataUnion {DataUnion s
unionMembers :: DataUnion s
unionMembers :: DataUnion s
..}
  fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
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 = [],
      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 = DataUnion s -> CondTypeContent OUT OUT s
forall (s :: Stage) (a :: TypeCategory).
DataUnion s -> CondTypeContent OUT a s
DataUnion (DataUnion s -> CondTypeContent OUT OUT s)
-> DataUnion s -> CondTypeContent OUT OUT s
forall a b. (a -> b) -> a -> b
$ (TypeName -> UnionMember OUT s) -> [TypeName] -> DataUnion s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeName -> UnionMember OUT s
forall (cat :: TypeCategory) (s :: Stage).
TypeName -> UnionMember cat s
mkUnionMember [TypeName]
typeData

mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue TypeName
enumName =
  DataEnumValue :: forall (s :: Stage).
Maybe Token -> TypeName -> [Directive s] -> DataEnumValue s
DataEnumValue
    { TypeName
enumName :: TypeName
enumName :: TypeName
enumName,
      enumDescription :: Maybe Token
enumDescription = Maybe Token
forall a. Maybe a
Nothing,
      enumDirectives :: [Directive s]
enumDirectives = []
    }

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

fromOperation :: Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation :: Maybe (TypeDefinition OBJECT s) -> [TypeDefinition ANY s]
fromOperation (Just TypeDefinition OBJECT s
datatype) = [TypeDefinition OBJECT s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT s
datatype]
fromOperation Maybe (TypeDefinition OBJECT s)
Nothing = []

defineType ::
  ( Monad m,
    Failure ValidationErrors 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 = TypeLib s -> Schema s
updateTypes (TypeLib s -> Schema s) -> m (TypeLib s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition ANY s -> TypeLib s -> m (TypeLib s)
forall a k (m :: * -> *).
(NameCollision a, KeyOf k a, Monad m,
 Failure ValidationErrors m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (TypeDefinition 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 -> TypeLib s
forall (s :: Stage). Schema s -> TypeLib s
types Schema s
lib)
  where
    updateTypes :: TypeLib s -> Schema s
updateTypes TypeLib s
types = Schema s
lib {TypeLib s
types :: TypeLib s
types :: TypeLib s
types}

lookupWith :: Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith :: (a -> k) -> k -> [a] -> Maybe a
lookupWith a -> k
f k
key = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key) (k -> Bool) -> (a -> k) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> k
f)

popByKey ::
  (Applicative m, Failure ValidationErrors m) =>
  [TypeDefinition ANY s] ->
  RootOperationTypeDefinition ->
  m (Maybe (TypeDefinition OBJECT s))
popByKey :: [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types (RootOperationTypeDefinition OperationType
opType TypeName
name) = case (TypeDefinition ANY s -> TypeName)
-> TypeName
-> [TypeDefinition ANY s]
-> Maybe (TypeDefinition ANY s)
forall k a. Eq k => (a -> k) -> k -> [a] -> Maybe a
lookupWith TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeName
name [TypeDefinition ANY s]
types of
  Just dt :: TypeDefinition ANY s
dt@TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {}} ->
    Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition ANY s -> Maybe (TypeDefinition OBJECT s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
FromCategory a ANY k =>
a ANY s -> Maybe (a k s)
fromAny TypeDefinition ANY s
dt)
  Just {} ->
    ValidationErrors -> m (Maybe (TypeDefinition OBJECT s))
forall error (f :: * -> *) v. Failure error f => error -> f v
failure
      [ String -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (OperationType -> String
forall a. Show a => a -> String
show OperationType
opType)
          ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
" root type must be Object type if provided, it cannot be "
          ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeName
name
      ]
  Maybe (TypeDefinition ANY s)
_ -> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing

--
-- OTHER
--------------------------------------------------------------------------------------------------

instance RenderGQL (Schema s) where
  renderGQL :: Schema s -> Rendering
renderGQL Schema s
schema =
    Rendering -> [Rendering] -> Rendering
intercalate Rendering
newline ((TypeDefinition ANY s -> Rendering)
-> [TypeDefinition ANY s] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition ANY s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL [TypeDefinition ANY s]
visibleTypes [Rendering] -> [Rendering] -> [Rendering]
forall a. Semigroup a => a -> a -> a
<> [[RootOperationTypeDefinition] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderSchemaDefinition [RootOperationTypeDefinition]
entries])
    where
      entries :: [RootOperationTypeDefinition]
entries =
        OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query (TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s -> TypeName
forall a b. (a -> b) -> a -> b
$ Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
schema)
          RootOperationTypeDefinition
-> [RootOperationTypeDefinition] -> [RootOperationTypeDefinition]
forall a. a -> [a] -> [a]
: [Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
            [ OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Mutation (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
schema,
              OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Subscription (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
schema
            ]
      visibleTypes :: [TypeDefinition ANY s]
visibleTypes = (TypeDefinition ANY s -> Bool)
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. (a -> Bool) -> [a] -> [a]
filter (TypeName -> Bool
isNotSystemTypeName (TypeName -> Bool)
-> (TypeDefinition ANY s -> TypeName)
-> TypeDefinition ANY s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName) (Schema s -> [TypeDefinition ANY s]
forall a coll. Elems a coll => coll -> [a]
elems Schema s
schema)

instance RenderGQL (TypeDefinition a s) where
  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 DataUnion 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
<> DataUnion s -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderMembers DataUnion s
members
      __render (DataInputObject FieldsDefinition IN s
fields) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
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 DataInputUnion 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 = DataInputUnion s -> FieldsDefinition IN s
forall (s :: Stage). [UnionMember IN s] -> FieldsDefinition IN s
mkInputUnionFields DataInputUnion 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