{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
module Language.GraphQL.Type.Internal
( AbstractType(..)
, CompositeType(..)
, Directive(..)
, Directives
, Schema(..)
, Type(..)
, description
, directives
, doesFragmentTypeApply
, implementations
, instanceOf
, lookupCompositeField
, lookupInputType
, lookupTypeCondition
, lookupTypeField
, mutation
, outToComposite
, subscription
, query
, types
) where
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
data Type m
= ScalarType Definition.ScalarType
| EnumType Definition.EnumType
| ObjectType (Out.ObjectType m)
| InputObjectType In.InputObjectType
| InterfaceType (Out.InterfaceType m)
| UnionType (Out.UnionType m)
deriving Type m -> Type m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). Type m -> Type m -> Bool
/= :: Type m -> Type m -> Bool
$c/= :: forall (m :: * -> *). Type m -> Type m -> Bool
== :: Type m -> Type m -> Bool
$c== :: forall (m :: * -> *). Type m -> Type m -> Bool
Eq
data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments
type Directives = HashMap Full.Name Directive
data Schema m = Schema
(Maybe Text)
(Out.ObjectType m)
(Maybe (Out.ObjectType m))
(Maybe (Out.ObjectType m))
Directives
(HashMap Full.Name (Type m))
(HashMap Full.Name [Type m])
description :: forall m. Schema m -> Maybe Text
description :: forall (m :: * -> *). Schema m -> Maybe Text
description (Schema Maybe Text
description' ObjectType m
_ Maybe (ObjectType m)
_ Maybe (ObjectType m)
_ Directives
_ HashMap Text (Type m)
_ HashMap Text [Type m]
_) = Maybe Text
description'
query :: forall m. Schema m -> Out.ObjectType m
query :: forall (m :: * -> *). Schema m -> ObjectType m
query (Schema Maybe Text
_ ObjectType m
query' Maybe (ObjectType m)
_ Maybe (ObjectType m)
_ Directives
_ HashMap Text (Type m)
_ HashMap Text [Type m]
_) = ObjectType m
query'
mutation :: forall m. Schema m -> Maybe (Out.ObjectType m)
mutation :: forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
mutation (Schema Maybe Text
_ ObjectType m
_ Maybe (ObjectType m)
mutation' Maybe (ObjectType m)
_ Directives
_ HashMap Text (Type m)
_ HashMap Text [Type m]
_) = Maybe (ObjectType m)
mutation'
subscription :: forall m. Schema m -> Maybe (Out.ObjectType m)
subscription :: forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
subscription (Schema Maybe Text
_ ObjectType m
_ Maybe (ObjectType m)
_ Maybe (ObjectType m)
subscription' Directives
_ HashMap Text (Type m)
_ HashMap Text [Type m]
_) = Maybe (ObjectType m)
subscription'
directives :: forall m. Schema m -> Directives
directives :: forall (m :: * -> *). Schema m -> Directives
directives (Schema Maybe Text
_ ObjectType m
_ Maybe (ObjectType m)
_ Maybe (ObjectType m)
_ Directives
directives' HashMap Text (Type m)
_ HashMap Text [Type m]
_) = Directives
directives'
types :: forall m. Schema m -> HashMap Full.Name (Type m)
types :: forall (m :: * -> *). Schema m -> HashMap Text (Type m)
types (Schema Maybe Text
_ ObjectType m
_ Maybe (ObjectType m)
_ Maybe (ObjectType m)
_ Directives
_ HashMap Text (Type m)
types' HashMap Text [Type m]
_) = HashMap Text (Type m)
types'
implementations :: forall m. Schema m -> HashMap Full.Name [Type m]
implementations :: forall (m :: * -> *). Schema m -> HashMap Text [Type m]
implementations (Schema Maybe Text
_ ObjectType m
_ Maybe (ObjectType m)
_ Maybe (ObjectType m)
_ Directives
_ HashMap Text (Type m)
_ HashMap Text [Type m]
implementations') = HashMap Text [Type m]
implementations'
data CompositeType m
= CompositeUnionType (Out.UnionType m)
| CompositeObjectType (Out.ObjectType m)
| CompositeInterfaceType (Out.InterfaceType m)
deriving CompositeType m -> CompositeType m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). CompositeType m -> CompositeType m -> Bool
/= :: CompositeType m -> CompositeType m -> Bool
$c/= :: forall (m :: * -> *). CompositeType m -> CompositeType m -> Bool
== :: CompositeType m -> CompositeType m -> Bool
$c== :: forall (m :: * -> *). CompositeType m -> CompositeType m -> Bool
Eq
data AbstractType m
= AbstractUnionType (Out.UnionType m)
| AbstractInterfaceType (Out.InterfaceType m)
deriving AbstractType m -> AbstractType m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). AbstractType m -> AbstractType m -> Bool
/= :: AbstractType m -> AbstractType m -> Bool
$c/= :: forall (m :: * -> *). AbstractType m -> AbstractType m -> Bool
== :: AbstractType m -> AbstractType m -> Bool
$c== :: forall (m :: * -> *). AbstractType m -> AbstractType m -> Bool
Eq
doesFragmentTypeApply :: forall m
. CompositeType m
-> Out.ObjectType m
-> Bool
doesFragmentTypeApply :: forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
doesFragmentTypeApply (CompositeObjectType ObjectType m
fragmentType) ObjectType m
objectType =
ObjectType m
fragmentType forall a. Eq a => a -> a -> Bool
== ObjectType m
objectType
doesFragmentTypeApply (CompositeInterfaceType InterfaceType m
fragmentType) ObjectType m
objectType =
forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
instanceOf ObjectType m
objectType forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). InterfaceType m -> AbstractType m
AbstractInterfaceType InterfaceType m
fragmentType
doesFragmentTypeApply (CompositeUnionType UnionType m
fragmentType) ObjectType m
objectType =
forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
instanceOf ObjectType m
objectType forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). UnionType m -> AbstractType m
AbstractUnionType UnionType m
fragmentType
instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool
instanceOf :: forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
instanceOf ObjectType m
objectType (AbstractInterfaceType InterfaceType m
interfaceType) =
let Out.ObjectType Text
_ Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Resolver m)
_ = ObjectType m
objectType
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InterfaceType m -> Bool -> Bool
go Bool
False [InterfaceType m]
interfaces
where
go :: InterfaceType m -> Bool -> Bool
go objectInterfaceType :: InterfaceType m
objectInterfaceType@(Out.InterfaceType Text
_ Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Field m)
_) Bool
acc =
Bool
acc Bool -> Bool -> Bool
|| forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InterfaceType m -> Bool -> Bool
go (InterfaceType m
interfaceType forall a. Eq a => a -> a -> Bool
== InterfaceType m
objectInterfaceType) [InterfaceType m]
interfaces
instanceOf ObjectType m
objectType (AbstractUnionType UnionType m
unionType) =
let Out.UnionType Text
_ Maybe Text
_ [ObjectType m]
members = UnionType m
unionType
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ObjectType m -> Bool -> Bool
go Bool
False [ObjectType m]
members
where
go :: ObjectType m -> Bool -> Bool
go ObjectType m
unionMemberType Bool
acc = Bool
acc Bool -> Bool -> Bool
|| ObjectType m
objectType forall a. Eq a => a -> a -> Bool
== ObjectType m
unionMemberType
lookupTypeCondition :: forall m
. Full.Name
-> HashMap Full.Name (Type m)
-> Maybe (CompositeType m)
lookupTypeCondition :: forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
lookupTypeCondition Text
type' HashMap Text (Type m)
types' =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
type' HashMap Text (Type m)
types' of
Just (ObjectType ObjectType m
objectType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ObjectType m -> CompositeType m
CompositeObjectType ObjectType m
objectType
Just (UnionType UnionType m
unionType) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). UnionType m -> CompositeType m
CompositeUnionType UnionType m
unionType
Just (InterfaceType InterfaceType m
interfaceType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). InterfaceType m -> CompositeType m
CompositeInterfaceType InterfaceType m
interfaceType
Maybe (Type m)
_ -> forall a. Maybe a
Nothing
lookupInputType :: Full.Type -> HashMap Full.Name (Type m) -> Maybe In.Type
lookupInputType :: forall (m :: * -> *). Type -> HashMap Text (Type m) -> Maybe Type
lookupInputType (Full.TypeNamed Text
name) HashMap Text (Type m)
types' =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text (Type m)
types' of
Just (ScalarType ScalarType
scalarType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScalarType -> Type
In.NamedScalarType ScalarType
scalarType
Just (EnumType EnumType
enumType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EnumType -> Type
In.NamedEnumType EnumType
enumType
Just (InputObjectType InputObjectType
objectType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ InputObjectType -> Type
In.NamedInputObjectType InputObjectType
objectType
Maybe (Type m)
_ -> forall a. Maybe a
Nothing
lookupInputType (Full.TypeList Type
list) HashMap Text (Type m)
types'
= Type -> Type
In.ListType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Type -> HashMap Text (Type m) -> Maybe Type
lookupInputType Type
list HashMap Text (Type m)
types'
lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed Text
nonNull)) HashMap Text (Type m)
types' =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
nonNull HashMap Text (Type m)
types' of
Just (ScalarType ScalarType
scalarType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScalarType -> Type
In.NonNullScalarType ScalarType
scalarType
Just (EnumType EnumType
enumType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EnumType -> Type
In.NonNullEnumType EnumType
enumType
Just (InputObjectType InputObjectType
objectType) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ InputObjectType -> Type
In.NonNullInputObjectType InputObjectType
objectType
Maybe (Type m)
_ -> forall a. Maybe a
Nothing
lookupInputType (Full.TypeNonNull (Full.NonNullTypeList Type
nonNull)) HashMap Text (Type m)
types'
= Type -> Type
In.NonNullListType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Type -> HashMap Text (Type m) -> Maybe Type
lookupInputType Type
nonNull HashMap Text (Type m)
types'
lookupTypeField :: forall a. Full.Name -> Out.Type a -> Maybe (Out.Field a)
lookupTypeField :: forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
lookupTypeField Text
fieldName Type a
outputType =
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
outToComposite Type a
outputType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: * -> *). Text -> CompositeType a -> Maybe (Field a)
lookupCompositeField Text
fieldName
lookupCompositeField :: forall a
. Full.Name
-> CompositeType a
-> Maybe (Out.Field a)
lookupCompositeField :: forall (a :: * -> *). Text -> CompositeType a -> Maybe (Field a)
lookupCompositeField Text
fieldName = \case
CompositeObjectType ObjectType a
objectType -> forall {m :: * -> *}. ObjectType m -> Maybe (Field m)
objectChild ObjectType a
objectType
CompositeInterfaceType InterfaceType a
interfaceType -> forall {m :: * -> *}. InterfaceType m -> Maybe (Field m)
interfaceChild InterfaceType a
interfaceType
CompositeType a
_ -> forall a. Maybe a
Nothing
where
objectChild :: ObjectType m -> Maybe (Field m)
objectChild (Out.ObjectType Text
_ Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
resolvers) =
forall {m :: * -> *}. Resolver m -> Field m
resolverType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
fieldName HashMap Text (Resolver m)
resolvers
interfaceChild :: InterfaceType m -> Maybe (Field m)
interfaceChild (Out.InterfaceType Text
_ Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
fields) =
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
fieldName HashMap Text (Field m)
fields
resolverType :: Resolver m -> Field m
resolverType (Out.ValueResolver Field m
objectField Resolve m
_) = Field m
objectField
resolverType (Out.EventStreamResolver Field m
objectField Resolve m
_ Subscribe m
_) = Field m
objectField
outToComposite :: forall a. Out.Type a -> Maybe (CompositeType a)
outToComposite :: forall (a :: * -> *). Type a -> Maybe (CompositeType a)
outToComposite = \case
Out.ObjectBaseType ObjectType a
objectType -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ObjectType m -> CompositeType m
CompositeObjectType ObjectType a
objectType
Out.InterfaceBaseType InterfaceType a
interfaceType ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). InterfaceType m -> CompositeType m
CompositeInterfaceType InterfaceType a
interfaceType
Out.UnionBaseType UnionType a
unionType -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). UnionType m -> CompositeType m
CompositeUnionType UnionType a
unionType
Out.ListBaseType Type a
listType -> forall (a :: * -> *). Type a -> Maybe (CompositeType a)
outToComposite Type a
listType
Type a
_ -> forall a. Maybe a
Nothing