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

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

import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Lazy as HM
import Data.Mergeable
  ( Merge (..),
    NameCollision (..),
    OrdMap,
  )
import Data.Mergeable.SafeHashMap
  ( SafeHashMap,
    toHashMap,
  )
import Data.Morpheus.Internal.Utils
  ( Empty (..),
    IsMap (..),
    KeyOf (..),
    insert,
    selectOr,
    toPair,
    unsafeFromList,
    (<:>),
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    intercalate,
    newline,
    renderEntry,
    renderMembers,
    renderObject,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    TRUE,
    Token,
  )
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
    msg,
  )
import Data.Morpheus.Types.Internal.AST.Fields
  ( DirectiveDefinition (..),
    Directives,
    DirectivesDefinition,
    FieldsDefinition,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( TypeName,
    isNotSystemTypeName,
    unpackName,
  )
import Data.Morpheus.Types.Internal.AST.OperationType
  ( OperationType (..),
    toOperationType,
  )
import Data.Morpheus.Types.Internal.AST.Stage
  ( CONST,
    Stage,
    VALID,
  )
import Data.Morpheus.Types.Internal.AST.Type
  ( Strictness (..),
    TypeKind (..),
  )
import Data.Morpheus.Types.Internal.AST.TypeCategory
  ( ANY,
    FromCategory (..),
    IMPLEMENTABLE,
    IN,
    INPUT_OBJECT,
    LEAF,
    OBJECT,
    OUT,
    ToCategory (..),
    TypeCategory,
    fromAny,
    toAny,
    type (<=!),
    type (<=?),
  )
import Data.Morpheus.Types.Internal.AST.Union
  ( UnionTypeDefinition,
    mkInputUnionFields,
    mkUnionMember,
  )
import Data.Morpheus.Types.Internal.AST.Value
  ( Value (..),
  )
import qualified Data.Text as T
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude hiding
  ( empty,
    intercalate,
    show,
  )
import Prelude (Show (..))

type DataEnum s = [DataEnumValue s]

-- 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 -> Directives s
enumDirectives :: Directives s
  }
  deriving (Int -> DataEnumValue s -> ShowS
[DataEnumValue s] -> ShowS
DataEnumValue s -> String
(Int -> DataEnumValue s -> ShowS)
-> (DataEnumValue s -> String)
-> ([DataEnumValue s] -> ShowS)
-> Show (DataEnumValue s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> DataEnumValue s -> ShowS
forall (s :: Stage). [DataEnumValue s] -> ShowS
forall (s :: Stage). DataEnumValue s -> String
showList :: [DataEnumValue s] -> ShowS
$cshowList :: forall (s :: Stage). [DataEnumValue s] -> ShowS
show :: DataEnumValue s -> String
$cshow :: forall (s :: Stage). DataEnumValue s -> String
showsPrec :: Int -> DataEnumValue s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> DataEnumValue s -> ShowS
Show, DataEnumValue s -> Q Exp
DataEnumValue s -> Q (TExp (DataEnumValue s))
(DataEnumValue s -> Q Exp)
-> (DataEnumValue s -> Q (TExp (DataEnumValue s)))
-> Lift (DataEnumValue s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). DataEnumValue s -> Q Exp
forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
liftTyped :: DataEnumValue s -> Q (TExp (DataEnumValue s))
$cliftTyped :: forall (s :: Stage). DataEnumValue s -> Q (TExp (DataEnumValue s))
lift :: DataEnumValue s -> Q Exp
$clift :: forall (s :: Stage). DataEnumValue s -> Q Exp
Lift, DataEnumValue s -> DataEnumValue s -> Bool
(DataEnumValue s -> DataEnumValue s -> Bool)
-> (DataEnumValue s -> DataEnumValue s -> Bool)
-> Eq (DataEnumValue s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
/= :: DataEnumValue s -> DataEnumValue s -> Bool
$c/= :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
== :: DataEnumValue s -> DataEnumValue s -> Bool
$c== :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
Eq)

instance RenderGQL (DataEnumValue s) where
  renderGQL :: DataEnumValue s -> Rendering
renderGQL DataEnumValue {TypeName
enumName :: TypeName
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumName} = TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
enumName

-- 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 -> TypeDefinitions s
types :: TypeDefinitions s,
    Schema s -> TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s,
    Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s),
    Schema s -> Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s),
    Schema s -> DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
  }
  deriving (Int -> Schema s -> ShowS
[Schema s] -> ShowS
Schema s -> String
(Int -> Schema s -> ShowS)
-> (Schema s -> String) -> ([Schema s] -> ShowS) -> Show (Schema s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> Schema s -> ShowS
forall (s :: Stage). [Schema s] -> ShowS
forall (s :: Stage). Schema s -> String
showList :: [Schema s] -> ShowS
$cshowList :: forall (s :: Stage). [Schema s] -> ShowS
show :: Schema s -> String
$cshow :: forall (s :: Stage). Schema s -> String
showsPrec :: Int -> Schema s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> Schema s -> ShowS
Show, Schema s -> Q Exp
Schema s -> Q (TExp (Schema s))
(Schema s -> Q Exp)
-> (Schema s -> Q (TExp (Schema s))) -> Lift (Schema s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). Schema s -> Q Exp
forall (s :: Stage). Schema s -> Q (TExp (Schema s))
liftTyped :: Schema s -> Q (TExp (Schema s))
$cliftTyped :: forall (s :: Stage). Schema s -> Q (TExp (Schema s))
lift :: Schema s -> Q Exp
$clift :: forall (s :: Stage). Schema s -> Q Exp
Lift)

instance
  ( Monad m,
    MonadError GQLError m
  ) =>
  Merge m (Schema s)
  where
  merge :: Schema s -> Schema s -> m (Schema s)
merge Schema s
s1 Schema s
s2 =
    TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
      (TypeDefinitions s
 -> TypeDefinition OBJECT s
 -> Maybe (TypeDefinition OBJECT s)
 -> Maybe (TypeDefinition OBJECT s)
 -> DirectivesDefinition s
 -> Schema s)
-> m (TypeDefinitions s)
-> m (TypeDefinition OBJECT s
      -> Maybe (TypeDefinition OBJECT s)
      -> Maybe (TypeDefinition OBJECT s)
      -> DirectivesDefinition s
      -> Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinitions s -> TypeDefinitions s -> m (TypeDefinitions s)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s1) (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
s2)
      m (TypeDefinition OBJECT s
   -> Maybe (TypeDefinition OBJECT s)
   -> Maybe (TypeDefinition OBJECT s)
   -> DirectivesDefinition s
   -> Schema s)
-> m (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s)
      -> Maybe (TypeDefinition OBJECT s)
      -> DirectivesDefinition s
      -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s1) (Schema s -> TypeDefinition OBJECT s
forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query Schema s
s2)
      m (Maybe (TypeDefinition OBJECT s)
   -> Maybe (TypeDefinition OBJECT s)
   -> DirectivesDefinition s
   -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (Maybe (TypeDefinition OBJECT s)
      -> DirectivesDefinition s -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation Schema s
s2)
      m (Maybe (TypeDefinition OBJECT s)
   -> DirectivesDefinition s -> Schema s)
-> m (Maybe (TypeDefinition OBJECT s))
-> m (DirectivesDefinition s -> Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
mergeOptional (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s1) (Schema s -> Maybe (TypeDefinition OBJECT s)
forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription Schema s
s2)
      m (DirectivesDefinition s -> Schema s)
-> m (DirectivesDefinition s) -> m (Schema s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Schema s -> DirectivesDefinition s
forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s1 DirectivesDefinition s
-> DirectivesDefinition s -> m (DirectivesDefinition s)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> Schema s -> DirectivesDefinition s
forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
s2

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

mergeOperation ::
  (Monad m, MonadError GQLError m) =>
  TypeDefinition OBJECT s ->
  TypeDefinition OBJECT s ->
  m (TypeDefinition OBJECT s)
mergeOperation :: TypeDefinition OBJECT s
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
mergeOperation
  TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i1 FieldsDefinition OUT s
fields1}
  TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject [TypeName]
i2 FieldsDefinition OUT s
fields2, Maybe Token
Directives s
TypeName
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..} =
    do
      FieldsDefinition OUT s
fields <- FieldsDefinition OUT s
-> FieldsDefinition OUT s -> m (FieldsDefinition OUT s)
forall (m :: * -> *) a. (Merge m a, Monad m) => a -> a -> m a
merge FieldsDefinition OUT s
fields1 FieldsDefinition OUT s
fields2
      TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s -> m (TypeDefinition OBJECT s)
forall a b. (a -> b) -> a -> b
$ TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE OBJECT s
typeContent = [TypeName]
-> FieldsDefinition OUT s -> CondTypeContent OBJECT OBJECT s
forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject ([TypeName]
i1 [TypeName] -> [TypeName] -> [TypeName]
forall a. Semigroup a => a -> a -> a
<> [TypeName]
i2) FieldsDefinition OUT s
fields, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..}

