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

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

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

type DataEnum s = [DataEnumValue s]

-- 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 :: forall (a :: TypeCategory -> Stage -> *) (c :: TypeCategory)
       (s :: Stage) b.
(a c s -> b) -> a c s -> Typed c s b
typed a c s -> b
f = forall (cat :: TypeCategory) (s :: Stage) a. a -> Typed cat s a
Typed forall b c a. (b -> c) -> (a -> b) -> a -> c
. a c s -> b
f

untyped :: (a -> b) -> Typed c s a -> b
untyped :: forall a b (c :: TypeCategory) (s :: Stage).
(a -> b) -> Typed c s a -> b
untyped a -> b
f = a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (cat :: TypeCategory) (s :: Stage) a. Typed cat s a -> a
_untyped

-- | used for preserving type information from untyped values
-- see function typed
newtype Typed (cat :: TypeCategory) (s :: Stage) a = Typed
  { forall (cat :: TypeCategory) (s :: Stage) a. 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 :: forall (m :: * -> *). Quote m => ScalarDefinition -> m Exp
lift ScalarDefinition
_ = [|ScalarDefinition pure|]

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
ScalarDefinition -> Code m ScalarDefinition
liftTyped ScalarDefinition
_ = [||ScalarDefinition pure||]
#endif

-- ENUM VALUE
data DataEnumValue s = DataEnumValue
  { forall (s :: Stage). DataEnumValue s -> Maybe Token
enumDescription :: Maybe Description,
    forall (s :: Stage). DataEnumValue s -> TypeName
enumName :: TypeName,
    forall (s :: Stage). DataEnumValue s -> Directives s
enumDirectives :: Directives s
  }
  deriving (Int -> DataEnumValue s -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> DataEnumValue s -> ShowS
forall (s :: Stage). [DataEnumValue s] -> ShowS
forall (s :: Stage). DataEnumValue s -> String
showList :: [DataEnumValue s] -> ShowS
$cshowList :: forall (s :: Stage). [DataEnumValue s] -> ShowS
show :: DataEnumValue s -> String
$cshow :: forall (s :: Stage). DataEnumValue s -> String
showsPrec :: Int -> DataEnumValue s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> DataEnumValue s -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
forall (m :: * -> *). Quote m => DataEnumValue s -> m Exp
forall (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
liftTyped :: forall (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> Code m (DataEnumValue s)
lift :: forall (m :: * -> *). Quote m => DataEnumValue s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DataEnumValue s -> m Exp
Lift, DataEnumValue s -> DataEnumValue s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
/= :: DataEnumValue s -> DataEnumValue s -> Bool
$c/= :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
== :: DataEnumValue s -> DataEnumValue s -> Bool
$c== :: forall (s :: Stage). DataEnumValue s -> DataEnumValue s -> Bool
Eq)

instance RenderGQL (DataEnumValue s) where
  renderGQL :: DataEnumValue s -> Rendering
renderGQL DataEnumValue {Maybe Token
Directives s
TypeName
enumDirectives :: Directives s
enumName :: TypeName
enumDescription :: Maybe Token
enumDirectives :: forall (s :: Stage). DataEnumValue s -> Directives s
enumName :: forall (s :: Stage). DataEnumValue s -> TypeName
enumDescription :: forall (s :: Stage). DataEnumValue s -> Maybe Token
..} = forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
enumName forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
enumDirectives

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

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

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

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

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

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

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

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

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

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

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

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

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

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

type TypeDefinitions s = SafeHashMap TypeName (TypeDefinition ANY s)

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

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

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

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

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

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

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

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

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

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

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

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

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

-- 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
  { forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
typeDescription :: Maybe Description,
    forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName,
    forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDirectives :: Directives s,
    forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
  }
  deriving (Int -> TypeDefinition a s -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: TypeCategory) (s :: Stage).
Int -> TypeDefinition a s -> ShowS
forall (a :: TypeCategory) (s :: Stage).
[TypeDefinition a s] -> ShowS
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> String
showList :: [TypeDefinition a s] -> ShowS
$cshowList :: forall (a :: TypeCategory) (s :: Stage).
[TypeDefinition a s] -> ShowS
show :: TypeDefinition a s -> String
$cshow :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> String
showsPrec :: Int -> TypeDefinition a s -> ShowS
$cshowsPrec :: forall (a :: TypeCategory) (s :: Stage).
Int -> TypeDefinition a s -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> m Exp
forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
forall (m :: * -> *). Quote m => TypeDefinition a s -> m Exp
forall (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
liftTyped :: forall (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
$cliftTyped :: forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> Code m (TypeDefinition a s)
lift :: forall (m :: * -> *). Quote m => TypeDefinition a s -> m Exp
$clift :: forall (a :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
TypeDefinition a s -> m Exp
Lift, TypeDefinition a s -> TypeDefinition a s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
/= :: TypeDefinition a s -> TypeDefinition a s -> Bool
$c/= :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
== :: TypeDefinition a s -> TypeDefinition a s -> Bool
$c== :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeDefinition a s -> Bool
Eq)

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

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

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

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

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

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

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

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

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

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

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

deriving instance Show (TypeContent a b s)

deriving instance Eq (TypeContent a b s)

deriving instance Lift (TypeContent a b s)

indexOf :: TypeContent b a s -> Int
indexOf :: forall (b :: Bool) (a :: TypeCategory) (s :: Stage).
TypeContent b a s -> Int
indexOf DataScalar {} = Int
0
indexOf DataEnum {} = Int
1
indexOf DataInputObject {} = Int
2
indexOf DataInputUnion {} = Int
3
indexOf DataInterface {} = Int
4
indexOf DataObject {} = Int
5
indexOf DataUnion {} = Int
6

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

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

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

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

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

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

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

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

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

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

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

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

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

isLeaf :: TypeContent TRUE a s -> Bool
isLeaf :: forall (k :: TypeCategory) (s :: Stage).
TypeContent TRUE k s -> Bool
isLeaf DataScalar {} = Bool
True
isLeaf DataEnum {} = Bool
True
isLeaf TypeContent TRUE a s
_ = Bool
False

kindOf :: TypeDefinition a s -> TypeKind
kindOf :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent} = TypeContent TRUE a s -> TypeKind
__kind TypeContent TRUE a s
typeContent
  where
    __kind :: TypeContent TRUE a s -> TypeKind
__kind DataScalar {} = TypeKind
KIND_SCALAR
    __kind DataEnum {} = TypeKind
KIND_ENUM
    __kind DataInputObject {} = TypeKind
KIND_INPUT_OBJECT
    __kind DataObject {} = Maybe OperationType -> TypeKind
KIND_OBJECT (TypeName -> Maybe OperationType
toOperationType TypeName
typeName)
    __kind DataUnion {} = TypeKind
KIND_UNION
    __kind DataInputUnion {} = TypeKind
KIND_INPUT_UNION
    __kind DataInterface {} = TypeKind
KIND_INTERFACE

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

defineDirective ::
  ( Monad m,
    MonadError GQLError m
  ) =>
  Schema s ->
  DirectiveDefinition s ->
  m (Schema s)
defineDirective :: forall (m :: * -> *) (s :: Stage).
(Monad m, MonadError GQLError m) =>
Schema s -> DirectiveDefinition s -> m (Schema s)
defineDirective Schema s
schema DirectiveDefinition s
directive = DirectivesDefinition s -> Schema s
updateTypes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a k (m :: * -> *).
(NameCollision e a, KeyOf k a, MonadError e m) =>
a -> SafeHashMap k a -> m (SafeHashMap k a)
insert DirectiveDefinition s
directive (forall (s :: Stage). Schema s -> DirectivesDefinition s
directiveDefinitions Schema s
schema)
  where
    updateTypes :: DirectivesDefinition s -> Schema s
updateTypes DirectivesDefinition s
directiveDefinitions = Schema s
schema {DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
directiveDefinitions :: DirectivesDefinition s
directiveDefinitions}

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

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

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

hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName :: RootOperationTypeDefinition -> Bool
hasDefaultOperationName
  RootOperationTypeDefinition
    { OperationType
rootOperationType :: OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType,
      rootOperationTypeDefinitionName :: RootOperationTypeDefinition -> TypeName
rootOperationTypeDefinitionName = TypeName
name
    } = OperationType -> TypeName -> Bool
isOperationType OperationType
rootOperationType TypeName
name

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

instance RenderGQL (TypeDefinition a s) where
  renderGQL :: TypeDefinition a s -> Rendering
renderGQL TypeDefinition {Maybe Token
Directives s
TypeName
TypeContent TRUE a s
typeContent :: TypeContent TRUE a s
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Token
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Token
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
..} = TypeContent TRUE a s -> Rendering
__render TypeContent TRUE a s
typeContent forall a. Semigroup a => a -> a -> a
<> Rendering
newline
    where
      name :: Rendering
name = forall a. RenderGQL a => a -> Rendering
renderGQL TypeName
typeName forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
typeDirectives

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