{-# 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 qualified Data.Text as 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 Name
this Maybe Name
_ [InterfaceType a]
_ HashMap Name (Resolver a)
_) == :: ObjectType a -> ObjectType a -> Bool
== (ObjectType Name
that Maybe Name
_ [InterfaceType a]
_ HashMap Name (Resolver a)
_) = Name
this forall a. Eq a => a -> a -> Bool
== Name
that
instance forall a. Show (ObjectType a) where
show :: ObjectType a -> String
show (ObjectType Name
typeName Maybe Name
_ [InterfaceType a]
_ HashMap Name (Resolver a)
_) = Name -> String
Text.unpack Name
typeName
data InterfaceType m = InterfaceType
Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
instance forall a. Eq (InterfaceType a) where
(InterfaceType Name
this Maybe Name
_ [InterfaceType a]
_ HashMap Name (Field a)
_) == :: InterfaceType a -> InterfaceType a -> Bool
== (InterfaceType Name
that Maybe Name
_ [InterfaceType a]
_ HashMap Name (Field a)
_) = Name
this forall a. Eq a => a -> a -> Bool
== Name
that
instance forall a. Show (InterfaceType a) where
show :: InterfaceType a -> String
show (InterfaceType Name
typeName Maybe Name
_ [InterfaceType a]
_ HashMap Name (Field a)
_) = Name -> String
Text.unpack Name
typeName
data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
instance forall a. Eq (UnionType a) where
(UnionType Name
this Maybe Name
_ [ObjectType a]
_) == :: UnionType a -> UnionType a -> Bool
== (UnionType Name
that Maybe Name
_ [ObjectType a]
_) = Name
this forall a. Eq a => a -> a -> Bool
== Name
that
instance forall a. Show (UnionType a) where
show :: UnionType a -> String
show (UnionType Name
typeName Maybe Name
_ [ObjectType a]
_) = Name -> String
Text.unpack Name
typeName
data Field m = Field
(Maybe Text)
(Type m)
In.Arguments
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 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
instance forall a. Show (Type a) where
show :: Type a -> String
show (NamedScalarType ScalarType
scalarType) = forall a. Show a => a -> String
show ScalarType
scalarType
show (NamedEnumType EnumType
enumType) = forall a. Show a => a -> String
show EnumType
enumType
show (NamedObjectType ObjectType a
inputObjectType) = forall a. Show a => a -> String
show ObjectType a
inputObjectType
show (NamedInterfaceType InterfaceType a
interfaceType) = forall a. Show a => a -> String
show InterfaceType a
interfaceType
show (NamedUnionType UnionType a
unionType) = forall a. Show a => a -> String
show UnionType a
unionType
show (ListType Type a
baseType) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"[", forall a. Show a => a -> String
show Type a
baseType, String
"]"]
show (NonNullScalarType ScalarType
scalarType) = Char
'!' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show ScalarType
scalarType
show (NonNullEnumType EnumType
enumType) = Char
'!' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show EnumType
enumType
show (NonNullObjectType ObjectType a
inputObjectType) = Char
'!' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show ObjectType a
inputObjectType
show (NonNullInterfaceType InterfaceType a
interfaceType) = Char
'!' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show InterfaceType a
interfaceType
show (NonNullUnionType UnionType a
unionType) = Char
'!' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show UnionType a
unionType
show (NonNullListType Type a
baseType) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"![", forall a. Show a => a -> String
show Type a
baseType, String
"]"]
pattern ScalarBaseType :: forall m. ScalarType -> Type m
pattern $mScalarBaseType :: forall {r} {m :: * -> *}.
Type m -> (ScalarType -> r) -> ((# #) -> r) -> r
ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
pattern EnumBaseType :: forall m. EnumType -> Type m
pattern enumType <- (isEnumType -> Just enumType)
pattern ObjectBaseType :: forall m. ObjectType m -> Type m
pattern $mObjectBaseType :: forall {r} {m :: * -> *}.
Type m -> (ObjectType m -> r) -> ((# #) -> r) -> r
ObjectBaseType objectType <- (isObjectType -> Just objectType)
pattern InterfaceBaseType :: forall m. InterfaceType m -> Type m
pattern $mInterfaceBaseType :: forall {r} {m :: * -> *}.
Type m -> (InterfaceType m -> r) -> ((# #) -> r) -> r
InterfaceBaseType interfaceType <-
(isInterfaceType -> Just interfaceType)
pattern UnionBaseType :: forall m. UnionType m -> Type m
pattern $mUnionBaseType :: forall {r} {m :: * -> *}.
Type m -> (UnionType m -> r) -> ((# #) -> r) -> r
UnionBaseType unionType <- (isUnionType -> Just unionType)
pattern ListBaseType :: forall m. Type m -> Type m
pattern $mListBaseType :: forall {r} {m :: * -> *}.
Type m -> (Type m -> r) -> ((# #) -> r) -> r
ListBaseType listType <- (isListType -> Just listType)
{-# COMPLETE ScalarBaseType
, EnumBaseType
, ObjectBaseType
, ListBaseType
, InterfaceBaseType
, UnionBaseType
#-}
isScalarType :: forall m. Type m -> Maybe ScalarType
isScalarType :: forall (m :: * -> *). Type m -> Maybe ScalarType
isScalarType (NamedScalarType ScalarType
outputType) = forall a. a -> Maybe a
Just ScalarType
outputType
isScalarType (NonNullScalarType ScalarType
outputType) = forall a. a -> Maybe a
Just ScalarType
outputType
isScalarType Type m
_ = forall a. Maybe a
Nothing
isObjectType :: forall m. Type m -> Maybe (ObjectType m)
isObjectType :: forall (m :: * -> *). Type m -> Maybe (ObjectType m)
isObjectType (NamedObjectType ObjectType m
outputType) = forall a. a -> Maybe a
Just ObjectType m
outputType
isObjectType (NonNullObjectType ObjectType m
outputType) = forall a. a -> Maybe a
Just ObjectType m
outputType
isObjectType Type m
_ = forall a. Maybe a
Nothing
isEnumType :: forall m. Type m -> Maybe EnumType
isEnumType :: forall (m :: * -> *). Type m -> Maybe EnumType
isEnumType (NamedEnumType EnumType
outputType) = forall a. a -> Maybe a
Just EnumType
outputType
isEnumType (NonNullEnumType EnumType
outputType) = forall a. a -> Maybe a
Just EnumType
outputType
isEnumType Type m
_ = forall a. Maybe a
Nothing
isInterfaceType :: forall m. Type m -> Maybe (InterfaceType m)
isInterfaceType :: forall (m :: * -> *). Type m -> Maybe (InterfaceType m)
isInterfaceType (NamedInterfaceType InterfaceType m
interfaceType) = forall a. a -> Maybe a
Just InterfaceType m
interfaceType
isInterfaceType (NonNullInterfaceType InterfaceType m
interfaceType) = forall a. a -> Maybe a
Just InterfaceType m
interfaceType
isInterfaceType Type m
_ = forall a. Maybe a
Nothing
isUnionType :: forall m. Type m -> Maybe (UnionType m)
isUnionType :: forall (m :: * -> *). Type m -> Maybe (UnionType m)
isUnionType (NamedUnionType UnionType m
unionType) = forall a. a -> Maybe a
Just UnionType m
unionType
isUnionType (NonNullUnionType UnionType m
unionType) = forall a. a -> Maybe a
Just UnionType m
unionType
isUnionType Type m
_ = forall a. Maybe a
Nothing
isListType :: forall m. Type m -> Maybe (Type m)
isListType :: forall (m :: * -> *). Type m -> Maybe (Type m)
isListType (ListType Type m
outputType) = forall a. a -> Maybe a
Just Type m
outputType
isListType (NonNullListType Type m
outputType) = forall a. a -> Maybe a
Just Type m
outputType
isListType Type m
_ = forall a. Maybe a
Nothing
isNonNullType :: forall m. Type m -> Bool
isNonNullType :: forall (m :: * -> *). Type m -> Bool
isNonNullType (NonNullScalarType ScalarType
_) = Bool
True
isNonNullType (NonNullEnumType EnumType
_) = Bool
True
isNonNullType (NonNullObjectType ObjectType m
_) = Bool
True
isNonNullType (NonNullInterfaceType InterfaceType m
_) = Bool
True
isNonNullType (NonNullUnionType UnionType m
_) = Bool
True
isNonNullType (NonNullListType Type m
_) = Bool
True
isNonNullType Type m
_ = Bool
False
data Context = Context
{ Context -> Arguments
arguments :: Arguments
, Context -> Value
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 :: forall (m :: * -> *). Monad m => Name -> Resolve m
argument Name
argumentName = do
Maybe Value
argumentValue <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ Arguments -> Maybe Value
lookupArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Arguments
arguments
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Value
Null Maybe Value
argumentValue
where
lookupArgument :: Arguments -> Maybe Value
lookupArgument (Arguments HashMap Name Value
argumentMap) =
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
argumentName HashMap Name Value
argumentMap