data SchemaDefinition = SchemaDefinition
  { SchemaDefinition -> Directives CONST
schemaDirectives :: Directives CONST,
    SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
  }
  deriving (Int -> SchemaDefinition -> ShowS
[SchemaDefinition] -> ShowS
SchemaDefinition -> String
(Int -> SchemaDefinition -> ShowS)
-> (SchemaDefinition -> String)
-> ([SchemaDefinition] -> ShowS)
-> Show SchemaDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefinition] -> ShowS
$cshowList :: [SchemaDefinition] -> ShowS
show :: SchemaDefinition -> String
$cshow :: SchemaDefinition -> String
showsPrec :: Int -> SchemaDefinition -> ShowS
$cshowsPrec :: Int -> SchemaDefinition -> ShowS
Show)

instance RenderGQL SchemaDefinition where
  renderGQL :: SchemaDefinition -> Rendering
renderGQL = [RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition ([RootOperationTypeDefinition] -> Rendering)
-> (SchemaDefinition -> [RootOperationTypeDefinition])
-> SchemaDefinition
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdMap OperationType RootOperationTypeDefinition
-> [RootOperationTypeDefinition]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (OrdMap OperationType RootOperationTypeDefinition
 -> [RootOperationTypeDefinition])
-> (SchemaDefinition
    -> OrdMap OperationType RootOperationTypeDefinition)
-> SchemaDefinition
-> [RootOperationTypeDefinition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition

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

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

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

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

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

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

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

instance RenderGQL RootOperationTypeDefinition where
  renderGQL :: RootOperationTypeDefinition -> Rendering
renderGQL
    RootOperationTypeDefinition
      { OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType,
        TypeName
rootOperationTypeDefinitionName :: TypeName
rootOperationTypeDefinitionName :: RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName
      } = OperationType -> TypeName -> Rendering
forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry OperationType
rootOperationType TypeName
rootOperationTypeDefinitionName

type TypeDefinitions s = SafeHashMap TypeName (TypeDefinition ANY s)

typeDefinitions :: Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions :: Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
..} = TypeDefinitions s -> HashMap TypeName (TypeDefinition ANY s)
forall k a. SafeHashMap k a -> HashMap k a
toHashMap TypeDefinitions s
types HashMap TypeName (TypeDefinition ANY s)
-> HashMap TypeName (TypeDefinition ANY s)
-> HashMap TypeName (TypeDefinition ANY s)
forall a. Semigroup a => a -> a -> a
<> [(TypeName, TypeDefinition ANY s)]
-> HashMap TypeName (TypeDefinition ANY s)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(TypeName, TypeDefinition ANY s)]
operations
  where
    operations :: [(TypeName, TypeDefinition ANY s)]
