diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/GraphQL/AST/Core.hs | 21 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Coerce.hs | 63 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Transform.hs | 45 | ||||
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 87 | ||||
| -rw-r--r-- | src/Language/GraphQL/Trans.hs | 7 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type.hs | 63 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Definition.hs | 20 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Directive.hs | 5 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/In.hs | 26 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Out.hs | 58 |
10 files changed, 191 insertions, 204 deletions
diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index d719912..6dcfb81 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs index 6997945..32c48fd 100644 --- a/src/Language/GraphQL/Execute/Coerce.hs +++ b/src/Language/GraphQL/Execute/Coerce.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index df64254..9768675 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -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' diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index 69f697e..34abf10 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -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 diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs index f09a8a0..3c3ffa4 100644 --- a/src/Language/GraphQL/Trans.hs +++ b/src/Language/GraphQL/Trans.hs @@ -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 diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs deleted file mode 100644 index 12b38dc..0000000 --- a/src/Language/GraphQL/Type.hs +++ /dev/null @@ -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-} diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs index 559611b..54eac85 100644 --- a/src/Language/GraphQL/Type/Definition.hs +++ b/src/Language/GraphQL/Type/Definition.hs @@ -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. -- diff --git a/src/Language/GraphQL/Type/Directive.hs b/src/Language/GraphQL/Type/Directive.hs index afd97da..9675df8 100644 --- a/src/Language/GraphQL/Type/Directive.hs +++ b/src/Language/GraphQL/Type/Directive.hs @@ -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' diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs new file mode 100644 index 0000000..a6d35e2 --- /dev/null +++ b/src/Language/GraphQL/Type/In.hs @@ -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 diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs new file mode 100644 index 0000000..96bc9cf --- /dev/null +++ b/src/Language/GraphQL/Type/Out.hs @@ -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 |