{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Language.GraphQL.Type.Out
( Context(..)
, Field(..)
, InterfaceType(..)
, ObjectType(..)
, Resolve
, Subscribe
, Resolver(..)
, SourceEventStream
, Type(..)
, UnionType(..)
, argument
, isNonNullType
, pattern EnumBaseType
, pattern InterfaceBaseType
, pattern ListBaseType
, pattern ObjectBaseType
, pattern ScalarBaseType
, pattern UnionBaseType
) where
import Conduit
import Control.Monad.Trans.Reader (ReaderT, asks)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Language.GraphQL.AST (Name)
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.In as In
data ObjectType m = ObjectType
Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
instance forall a. Eq (ObjectType a) where
(ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
data InterfaceType m = InterfaceType
Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
instance forall a. Eq (InterfaceType a) where
(InterfaceType this _ _ _) == (InterfaceType that _ _ _) = this == that
data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
instance forall a. Eq (UnionType a) where
(UnionType this _ _) == (UnionType that _ _) = this == that
data Field m = Field
(Maybe Text)
(Type m)
(HashMap Name In.Argument)
data Type m
= NamedScalarType ScalarType
| NamedEnumType EnumType
| NamedObjectType (ObjectType m)
| NamedInterfaceType (InterfaceType m)
| NamedUnionType (UnionType m)
| ListType (Type m)
| NonNullScalarType ScalarType
| NonNullEnumType EnumType
| NonNullObjectType (ObjectType m)
| NonNullInterfaceType (InterfaceType m)
| NonNullUnionType (UnionType m)
| NonNullListType (Type m)
deriving Eq
pattern ScalarBaseType :: forall m. ScalarType -> Type m
pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
pattern EnumBaseType :: forall m. EnumType -> Type m
pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
pattern ObjectBaseType :: forall m. ObjectType m -> Type m
pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
pattern InterfaceBaseType :: forall m. InterfaceType m -> Type m
pattern InterfaceBaseType interfaceType <-
(isInterfaceType -> Just interfaceType)
pattern UnionBaseType :: forall m. UnionType m -> Type m
pattern UnionBaseType unionType <- (isUnionType -> Just unionType)
pattern ListBaseType :: forall m. Type m -> Type m
pattern ListBaseType listType <- (isListType -> Just listType)
{-# COMPLETE ScalarBaseType
, EnumBaseType
, ObjectBaseType
, ListBaseType
, InterfaceBaseType
, UnionBaseType
#-}
isScalarType :: forall m. Type m -> Maybe ScalarType
isScalarType (NamedScalarType outputType) = Just outputType
isScalarType (NonNullScalarType outputType) = Just outputType
isScalarType _ = Nothing
isObjectType :: forall m. Type m -> Maybe (ObjectType m)
isObjectType (NamedObjectType outputType) = Just outputType
isObjectType (NonNullObjectType outputType) = Just outputType
isObjectType _ = Nothing
isEnumType :: forall m. Type m -> Maybe EnumType
isEnumType (NamedEnumType outputType) = Just outputType
isEnumType (NonNullEnumType outputType) = Just outputType
isEnumType _ = Nothing
isInterfaceType :: forall m. Type m -> Maybe (InterfaceType m)
isInterfaceType (NamedInterfaceType interfaceType) = Just interfaceType
isInterfaceType (NonNullInterfaceType interfaceType) = Just interfaceType
isInterfaceType _ = Nothing
isUnionType :: forall m. Type m -> Maybe (UnionType m)
isUnionType (NamedUnionType unionType) = Just unionType
isUnionType (NonNullUnionType unionType) = Just unionType
isUnionType _ = Nothing
isListType :: forall m. Type m -> Maybe (Type m)
isListType (ListType outputType) = Just outputType
isListType (NonNullListType outputType) = Just outputType
isListType _ = Nothing
isNonNullType :: forall m. Type m -> Bool
isNonNullType (NonNullScalarType _) = True
isNonNullType (NonNullEnumType _) = True
isNonNullType (NonNullObjectType _) = True
isNonNullType (NonNullInterfaceType _) = True
isNonNullType (NonNullUnionType _) = True
isNonNullType (NonNullListType _) = True
isNonNullType _ = False
data Context = Context
{ arguments :: Arguments
, values :: Value
}
type Resolve m = ReaderT Context m Value
type Subscribe m = ReaderT Context m (SourceEventStream m)
type SourceEventStream m = ConduitT () Value m ()
data Resolver m
= ValueResolver (Field m) (Resolve m)
| EventStreamResolver (Field m) (Resolve m) (Subscribe m)
argument :: Monad m => Name -> Resolve m
argument argumentName = do
argumentValue <- asks $ lookupArgument . arguments
pure $ fromMaybe Null argumentValue
where
lookupArgument (Arguments argumentMap) =
HashMap.lookup argumentName argumentMap