operations = (TypeDefinition ANY s -> (TypeName, TypeDefinition ANY s))
-> [TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)]
forall a b. (a -> b) -> [a] -> [b]
map TypeDefinition ANY s -> (TypeName, TypeDefinition ANY s)
forall k a. KeyOf k a => a -> (k, a)
toPair ([TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)])
-> [TypeDefinition ANY s] -> [(TypeName, TypeDefinition ANY s)]
forall a b. (a -> b) -> a -> b
$ Schema s -> [TypeDefinition ANY s]
forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema s
schema

rootTypeDefinitions :: Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions :: Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
..} = (TypeDefinition OBJECT s -> TypeDefinition ANY s)
-> [TypeDefinition OBJECT s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> [a] -> [b]
map TypeDefinition OBJECT s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny ([TypeDefinition OBJECT s] -> [TypeDefinition ANY s])
-> [TypeDefinition OBJECT s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ [Maybe (TypeDefinition OBJECT s)] -> [TypeDefinition OBJECT s]
forall a. [Maybe a] -> [a]
catMaybes [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription]

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

defineSchemaWith ::
  ( Monad f,
    MonadError GQLError f
  ) =>
  [TypeDefinition cat s] ->
  ( Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s)
  ) ->
  f (Schema s)
defineSchemaWith :: [TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition cat s]
oTypes (Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription) = do
  let types :: [TypeDefinition cat s]
types = [Maybe (TypeDefinition OBJECT s)]
-> [TypeDefinition cat s] -> [TypeDefinition cat s]
forall (c1 :: TypeCategory) (s :: Stage) (c2 :: TypeCategory).
[Maybe (TypeDefinition c1 s)]
-> [TypeDefinition c2 s] -> [TypeDefinition c2 s]
excludeTypes [TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription] [TypeDefinition cat s]
oTypes
  let schema :: Schema s
schema = (TypeDefinition OBJECT s -> Schema s
forall (s :: Stage). TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query) {Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription}
  (Schema s -> TypeDefinition cat s -> f (Schema s))
-> Schema s -> [TypeDefinition cat s] -> f (Schema s)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((TypeDefinition cat s -> Schema s -> f (Schema s))
-> Schema s -> TypeDefinition cat s -> f (Schema s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeDefinition cat s -> Schema s -> f (Schema s)
forall (m :: * -> *) (k :: TypeCategory) (s :: Stage).
(Monad m, MonadError GQLError m) =>
TypeDefinition k s -> Schema s -> m (Schema s)
defineType) Schema s
schema [TypeDefinition cat s]
types
defineSchemaWith [TypeDefinition cat s]
_ (Maybe (TypeDefinition OBJECT s)
Nothing, Maybe (TypeDefinition OBJECT s)
_, Maybe (TypeDefinition OBJECT s)
_) = GQLError -> f (Schema s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"Query root type must be provided."

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

withDirectives ::
  (Monad m, MonadError GQLError m) =>
  DirectivesDefinition s ->
  Schema s ->
  m (Schema s)
withDirectives :: DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
..} = do
  DirectivesDefinition s
dirs' <- DirectivesDefinition s
directiveDefinitions DirectivesDefinition s
-> DirectivesDefinition s -> m (DirectivesDefinition s)
forall (m :: * -> *) a.
(Merge (HistoryT m) a, Monad m) =>
a -> a -> m a
<:> DirectivesDefinition s
dirs
  Schema s -> m (Schema s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema s -> m (Schema s)) -> Schema s -> m (Schema s)
forall a b. (a -> b) -> a -> b
$
    Schema :: forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
      { directiveDefinitions :: DirectivesDefinition s
directiveDefinitions = DirectivesDefinition s
dirs',
        Maybe (TypeDefinition OBJECT s)
TypeDefinitions s
TypeDefinition OBJECT s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
..
      }

buildSchema ::
  (Monad m, MonadError GQLError m) =>
  ( Maybe SchemaDefinition,
    [TypeDefinition ANY s],
    DirectivesDefinition s
  ) ->
  m (Schema s)
buildSchema :: (Maybe SchemaDefinition, [TypeDefinition ANY s],
 DirectivesDefinition s)
-> m (Schema s)
buildSchema (Maybe SchemaDefinition
Nothing, [TypeDefinition ANY s]
types, DirectivesDefinition s
dirs) = [TypeDefinition ANY s] -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s] -> m (Schema s)
mkSchema [TypeDefinition ANY s]
types m (Schema s) -> (Schema s -> m (Schema s)) -> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DirectivesDefinition s -> Schema s -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs
buildSchema (Just SchemaDefinition
schemaDef, [TypeDefinition ANY s]
types, DirectivesDefinition s
dirs) =
  (OperationType -> m (Maybe (TypeDefinition OBJECT s)))
-> (OperationType, OperationType, OperationType)
-> m (Maybe (TypeDefinition OBJECT s),
      Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
forall (t :: * -> *) a b.
Applicative t =>
(a -> t b) -> (a, a, a) -> t (b, b, b)
traverse3 OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp (OperationType
Query, OperationType
Mutation, OperationType
Subscription)
    m (Maybe (TypeDefinition OBJECT s),
   Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> ((Maybe (TypeDefinition OBJECT s),
     Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
    -> m (Schema s))
-> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TypeDefinition ANY s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> m (Schema s)
forall (f :: * -> *) (cat :: TypeCategory) (s :: Stage).
(Monad f, MonadError GQLError f) =>
[TypeDefinition cat s]
-> (Maybe (TypeDefinition OBJECT s),
    Maybe (TypeDefinition OBJECT s), Maybe (TypeDefinition OBJECT s))
-> f (Schema s)
defineSchemaWith [TypeDefinition ANY s]
types
    m (Schema s) -> (Schema s -> m (Schema s)) -> m (Schema s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DirectivesDefinition s -> Schema s -> m (Schema s)
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
DirectivesDefinition s -> Schema s -> m (Schema s)
withDirectives DirectivesDefinition s
dirs
  where
    selectOp :: OperationType -> m (Maybe (TypeDefinition OBJECT s))
selectOp OperationType
op = SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) (s :: Stage).
(Monad f, MonadError GQLError f) =>
SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition
schemaDef OperationType
op [TypeDefinition ANY s]
types

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

typeReference ::
  (Monad m, MonadError GQLError m) =>
  [TypeDefinition ANY s] ->
  RootOperationTypeDefinition ->
  m (Maybe (TypeDefinition OBJECT s))
typeReference :: [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation =
  [TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
popByKey [TypeDefinition ANY s]
types RootOperationTypeDefinition
rootOperation
    m (Maybe (TypeDefinition OBJECT s))
-> (Maybe (TypeDefinition OBJECT s)
    -> m (Maybe (TypeDefinition OBJECT s)))
-> m (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe (TypeDefinition OBJECT s))
-> (TypeDefinition OBJECT s -> m (Maybe (TypeDefinition OBJECT s)))
-> Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> m (Maybe (TypeDefinition OBJECT s)))
-> GQLError -> m (Maybe (TypeDefinition OBJECT s))
forall a b. (a -> b) -> a -> b
$ GQLError
"Unknown type " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName RootOperationTypeDefinition
rootOperation) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
".")
      (Maybe (TypeDefinition OBJECT s)
-> m (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TypeDefinition OBJECT s)
 -> m (Maybe (TypeDefinition OBJECT s)))
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s))
-> TypeDefinition OBJECT s
-> m (Maybe (TypeDefinition OBJECT s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just)

selectOperation ::
  ( Monad f,
    MonadError GQLError f
  ) =>
  SchemaDefinition ->
  OperationType ->
  [TypeDefinition ANY s] ->
  f (Maybe (TypeDefinition OBJECT s))
selectOperation :: SchemaDefinition
-> OperationType
-> [TypeDefinition ANY s]
-> f (Maybe (TypeDefinition OBJECT s))
selectOperation SchemaDefinition {OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition :: SchemaDefinition
-> OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition} OperationType
operationType [TypeDefinition ANY s]
lib =
  f (Maybe (TypeDefinition OBJECT s))
-> (RootOperationTypeDefinition
    -> f (Maybe (TypeDefinition OBJECT s)))
-> OperationType
-> OrdMap OperationType RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr (Maybe (TypeDefinition OBJECT s)
-> f (Maybe (TypeDefinition OBJECT s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing) ([TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> f (Maybe (TypeDefinition OBJECT s))
forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
[TypeDefinition ANY s]
-> RootOperationTypeDefinition
-> m (Maybe (TypeDefinition OBJECT s))
typeReference [TypeDefinition ANY s]
lib) OperationType
operationType OrdMap OperationType RootOperationTypeDefinition
unSchemaDefinition

initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib :: TypeDefinition OBJECT s -> Schema s
initTypeLib TypeDefinition OBJECT s
query =
  Schema :: forall (s :: Stage).
TypeDefinitions s
-> TypeDefinition OBJECT s
-> Maybe (TypeDefinition OBJECT s)
-> Maybe (TypeDefinition OBJECT s)
-> DirectivesDefinition s
-> Schema s
Schema
    { types :: TypeDefinitions s
types = TypeDefinitions s
forall coll. Empty coll => coll
empty,
      query :: TypeDefinition OBJECT s
query = TypeDefinition OBJECT s
query,
      mutation :: Maybe (TypeDefinition OBJECT s)
mutation = Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing,
      subscription :: Maybe (TypeDefinition OBJECT s)
subscription = Maybe (TypeDefinition OBJECT s)
forall a. Maybe a
Nothing,
      directiveDefinitions :: DirectivesDefinition s
directiveDefinitions = DirectivesDefinition s
forall coll. Empty coll => coll
empty
    }

isType :: TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType :: TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
x
  | TypeName
name TypeName -> TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition OBJECT s
x = TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall a. a -> Maybe a
Just (TypeDefinition OBJECT s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT s
x)
  | Bool
otherwise = Maybe (TypeDefinition ANY s)
forall a. Maybe a
Nothing

lookupDataType :: TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType :: TypeName -> Schema s -> Maybe (TypeDefinition ANY s)
lookupDataType TypeName
name Schema {TypeDefinitions s
types :: TypeDefinitions s
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
types, TypeDefinition OBJECT s
query :: TypeDefinition OBJECT s
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
query, Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation, Maybe (TypeDefinition OBJECT s)
subscription :: Maybe (TypeDefinition OBJECT s)
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
subscription} =
  TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name TypeDefinition OBJECT s
query
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
mutation Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (TypeDefinition OBJECT s)
subscription Maybe (TypeDefinition OBJECT s)
-> (TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s))
-> Maybe (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
forall (s :: Stage).
TypeName -> TypeDefinition OBJECT s -> Maybe (TypeDefinition ANY s)
isType TypeName
name)
    Maybe (TypeDefinition ANY s)
-> Maybe (TypeDefinition ANY s) -> Maybe (TypeDefinition ANY s)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeName -> TypeDefinitions s -> Maybe (TypeDefinition ANY s)
forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
lookup TypeName
name TypeDefinitions s
types

-- 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 Ord (TypeDefinition k s) where
  compare :: TypeDefinition k s -> TypeDefinition k s -> Ordering
compare TypeDefinition k s
a TypeDefinition k s
b =
    Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeContent TRUE k s -> Int
forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf (TypeContent TRUE k s -> Int) -> TypeContent TRUE k s -> Int
forall a b. (a -> b) -> a -> b
$ TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
a) (TypeContent TRUE k s -> Int
forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf (TypeContent TRUE k s -> Int) -> TypeContent TRUE k s -> Int
forall a b. (a -> b) -> a -> b
$ TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent TypeDefinition k s
b)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> TypeName -> TypeName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeDefinition k s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition k s
a) (TypeDefinition k s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition k s
b)

instance KeyOf TypeName (TypeDefinition a s) where
  keyOf :: TypeDefinition a s -> TypeName
keyOf = TypeDefinition a s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName

instance Strictness (TypeDefinition k s) where
  isResolverType :: TypeDefinition k s -> Bool
isResolverType = TypeContent TRUE k s -> Bool
forall t. Strictness t => t -> Bool
isResolverType (TypeContent TRUE k s -> Bool)
-> (TypeDefinition k s -> TypeContent TRUE k s)
-> TypeDefinition k s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition k s -> TypeContent TRUE k s
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent

instance NameCollision GQLError (TypeDefinition cat s) where
  nameCollision :: TypeDefinition cat s -> GQLError
nameCollision TypeDefinition cat s
x =
    GQLError
"There can Be only One TypeDefinition Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> TypeName -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeDefinition cat s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition cat s
x) GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."

instance
  ToCategory (TypeContent TRUE) cat cat' =>
  ToCategory TypeDefinition cat cat'
  where
  toCategory :: TypeDefinition cat s -> TypeDefinition cat' s
toCategory TypeDefinition {TypeContent TRUE cat s
typeContent :: TypeContent TRUE cat s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
..} =
    TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
      { typeContent :: TypeContent TRUE cat' s
typeContent = TypeContent TRUE cat s -> TypeContent TRUE cat' s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory TypeContent TRUE cat s
typeContent,
        Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..
      }

possibleTypes :: TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes :: TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes
  TypeDefinition
    { TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName,
      typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements}
    }
  Schema s'
