Check point
This commit is contained in:
@ -9,15 +9,13 @@ module Language.GraphQL.AST.Core
|
||||
, Operation(..)
|
||||
, Selection(..)
|
||||
, TypeCondition
|
||||
, Value(..)
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Sequence (Seq)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST (Alias, Name, TypeCondition)
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
|
||||
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
|
||||
--
|
||||
@ -33,7 +31,7 @@ data Field
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Argument list.
|
||||
newtype Arguments = Arguments (HashMap Name Value)
|
||||
newtype Arguments = Arguments (HashMap Name In.Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Semigroup Arguments where
|
||||
@ -56,18 +54,3 @@ data Selection
|
||||
= SelectionFragment Fragment
|
||||
| SelectionField Field
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= Int Int32
|
||||
| Float Double -- ^ GraphQL Float is double precision
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
|
||||
@ -15,7 +15,8 @@ import qualified Data.Text.Lazy as Text.Lazy
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Language.GraphQL.Schema
|
||||
import Language.GraphQL.Type.Definition
|
||||
|
||||
@ -46,26 +47,26 @@ class VariableValue a where
|
||||
coerceVariableValue
|
||||
:: InputType -- ^ Expected type (variable type given in the query).
|
||||
-> a -- ^ Variable value being coerced.
|
||||
-> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
-> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
|
||||
|
||||
instance VariableValue Aeson.Value where
|
||||
coerceVariableValue _ Aeson.Null = Just Null
|
||||
coerceVariableValue _ Aeson.Null = Just In.Null
|
||||
coerceVariableValue (ScalarInputTypeDefinition scalarType) value
|
||||
| (Aeson.String stringValue) <- value = Just $ String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
|
||||
| (Aeson.String stringValue) <- value = Just $ In.String stringValue
|
||||
| (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
|
||||
| (Aeson.Number numberValue) <- value
|
||||
, (ScalarType "Float" _) <- scalarType =
|
||||
Just $ Float $ toRealFloat numberValue
|
||||
Just $ In.Float $ toRealFloat numberValue
|
||||
| (Aeson.Number numberValue) <- value = -- ID or Int
|
||||
Int <$> toBoundedInteger numberValue
|
||||
In.Int <$> toBoundedInteger numberValue
|
||||
coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) =
|
||||
Just $ Enum stringValue
|
||||
Just $ In.Enum stringValue
|
||||
coerceVariableValue (ObjectInputTypeDefinition objectType) value
|
||||
| (Aeson.Object objectValue) <- value = do
|
||||
let (InputObjectType _ _ inputFields) = objectType
|
||||
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
|
||||
if HashMap.null newObjectValue
|
||||
then Just $ Object resultMap
|
||||
then Just $ In.Object resultMap
|
||||
else Nothing
|
||||
where
|
||||
foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues
|
||||
@ -81,7 +82,7 @@ instance VariableValue Aeson.Value where
|
||||
pure (newObjectValue, insert coerced)
|
||||
Nothing -> Just (objectValue, resultMap)
|
||||
coerceVariableValue (ListInputTypeDefinition listType) value
|
||||
| (Aeson.Array arrayValue) <- value = List
|
||||
| (Aeson.Array arrayValue) <- value = In.List
|
||||
<$> foldr foldVector (Just []) arrayValue
|
||||
| otherwise = coerceVariableValue listType value
|
||||
where
|
||||
@ -95,7 +96,7 @@ instance VariableValue Aeson.Value where
|
||||
-- corresponding types.
|
||||
coerceInputLiterals
|
||||
:: HashMap Name InputType
|
||||
-> HashMap Name Value
|
||||
-> HashMap Name In.Value
|
||||
-> Maybe Subs
|
||||
coerceInputLiterals variableTypes variableValues =
|
||||
foldWithKey operator variableTypes
|
||||
@ -105,34 +106,34 @@ coerceInputLiterals variableTypes variableValues =
|
||||
<$> (lookupVariable variableName >>= coerceInputLiteral variableType)
|
||||
<*> resultMap
|
||||
coerceInputLiteral (ScalarInputType type') value
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ String stringValue
|
||||
| (Boolean booleanValue) <- value
|
||||
, (ScalarType "Boolean" _) <- type' = Just $ Boolean booleanValue
|
||||
| (Int intValue) <- value
|
||||
, (ScalarType "Int" _) <- type' = Just $ Int intValue
|
||||
| (Float floatValue) <- value
|
||||
, (ScalarType "Float" _) <- type' = Just $ Float floatValue
|
||||
| (Int intValue) <- value
|
||||
| (In.String stringValue) <- value
|
||||
, (ScalarType "String" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Boolean booleanValue) <- value
|
||||
, (ScalarType "Boolean" _) <- type' = Just $ In.Boolean booleanValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "Int" _) <- type' = Just $ In.Int intValue
|
||||
| (In.Float floatValue) <- value
|
||||
, (ScalarType "Float" _) <- type' = Just $ In.Float floatValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "Float" _) <- type' =
|
||||
Just $ Float $ fromIntegral intValue
|
||||
| (String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ String stringValue
|
||||
| (Int intValue) <- value
|
||||
Just $ In.Float $ fromIntegral intValue
|
||||
| (In.String stringValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ In.String stringValue
|
||||
| (In.Int intValue) <- value
|
||||
, (ScalarType "ID" _) <- type' = Just $ decimal intValue
|
||||
coerceInputLiteral (EnumInputType type') (Enum enumValue)
|
||||
| member enumValue type' = Just $ Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (Object _) =
|
||||
coerceInputLiteral (EnumInputType type') (In.Enum enumValue)
|
||||
| member enumValue type' = Just $ In.Enum enumValue
|
||||
coerceInputLiteral (ObjectInputType type') (In.Object _) =
|
||||
let (InputObjectType _ _ inputFields) = type'
|
||||
in Object <$> foldWithKey matchFieldValues inputFields
|
||||
in In.Object <$> foldWithKey matchFieldValues inputFields
|
||||
coerceInputLiteral _ _ = Nothing
|
||||
member value (EnumType _ _ members) = Set.member value members
|
||||
matchFieldValues fieldName (InputField _ type' defaultValue) resultMap =
|
||||
case lookupVariable fieldName of
|
||||
Just Null
|
||||
Just In.Null
|
||||
| isNonNullInputType type' -> Nothing
|
||||
| otherwise ->
|
||||
HashMap.insert fieldName Null <$> resultMap
|
||||
HashMap.insert fieldName In.Null <$> resultMap
|
||||
Just variableValue -> HashMap.insert fieldName
|
||||
<$> coerceInputLiteral type' variableValue
|
||||
<*> resultMap
|
||||
@ -144,7 +145,7 @@ coerceInputLiterals variableTypes variableValues =
|
||||
| otherwise -> resultMap
|
||||
lookupVariable = flip HashMap.lookup variableValues
|
||||
foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
|
||||
decimal = String
|
||||
decimal = In.String
|
||||
. Text.Lazy.toStrict
|
||||
. Text.Builder.toLazyText
|
||||
. Text.Builder.decimal
|
||||
|
||||
@ -32,6 +32,7 @@ import Language.GraphQL.Execute.Coerce
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Language.GraphQL.Type.Schema
|
||||
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
@ -136,23 +137,23 @@ coerceVariableValues schema operationDefinition variableValues' =
|
||||
<*> coercedValues
|
||||
choose Nothing defaultValue variableType
|
||||
| Just _ <- defaultValue = defaultValue
|
||||
| not (isNonNullInputType variableType) = Just Core.Null
|
||||
| not (isNonNullInputType variableType) = Just In.Null
|
||||
choose (Just value') _ variableType
|
||||
| Just coercedValue <- coerceVariableValue variableType value'
|
||||
, not (isNonNullInputType variableType) || coercedValue /= Core.Null =
|
||||
, not (isNonNullInputType variableType) || coercedValue /= In.Null =
|
||||
Just coercedValue
|
||||
choose _ _ _ = Nothing
|
||||
|
||||
constValue :: Full.ConstValue -> Core.Value
|
||||
constValue (Full.ConstInt i) = Core.Int i
|
||||
constValue (Full.ConstFloat f) = Core.Float f
|
||||
constValue (Full.ConstString x) = Core.String x
|
||||
constValue (Full.ConstBoolean b) = Core.Boolean b
|
||||
constValue Full.ConstNull = Core.Null
|
||||
constValue (Full.ConstEnum e) = Core.Enum e
|
||||
constValue (Full.ConstList l) = Core.List $ constValue <$> l
|
||||
constValue :: Full.ConstValue -> In.Value
|
||||
constValue (Full.ConstInt i) = In.Int i
|
||||
constValue (Full.ConstFloat f) = In.Float f
|
||||
constValue (Full.ConstString x) = In.String x
|
||||
constValue (Full.ConstBoolean b) = In.Boolean b
|
||||
constValue Full.ConstNull = In.Null
|
||||
constValue (Full.ConstEnum e) = In.Enum e
|
||||
constValue (Full.ConstList l) = In.List $ constValue <$> l
|
||||
constValue (Full.ConstObject o) =
|
||||
Core.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
In.Object $ HashMap.fromList $ constObjectField <$> o
|
||||
where
|
||||
constObjectField (Full.ObjectField key value') = (key, constValue value')
|
||||
|
||||
@ -294,19 +295,19 @@ arguments = fmap Core.Arguments . foldM go HashMap.empty
|
||||
substitutedValue <- value value'
|
||||
return $ HashMap.insert name substitutedValue arguments'
|
||||
|
||||
value :: Full.Value -> TransformT Core.Value
|
||||
value :: Full.Value -> TransformT In.Value
|
||||
value (Full.Variable name) =
|
||||
gets $ fromMaybe Core.Null . HashMap.lookup name . variableValues
|
||||
value (Full.Int i) = pure $ Core.Int i
|
||||
value (Full.Float f) = pure $ Core.Float f
|
||||
value (Full.String x) = pure $ Core.String x
|
||||
value (Full.Boolean b) = pure $ Core.Boolean b
|
||||
value Full.Null = pure Core.Null
|
||||
value (Full.Enum e) = pure $ Core.Enum e
|
||||
gets $ fromMaybe In.Null . HashMap.lookup name . variableValues
|
||||
value (Full.Int i) = pure $ In.Int i
|
||||
value (Full.Float f) = pure $ In.Float f
|
||||
value (Full.String x) = pure $ In.String x
|
||||
value (Full.Boolean b) = pure $ In.Boolean b
|
||||
value Full.Null = pure In.Null
|
||||
value (Full.Enum e) = pure $ In.Enum e
|
||||
value (Full.List l) =
|
||||
Core.List <$> traverse value l
|
||||
In.List <$> traverse value l
|
||||
value (Full.Object o) =
|
||||
Core.Object . HashMap.fromList <$> traverse objectField o
|
||||
In.Object . HashMap.fromList <$> traverse objectField o
|
||||
|
||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, Core.Value)
|
||||
objectField :: Full.ObjectField Full.Value -> TransformT (Core.Name, In.Value)
|
||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module provides a representation of a @GraphQL@ Schema in addition to
|
||||
@ -8,10 +9,6 @@ module Language.GraphQL.Schema
|
||||
, object
|
||||
, resolve
|
||||
, resolversToMap
|
||||
, wrappedObject
|
||||
-- * AST Reexports
|
||||
, Field
|
||||
, Value(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
@ -28,38 +25,35 @@ import qualified Data.Text as T
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Trans
|
||||
import qualified Language.GraphQL.Type.Definition as Definition
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
|
||||
-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
|
||||
-- information (if an error has occurred). @m@ is an arbitrary monad, usually
|
||||
-- 'IO'.
|
||||
data Resolver m = Resolver Name (Definition.FieldResolver m)
|
||||
-- information (if an error has occurred). @m@ is an arbitrary monad, usually
|
||||
-- 'IO'.
|
||||
--
|
||||
-- Resolving a field can result in a leaf value or an object, which is
|
||||
-- represented as a list of nested resolvers, used to resolve the fields of that
|
||||
-- object.
|
||||
data Resolver m = Resolver Name (ActionT m (Out.Value m))
|
||||
|
||||
-- | Converts resolvers to a map.
|
||||
resolversToMap :: (Foldable f, Functor f)
|
||||
=> f (Resolver m)
|
||||
-> HashMap Text (Definition.FieldResolver m)
|
||||
=> forall m
|
||||
. f (Resolver m)
|
||||
-> HashMap Text (ActionT m (Out.Value m))
|
||||
resolversToMap = HashMap.fromList . toList . fmap toKV
|
||||
where
|
||||
toKV (Resolver name r) = (name, r)
|
||||
|
||||
-- | Contains variables for the query. The key of the map is a variable name,
|
||||
-- and the value is the variable value.
|
||||
type Subs = HashMap Name Value
|
||||
type Subs = HashMap Name In.Value
|
||||
|
||||
-- | Like 'object' but can be null or a list of objects.
|
||||
wrappedObject :: Monad m
|
||||
=> Name
|
||||
-> ActionT m (Type.Wrapping (Definition.FieldResolver m))
|
||||
-> Resolver m
|
||||
wrappedObject name = Resolver name . Definition.NestingResolver
|
||||
|
||||
-- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
|
||||
object :: Monad m
|
||||
=> [Resolver m]
|
||||
-> Type.Wrapping (Definition.FieldResolver m)
|
||||
object = Type.O . resolversToMap
|
||||
-- | Create a new 'Resolver' with the given 'Name' from the given
|
||||
-- Resolver's.
|
||||
object :: Monad m => [Resolver m] -> Out.Value m
|
||||
object = Out.Object . resolversToMap
|
||||
|
||||
resolveFieldValue :: Monad m => Field -> ActionT m a -> m (Either Text a)
|
||||
resolveFieldValue field@(Field _ _ args _) =
|
||||
@ -69,26 +63,25 @@ resolveFieldValue field@(Field _ _ args _) =
|
||||
|
||||
withField :: Monad m
|
||||
=> Field
|
||||
-> Definition.FieldResolver m
|
||||
-> ActionT m (Out.Value m)
|
||||
-> CollectErrsT m Aeson.Object
|
||||
withField field (Definition.ValueResolver resolver) = do
|
||||
answer <- lift $ resolveFieldValue field resolver
|
||||
either (errmsg field) (pure . HashMap.singleton (aliasOrName field)) answer
|
||||
withField field (Definition.NestingResolver resolver) = do
|
||||
withField field resolver = do
|
||||
answer <- lift $ resolveFieldValue field resolver
|
||||
case answer of
|
||||
Right result -> HashMap.singleton (aliasOrName field) <$> toJSON field result
|
||||
Right result -> HashMap.singleton (aliasOrName field)
|
||||
<$> toJSON field result
|
||||
Left errorMessage -> errmsg field errorMessage
|
||||
|
||||
toJSON :: Monad m => Field -> Type.Wrapping (Definition.FieldResolver m) -> CollectErrsT m Aeson.Value
|
||||
toJSON _ Type.Null = pure Aeson.Null
|
||||
toJSON _ (Type.I i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.B i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.F i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.E i) = pure $ Aeson.toJSON i
|
||||
toJSON _ (Type.S i) = pure $ Aeson.toJSON i
|
||||
toJSON field (Type.List list) = Aeson.toJSON <$> traverse (toJSON field) list
|
||||
toJSON (Field _ _ _ seqSelection) (Type.O map') = map' `resolve` seqSelection
|
||||
toJSON :: Monad m => Field -> Out.Value m -> CollectErrsT m Aeson.Value
|
||||
toJSON _ Out.Null = pure Aeson.Null
|
||||
toJSON _ (Out.Int integer) = pure $ Aeson.toJSON integer
|
||||
toJSON _ (Out.Boolean boolean) = pure $ Aeson.Bool boolean
|
||||
toJSON _ (Out.Float float) = pure $ Aeson.toJSON float
|
||||
toJSON _ (Out.Enum enum) = pure $ Aeson.String enum
|
||||
toJSON _ (Out.String string) = pure $ Aeson.String string
|
||||
toJSON field (Out.List list) = Aeson.toJSON <$> traverse (toJSON field) list
|
||||
toJSON (Field _ _ _ seqSelection) (Out.Object map') =
|
||||
map' `resolve` seqSelection
|
||||
|
||||
errmsg :: Monad m => Field -> Text -> CollectErrsT m (HashMap Text Aeson.Value)
|
||||
errmsg field errorMessage = do
|
||||
@ -96,10 +89,10 @@ errmsg field errorMessage = do
|
||||
pure $ HashMap.singleton (aliasOrName field) Aeson.Null
|
||||
|
||||
-- | Takes a list of 'Resolver's and a list of 'Field's and applies each
|
||||
-- 'Resolver' to each 'Field'. Resolves into a value containing the
|
||||
-- resolved 'Field', or a null value and error information.
|
||||
-- 'Resolver' to each 'Field'. Resolves into a value containing the
|
||||
-- resolved 'Field', or a null value and error information.
|
||||
resolve :: Monad m
|
||||
=> HashMap Text (Definition.FieldResolver m)
|
||||
=> HashMap Text (ActionT m (Out.Value m))
|
||||
-> Seq Selection
|
||||
-> CollectErrsT m Aeson.Value
|
||||
resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
||||
@ -109,17 +102,11 @@ resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
||||
| (Just resolver) <- lookupResolver name = withField fld resolver
|
||||
| otherwise = errmsg fld $ T.unwords ["field", name, "not resolved."]
|
||||
tryResolvers (SelectionFragment (Fragment typeCondition selections'))
|
||||
| Just (Definition.ValueResolver resolver) <- lookupResolver "__typename" = do
|
||||
let fakeField = Field Nothing "__typename" mempty mempty
|
||||
that <- lift $ resolveFieldValue fakeField resolver
|
||||
if Right (Aeson.String typeCondition) == that
|
||||
then fmap fold . traverse tryResolvers $ selections'
|
||||
else pure mempty
|
||||
| Just (Definition.NestingResolver resolver) <- lookupResolver "__typename" = do
|
||||
| Just resolver <- lookupResolver "__typename" = do
|
||||
let fakeField = Field Nothing "__typename" mempty mempty
|
||||
that <- lift $ resolveFieldValue fakeField resolver
|
||||
case that of
|
||||
Right (Type.S typeCondition')
|
||||
Right (Out.String typeCondition')
|
||||
| typeCondition' == typeCondition ->
|
||||
fmap fold . traverse tryResolvers $ selections'
|
||||
_ -> pure mempty
|
||||
|
||||
@ -15,6 +15,7 @@ import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
-- | Resolution context holds resolver arguments.
|
||||
@ -55,11 +56,11 @@ instance Monad m => MonadPlus (ActionT m) where
|
||||
mplus = (<|>)
|
||||
|
||||
-- | Retrieves an argument by its name. If the argument with this name couldn't
|
||||
-- be found, returns 'Value.Null' (i.e. the argument is assumed to
|
||||
-- be found, returns 'In.Null' (i.e. the argument is assumed to
|
||||
-- be optional then).
|
||||
argument :: Monad m => Name -> ActionT m Value
|
||||
argument :: Monad m => Name -> ActionT m In.Value
|
||||
argument argumentName = do
|
||||
argumentValue <- ActionT $ lift $ asks $ lookup . arguments
|
||||
pure $ fromMaybe Null argumentValue
|
||||
pure $ fromMaybe In.Null argumentValue
|
||||
where
|
||||
lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
|
||||
|
||||
@ -1,63 +0,0 @@
|
||||
-- | Definitions for @GraphQL@ input types.
|
||||
module Language.GraphQL.Type
|
||||
( Wrapping(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
|
||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||
-- type can wrap other wrapping or named types. Wrapping types are lists and
|
||||
-- Non-Null types (named types are nullable by default).
|
||||
--
|
||||
-- This 'Wrapping' type doesn\'t reflect this distinction exactly but it is
|
||||
-- used in the resolvers to take into account that the returned value can be
|
||||
-- nullable or an (arbitrary nested) list.
|
||||
data Wrapping a
|
||||
= List [Wrapping a] -- ^ Arbitrary nested list
|
||||
-- | Named a -- ^ Named type without further wrapping
|
||||
| Null -- ^ Null
|
||||
| O (HashMap Name a)
|
||||
| I Int
|
||||
| B Bool
|
||||
| F Float
|
||||
| E Text
|
||||
| S Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Functor Wrapping where
|
||||
fmap f (List list) = List $ fmap (fmap f) list
|
||||
fmap f (O map') = O $ f <$> map'
|
||||
fmap _ Null = Null
|
||||
fmap _ (I i) = I i
|
||||
fmap _ (B i) = B i
|
||||
fmap _ (F i) = F i
|
||||
fmap _ (E i) = E i
|
||||
fmap _ (S i) = S i
|
||||
|
||||
{-instance Foldable Wrapping where
|
||||
foldr f acc (List list) = foldr (flip $ foldr f) acc list
|
||||
foldr f acc (O map') = foldr f acc map'
|
||||
foldr _ acc _ = acc -}
|
||||
|
||||
{-instance Traversable Wrapping where
|
||||
traverse f (List list) = List <$> traverse (traverse f) list
|
||||
traverse f (Named named) = Named <$> f named
|
||||
traverse _ Null = pure Null
|
||||
traverse f (O map') = O <$> traverse f map'-}
|
||||
|
||||
{-instance Applicative Wrapping where
|
||||
pure = Named
|
||||
Null <*> _ = Null
|
||||
_ <*> Null = Null
|
||||
(Named f) <*> (Named x) = Named $ f x
|
||||
(List fs) <*> (List xs) = List $ (<*>) <$> fs <*> xs
|
||||
(Named f) <*> list = f <$> list
|
||||
(List fs) <*> named = List $ (<*> named) <$> fs
|
||||
|
||||
instance Monad Wrapping where
|
||||
return = pure
|
||||
Null >>= _ = Null
|
||||
(Named x) >>= f = f x
|
||||
(List xs) >>= f = List $ fmap (>>= f) xs-}
|
||||
@ -8,7 +8,6 @@ module Language.GraphQL.Type.Definition
|
||||
( Argument(..)
|
||||
, EnumType(..)
|
||||
, Field(..)
|
||||
, FieldResolver(..)
|
||||
, InputField(..)
|
||||
, InputObjectType(..)
|
||||
, InputType(..)
|
||||
@ -31,13 +30,13 @@ module Language.GraphQL.Type.Definition
|
||||
, string
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Set (Set)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core (Name, Value)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Prelude hiding (id)
|
||||
|
||||
-- | Object type definition.
|
||||
@ -51,17 +50,10 @@ data Field m = Field
|
||||
(Maybe Text) -- ^ Description.
|
||||
(OutputType m) -- ^ Field type.
|
||||
(HashMap Name Argument) -- ^ Arguments.
|
||||
(FieldResolver m) -- ^ Resolver.
|
||||
|
||||
-- | Resolving a field can result in a leaf value or an object, which is
|
||||
-- represented as a list of nested resolvers, used to resolve the fields of that
|
||||
-- object.
|
||||
data FieldResolver m
|
||||
= ValueResolver (ActionT m Aeson.Value)
|
||||
| NestingResolver (ActionT m (Type.Wrapping (FieldResolver m)))
|
||||
(ActionT m (Out.Value m)) -- ^ Resolver.
|
||||
|
||||
-- | Field argument definition.
|
||||
data Argument = Argument (Maybe Text) InputType (Maybe Value)
|
||||
data Argument = Argument (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Scalar type definition.
|
||||
--
|
||||
@ -77,7 +69,7 @@ data ScalarType = ScalarType Name (Maybe Text)
|
||||
data EnumType = EnumType Name (Maybe Text) (Set Text)
|
||||
|
||||
-- | Single field of an 'InputObjectType'.
|
||||
data InputField = InputField (Maybe Text) InputType (Maybe Value)
|
||||
data InputField = InputField (Maybe Text) InputType (Maybe In.Value)
|
||||
|
||||
-- | Input object type definition.
|
||||
--
|
||||
|
||||
@ -6,6 +6,7 @@ module Language.GraphQL.Type.Directive
|
||||
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Language.GraphQL.AST.Core
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
|
||||
-- | Directive processing status.
|
||||
data Status
|
||||
@ -36,7 +37,7 @@ skip = handle skip'
|
||||
where
|
||||
skip' directive'@(Directive "skip" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Skip
|
||||
(Just (In.Boolean True)) -> Skip
|
||||
_ -> Include directive'
|
||||
skip' directive' = Continue directive'
|
||||
|
||||
@ -45,6 +46,6 @@ include = handle include'
|
||||
where
|
||||
include' directive'@(Directive "include" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Include directive'
|
||||
(Just (In.Boolean True)) -> Include directive'
|
||||
_ -> Skip
|
||||
include' directive' = Continue directive'
|
||||
|
||||
26
src/Language/GraphQL/Type/In.hs
Normal file
26
src/Language/GraphQL/Type/In.hs
Normal file
@ -0,0 +1,26 @@
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.Out'.
|
||||
module Language.GraphQL.Type.In
|
||||
( Value(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Int (Int32)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= Int Int32
|
||||
| Float Double -- ^ GraphQL Float is double precision
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
58
src/Language/GraphQL/Type/Out.hs
Normal file
58
src/Language/GraphQL/Type/Out.hs
Normal file
@ -0,0 +1,58 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module is intended to be imported qualified, to avoid name clashes
|
||||
-- with 'Language.GraphQL.Type.In'.
|
||||
module Language.GraphQL.Type.Out
|
||||
( Value(..)
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Int (Int32)
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Language.GraphQL.AST.Document (Name)
|
||||
import Language.GraphQL.Trans
|
||||
|
||||
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
|
||||
-- type can wrap other wrapping or named types. Wrapping types are lists and
|
||||
-- Non-Null types (named types are nullable by default).
|
||||
--
|
||||
-- This 'Value' type doesn\'t reflect this distinction exactly but it is used
|
||||
-- in the resolvers to take into account that the returned value can be nullable
|
||||
-- or an (arbitrary nested) list.
|
||||
data Value m
|
||||
= Int Int32
|
||||
| Float Double
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value m] -- ^ Arbitrary nested list.
|
||||
| Object (HashMap Name (ActionT m (Value m)))
|
||||
|
||||
instance IsString (Value m) where
|
||||
fromString = String . fromString
|
||||
|
||||
instance Show (Value m) where
|
||||
show (Int integer) = "Int " ++ show integer
|
||||
show (Float float) = "Float " ++ show float
|
||||
show (String text) = Text.unpack $ "String " <> text
|
||||
show (Boolean True) = "Boolean True"
|
||||
show (Boolean False) = "Boolean False"
|
||||
show Null = "Null"
|
||||
show (Enum enum) = Text.unpack $ "Enum " <> enum
|
||||
show (List list) = show list
|
||||
show (Object object) = Text.unpack
|
||||
$ "Object [" <> Text.intercalate ", " (HashMap.keys object) <> "]"
|
||||
|
||||
instance Eq (Value m) where
|
||||
(Int this) == (Int that) = this == that
|
||||
(Float this) == (Float that) = this == that
|
||||
(String this) == (String that) = this == that
|
||||
(Boolean this) == (Boolean that) = this == that
|
||||
(Enum this) == (Enum that) = this == that
|
||||
(List this) == (List that) = this == that
|
||||
(Object this) == (Object that) = HashMap.keys this == HashMap.keys that
|
||||
_ == _ = False
|
||||
Reference in New Issue
Block a user