_ = TypeName
typeName TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
objectImplements
possibleTypes TypeDefinition {typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName = TypeName
name, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface {}} Schema s'
schema =
  TypeName
name TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: (TypeDefinition ANY s' -> TypeName)
-> [TypeDefinition ANY s'] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition ANY s' -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeName -> Schema s' -> [TypeDefinition ANY s']
forall (s :: Stage). TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
name Schema s'
schema)
possibleTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName} Schema s'
_ = [TypeName
typeName]

possibleInterfaceTypes ::
  TypeName ->
  Schema s ->
  [TypeDefinition ANY s]
possibleInterfaceTypes :: TypeName -> Schema s -> [TypeDefinition ANY s]
possibleInterfaceTypes TypeName
name Schema s
schema =
  (TypeDefinition ANY s -> Maybe (TypeDefinition ANY s))
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    (TypeName -> TypeDefinition ANY s -> Maybe (TypeDefinition ANY s)
forall (c :: TypeCategory) (s :: Stage).
TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name)
    (HashMap TypeName (TypeDefinition ANY s) -> [TypeDefinition ANY s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (HashMap TypeName (TypeDefinition ANY s) -> [TypeDefinition ANY s])
-> HashMap TypeName (TypeDefinition ANY s)
-> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ Schema s -> HashMap TypeName (TypeDefinition ANY s)
forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions Schema s
schema)

isPossibleInterfaceType ::
  TypeName ->
  TypeDefinition c s ->
  Maybe (TypeDefinition c s)
isPossibleInterfaceType :: TypeName -> TypeDefinition c s -> Maybe (TypeDefinition c s)
isPossibleInterfaceType TypeName
name typeDef :: TypeDefinition c s
typeDef@TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {[TypeName]
objectImplements :: [TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements}}
  | TypeName
name TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (TypeName
typeName TypeName -> [TypeName] -> [TypeName]
forall a. a -> [a] -> [a]
: [TypeName]
objectImplements) = TypeDefinition c s -> Maybe (TypeDefinition c s)
forall a. a -> Maybe a
Just TypeDefinition c s
typeDef
isPossibleInterfaceType TypeName
_ TypeDefinition c s
_ = Maybe (TypeDefinition c s)
forall a. Maybe a
Nothing

instance
  (FromCategory (TypeContent TRUE) cat cat') =>
  FromCategory TypeDefinition cat cat'
  where
  fromCategory :: TypeDefinition cat s -> Maybe (TypeDefinition cat' s)
fromCategory TypeDefinition {TypeContent TRUE cat s
typeContent :: TypeContent TRUE cat s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
..} = TypeContent TRUE cat' s -> TypeDefinition cat' s
bla (TypeContent TRUE cat' s -> TypeDefinition cat' s)
-> Maybe (TypeContent TRUE cat' s) -> Maybe (TypeDefinition cat' s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeContent TRUE cat s -> Maybe (TypeContent TRUE cat' s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (k' :: TypeCategory) (s :: Stage).
FromCategory a k k' =>
a k s -> Maybe (a k' s)
fromCategory TypeContent TRUE cat s
typeContent
    where
      bla :: TypeContent TRUE cat' s -> TypeDefinition cat' s
bla TypeContent TRUE cat' s
x = TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE cat' s
typeContent = TypeContent TRUE cat' s
x, Maybe Token
Directives s
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
..}

type CondTypeContent r a s = TypeContent (r <=? a) a s

data
  TypeContent
    (b :: Bool)
    (a :: TypeCategory)
    (s :: Stage)
  where
  DataScalar ::
    { CondTypeContent LEAF a s -> ScalarDefinition
dataScalar :: ScalarDefinition
    } ->
    CondTypeContent LEAF a s
  DataEnum ::
    { CondTypeContent LEAF a s -> DataEnum s
enumMembers :: DataEnum s
    } ->
    CondTypeContent LEAF a s
  DataInputObject ::
    { CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
    } ->
    CondTypeContent INPUT_OBJECT a s
  DataInputUnion ::
    { CondTypeContent IN a s -> UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
    } ->
    CondTypeContent IN a s
  DataObject ::
    { CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName],
      CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
    } ->
    CondTypeContent OBJECT a s
  DataUnion ::
    { CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
    } ->
    CondTypeContent OUT a s
  DataInterface ::
    { CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
    } ->
    CondTypeContent IMPLEMENTABLE a s

deriving instance Show (TypeContent a b s)

deriving instance Eq (TypeContent a b s)

deriving instance Lift (TypeContent a b s)

indexOf :: TypeContent b a s -> Int
indexOf :: TypeContent b a s -> Int
indexOf DataScalar {} = Int
0
indexOf DataEnum {} = Int
1
indexOf DataInputObject {} = Int
2
indexOf DataInputUnion {} = Int
3
indexOf DataInterface {} = Int
4
indexOf DataObject {} = Int
5
indexOf DataUnion {} = Int
6

instance Strictness (TypeContent TRUE k s) where
  isResolverType :: TypeContent TRUE k s -> Bool
isResolverType DataObject {} = Bool
True
  isResolverType DataUnion {} = Bool
True
  isResolverType DataInterface {} = Bool
True
  isResolverType TypeContent TRUE k s
_ = Bool
False

instance ToCategory (TypeContent TRUE) a ANY where
  toCategory :: TypeContent TRUE a s -> TypeContent TRUE ANY s
toCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
..} = DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  toCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
..} = DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
  toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
  toCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> UnionTypeDefinition IN s
..} = DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> CondTypeContent IN a s
DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
..}
  toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
  toCategory DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = DataUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
  toCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}

instance ToCategory (TypeContent TRUE) OBJECT IMPLEMENTABLE where
  toCategory :: TypeContent TRUE OBJECT s -> TypeContent TRUE IMPLEMENTABLE s
toCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}

instance ToCategory (TypeContent TRUE) INPUT_OBJECT IN where
  toCategory :: TypeContent TRUE INPUT_OBJECT s -> TypeContent TRUE IN s
toCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}

instance FromCategory (TypeContent TRUE) ANY IN where
  fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE IN s)
fromCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
  fromCategory DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent INPUT_OBJECT a s -> FieldsDefinition IN s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputObject :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition IN s -> CondTypeContent INPUT_OBJECT a s
DataInputObject {FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
inputObjectFields :: FieldsDefinition IN s
..}
  fromCategory DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IN a s -> UnionTypeDefinition IN s
..} = TypeContent TRUE IN s -> Maybe (TypeContent TRUE IN s)
forall a. a -> Maybe a
Just DataInputUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition IN s -> CondTypeContent IN a s
DataInputUnion {UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
inputUnionMembers :: UnionTypeDefinition IN s
..}
  fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE IN s)
forall a. Maybe a
Nothing

instance FromCategory (TypeContent TRUE) ANY OUT where
  fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OUT s)
fromCategory DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> ScalarDefinition
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataScalar :: forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar {ScalarDefinition
dataScalar :: ScalarDefinition
dataScalar :: ScalarDefinition
..}
  fromCategory DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent LEAF a s -> DataEnum s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataEnum :: forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum {DataEnum s
enumMembers :: DataEnum s
enumMembers :: DataEnum s
..}
  fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
  fromCategory DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataUnion :: forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion {UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT s
..}
  fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = TypeContent TRUE OUT s -> Maybe (TypeContent TRUE OUT s)
forall a. a -> Maybe a
Just DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
  fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE OUT s)
forall a. Maybe a
Nothing

instance FromCategory (TypeContent TRUE) ANY OBJECT where
  fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE OBJECT s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = TypeContent TRUE OBJECT s -> Maybe (TypeContent TRUE OBJECT s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
  fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE OBJECT s)
forall a. Maybe a
Nothing

instance FromCategory (TypeContent TRUE) ANY IMPLEMENTABLE where
  fromCategory :: TypeContent TRUE ANY s -> Maybe (TypeContent TRUE IMPLEMENTABLE s)
fromCategory DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
..} = TypeContent TRUE IMPLEMENTABLE s
-> Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. a -> Maybe a
Just DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT s
objectImplements :: [TypeName]
..}
  fromCategory DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
..} = TypeContent TRUE IMPLEMENTABLE s
-> Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. a -> Maybe a
Just DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE a s
DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
..}
  fromCategory TypeContent TRUE ANY s
_ = Maybe (TypeContent TRUE IMPLEMENTABLE s)
forall a. Maybe a
Nothing

mkType :: TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType :: TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName TypeContent TRUE a s
typeContent =
  TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Token
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition
    { TypeName
typeName :: TypeName
typeName :: TypeName
typeName,
      typeDescription :: Maybe Token
typeDescription = Maybe Token
forall a. Maybe a
Nothing,
      typeDirectives :: Directives s
typeDirectives = Directives s
forall coll. Empty coll => coll
empty,
      TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent
    }

createScalarType :: (LEAF <=! a) => TypeName -> TypeDefinition a s
createScalarType :: TypeName -> TypeDefinition a s
createScalarType TypeName
typeName = TypeName -> TypeContent TRUE a s -> TypeDefinition a s
forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent TRUE a s -> TypeDefinition a s
mkType TypeName
typeName (TypeContent TRUE a s -> TypeDefinition a s)
-> TypeContent TRUE a s -> TypeDefinition a s
forall a b. (a -> b) -> a -> b
$ ScalarDefinition -> CondTypeContent LEAF a s
forall (a :: TypeCategory) (s :: Stage).
ScalarDefinition -> CondTypeContent LEAF a s
DataScalar ((Value VALID -> Either Token (Value VALID)) -> ScalarDefinition
ScalarDefinition Value VALID -> Either Token (Value VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

mkEnumContent :: (LEAF <=! a) => [TypeName] -> TypeContent TRUE a s
mkEnumContent :: [TypeName] -> TypeContent TRUE a s
mkEnumContent [TypeName]
typeData = DataEnum s -> CondTypeContent LEAF a s
forall (s :: Stage) (a :: TypeCategory).
DataEnum s -> CondTypeContent LEAF a s
DataEnum ((TypeName -> DataEnumValue s) -> [TypeName] -> DataEnum s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeName -> DataEnumValue s
forall (s :: Stage). TypeName -> DataEnumValue s
mkEnumValue [TypeName]
typeData)

mkUnionContent :: [TypeName] -> TypeContent TRUE OUT s
mkUnionContent :: [TypeName] -> TypeContent TRUE OUT s
mkUnionContent [TypeName]
typeData = UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s
forall (s :: Stage) (a :: TypeCategory).
UnionTypeDefinition OUT s -> CondTypeContent OUT a s
DataUnion (UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s)
-> UnionTypeDefinition OUT s -> CondTypeContent OUT OUT s
forall a b. (a -> b) -> a -> b
$ [(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList ([(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s)
-> [(TypeName, UnionMember OUT s)] -> UnionTypeDefinition OUT s
forall a b. (a -> b) -> a -> b
$ (TypeName -> (TypeName, UnionMember OUT s))
-> [TypeName] -> [(TypeName, UnionMember OUT s)]
forall a b. (a -> b) -> [a] -> [b]
map (UnionMember OUT s -> (TypeName, UnionMember OUT s)
forall k a. KeyOf k a => a -> (k, a)
toPair (UnionMember OUT s -> (TypeName, UnionMember OUT s))
-> (TypeName -> UnionMember OUT s)
-> TypeName
-> (TypeName, UnionMember OUT s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> UnionMember OUT s
forall (cat :: TypeCategory) (s :: Stage).
TypeName -> UnionMember cat s
mkUnionMember) [TypeName]
typeData

mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue :: TypeName -> DataEnumValue s
mkEnumValue TypeName
enumName =
  DataEnumValue :: forall (s :: Stage).
Maybe Token -> TypeName -> Directives s -> DataEnumValue s
DataEnumValue
    { TypeName
enumName :: TypeName
enumName :: TypeName
enumName,
      enumDescription :: Maybe Token
enumDescription = Maybe Token
forall a. Maybe a
Nothing,
      enumDirectives :: Directives s
enumDirectives = Directives s
forall coll. Empty coll => coll
empty
    }

isLeaf :: TypeContent TRUE a s -> Bool
isLeaf :: TypeContent TRUE a s -> Bool
isLeaf DataScalar {} = Bool
True
isLeaf DataEnum {} = Bool
True
isLeaf TypeContent TRUE a s
_ = Bool
False

kindOf :: TypeDefinition a s -> TypeKind
kindOf :: TypeDefinition a s -> TypeKind
kindOf TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE a s -> TypeKind
__kind TypeContent TRUE a s
typeContent
  where
    __kind :: TypeContent TRUE a s -> TypeKind
__kind DataScalar {} = TypeKind
KindScalar
    __kind DataEnum {} = TypeKind
KindEnum
    __kind DataInputObject {} = TypeKind
KindInputObject
    __kind DataObject {} = Maybe OperationType -> TypeKind
KindObject (TypeName -> Maybe OperationType
toOperationType TypeName
typeName)
    __kind DataUnion {} = TypeKind
KindUnion
    __kind DataInputUnion {} = TypeKind
KindInputUnion
    __kind DataInterface {} = TypeKind
KindInterface

defineType ::
  ( Monad m,
    MonadError GQLError m
  ) =>
  TypeDefinition k s ->
  Schema s ->
  m (Schema s)
defineType :: TypeDefinition k s -> Schema s -> m (Schema s)
defineType TypeDefinition k s
datatype Schema s
lib = TypeDefinitions s -> Schema s
updateTypes (TypeDefinitions s -> Schema s)
-> m (TypeDefinitions s) -> m (Schema s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition ANY s -> TypeDefinitions s -> m (TypeDefinitions s)
forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, Failure e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert (TypeDefinition k s -> TypeDefinition ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition k s
datatype) (Schema s -> TypeDefinitions s
forall (s :: Stage). Schema s -> TypeDefinitions s
types Schema s
lib)
  where
    updateTypes :: TypeDefinitions s -> Schema s
updateTypes TypeDefinitions s
types = Schema s
lib {TypeDefinitions s
types :: TypeDefinitions s
types :: TypeDefinitions s
types}

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

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

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

hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName
  RootOperationTypeDefinition
    { OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType,
      rootOperationTypeDefinitionName :: RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName = TypeName
name
    } = OperationType -> String
forall a. Show a => a -> String
show OperationType
rootOperationType String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> String
T.unpack (TypeName -> Token
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name)

instance RenderGQL (Schema s) where
  renderGQL :: Schema s -> Rendering
renderGQL schema :: Schema s
schema@Schema {Maybe (TypeDefinition OBJECT s)
DirectivesDefinition s
TypeDefinitions s
TypeDefinition OBJECT s
directiveDefinitions :: DirectivesDefinition s
subscription :: Maybe (TypeDefinition OBJECT s)
mutation :: Maybe (TypeDefinition OBJECT s)
query :: TypeDefinition OBJECT s
types :: TypeDefinitions s
directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s
subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s)
query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s
types :: forall (s :: Stage). Schema s -> TypeDefinitions s
..} =
    Rendering -> [Rendering] -> Rendering
intercalate Rendering
newline ((TypeDefinition ANY s -> Rendering)
-> [TypeDefinition ANY s] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeDefinition ANY s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL [TypeDefinition ANY s]
visibleTypes [Rendering] -> [Rendering] -> [Rendering]
forall a. Semigroup a => a -> a -> a
<> [Rendering]
schemaDefinition)
    where
      schemaDefinition :: [Rendering]
schemaDefinition
        | (RootOperationTypeDefinition -> Bool)
-> [RootOperationTypeDefinition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RootOperationTypeDefinition -> Bool
hasDefaultOperationName [RootOperationTypeDefinition]
entries = []
        | Bool
otherwise = [[RootOperationTypeDefinition] -> Rendering
renderSchemaDefinition [RootOperationTypeDefinition]
entries]
      entries :: [RootOperationTypeDefinition]
entries =
        [Maybe RootOperationTypeDefinition]
-> [RootOperationTypeDefinition]
forall a. [Maybe a] -> [a]
catMaybes
          [ OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Query (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDefinition OBJECT s -> Maybe (TypeDefinition OBJECT s)
forall a. a -> Maybe a
Just TypeDefinition OBJECT s
query,
            OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Mutation (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeDefinition OBJECT s)
mutation,
            OperationType -> TypeName -> RootOperationTypeDefinition
RootOperationTypeDefinition OperationType
Subscription (TypeName -> RootOperationTypeDefinition)
-> (TypeDefinition OBJECT s -> TypeName)
-> TypeDefinition OBJECT s
-> RootOperationTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition OBJECT s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName (TypeDefinition OBJECT s -> RootOperationTypeDefinition)
-> Maybe (TypeDefinition OBJECT s)
-> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeDefinition OBJECT s)
subscription
          ]
      visibleTypes :: [TypeDefinition ANY s]
visibleTypes =
        (TypeDefinition ANY s -> Bool)
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (TypeName -> Bool
isNotSystemTypeName (TypeName -> Bool)
-> (TypeDefinition ANY s -> TypeName)
-> TypeDefinition ANY s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition ANY s -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName)
          ([TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Ord a => [a] -> [a]
sort ([TypeDefinition ANY s] -> [TypeDefinition ANY s])
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a b. (a -> b) -> a -> b
$ TypeDefinitions s -> [TypeDefinition ANY s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList TypeDefinitions s
types)
          [TypeDefinition ANY s]
-> [TypeDefinition ANY s] -> [TypeDefinition ANY s]
forall a. Semigroup a => a -> a -> a
<> Schema s -> [TypeDefinition ANY s]
forall (s :: Stage). Schema s -> [TypeDefinition ANY s]
rootTypeDefinitions Schema s
schema

instance RenderGQL (TypeDefinition a s) where
  renderGQL :: TypeDefinition a s -> Rendering
renderGQL TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE a s -> Rendering
__render TypeContent TRUE a s
typeContent Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
newline
    where
      __render :: TypeContent TRUE a s -> Rendering
__render DataInterface {FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT s
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields} = Rendering
"interface " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition OUT s
interfaceFields
      __render DataScalar {} = Rendering
"scalar " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName
      __render (DataEnum DataEnum s
tags) = Rendering
"enum " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> DataEnum s -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject DataEnum s
tags
      __render (DataUnion UnionTypeDefinition OUT s
members) =
        Rendering
"union "
          Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName
          Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
" = "
          Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> UnionTypeDefinition OUT s -> Rendering
forall a (t :: * -> *).
(RenderGQL a, Foldable t) =>
t a -> Rendering
renderMembers UnionTypeDefinition OUT s
members
      __render (DataInputObject FieldsDefinition IN s
fields) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
      __render (DataInputUnion UnionTypeDefinition IN s
members) = Rendering
"input " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition IN s
fields
        where
          fields :: FieldsDefinition IN s
fields = UnionTypeDefinition IN s -> FieldsDefinition IN s
forall (t :: * -> *) (s :: Stage).
Foldable t =>
t (UnionMember IN s) -> FieldsDefinition IN s
mkInputUnionFields UnionTypeDefinition IN s
members
      __render DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields} = Rendering
"type " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldsDefinition OUT s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldsDefinition OUT s
objectFields