Coerce result

Fixes #45.

docs/tutorial/tutorial.lhs

@@ -61,7 +61,7 @@ Next we define our query.
 To run the query, we call the `graphql` with the schema and the query.
 
 > main1 :: IO ()
-> main1 = putStrLn =<< encode <$> graphql schema1 query1
+> main1 = graphql schema1 query1 >>= putStrLn . encode
 
 This runs the query by fetching the one field defined,
 returning
@@ -99,7 +99,7 @@ Next we define our query.
 > query2 = "{ time }"
 >
 > main2 :: IO ()
-> main2 = putStrLn =<< encode <$> graphql schema2 query2
+> main2 = graphql schema2 query2 >>= putStrLn . encode
 
 This runs the query, returning the current time
 
@@ -154,7 +154,7 @@ Now that we have two resolvers, we can define a schema which uses them both.
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
-> main3 = putStrLn =<< encode <$> graphql schema3 query3
+> main3 = graphql schema3 query3 >>= putStrLn . encode
 
 This queries for both time and hello, returning
 

src/Language/GraphQL/Execute.hs

@@ -14,7 +14,7 @@ import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.Execution
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
-import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 
@@ -68,4 +68,4 @@ executeOperation :: Monad m
     -> Seq (Transform.Selection m)
     -> m Aeson.Value
 executeOperation types' objectType fields =
-    runCollectErrs types' $ executeSelectionSet Null objectType fields
+    runCollectErrs types' $ executeSelectionSet Definition.Null objectType fields

src/Language/GraphQL/Execute/Coerce.hs

@@ -3,21 +3,28 @@
 
 -- | Types and functions used for input and result coercion.
 module Language.GraphQL.Execute.Coerce
-    ( VariableValue(..)
+    ( Output(..)
+    , Serialize(..)
+    , VariableValue(..)
     , coerceInputLiteral
     , matchFieldValues
     ) where
 
 import qualified Data.Aeson as Aeson
+import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
+import Data.Map.Strict (Map)
+import Data.String (IsString(..))
+import Data.Text (Text)
 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 (Name)
+import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
-import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.Out as Out
 
 -- | Since variables are passed separately from the query, in an independent
 -- format, they should be first coerced to the internal representation used by
@@ -46,26 +53,26 @@ class VariableValue a where
     coerceVariableValue
         :: In.Type -- ^ Expected type (variable type given in the query).
         -> a -- ^ Variable value being coerced.
-        -> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.
+        -> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
 
 instance VariableValue Aeson.Value where
-    coerceVariableValue _ Aeson.Null = Just Null
+    coerceVariableValue _ Aeson.Null = Just Type.Null
     coerceVariableValue (In.ScalarBaseType scalarType) value
-        | (Aeson.String stringValue) <- value = Just $ String stringValue
+        | (Aeson.String stringValue) <- value = Just $ Type.String stringValue
-        | (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
+        | (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
         | (Aeson.Number numberValue) <- value
-        , (ScalarType "Float" _) <- scalarType =
+        , (Type.ScalarType "Float" _) <- scalarType =
-            Just $ Float $ toRealFloat numberValue
+            Just $ Type.Float $ toRealFloat numberValue
         | (Aeson.Number numberValue) <- value = -- ID or Int
-            Int <$> toBoundedInteger numberValue
+            Type.Int <$> toBoundedInteger numberValue
     coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
-        Just $ Enum stringValue
+        Just $ Type.Enum stringValue
     coerceVariableValue (In.InputObjectBaseType objectType) value
         | (Aeson.Object objectValue) <- value = do
             let (In.InputObjectType _ _ inputFields) = objectType
             (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
             if HashMap.null newObjectValue
-                then Just $ Object resultMap
+                then Just $ Type.Object resultMap
                 else Nothing
       where
         foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
@@ -81,8 +88,8 @@ instance VariableValue Aeson.Value where
                         pure (newObjectValue, insert coerced)
                     Nothing -> Just (objectValue, resultMap)
     coerceVariableValue (In.ListBaseType listType) value
-        | (Aeson.Array arrayValue) <- value = List
+        | (Aeson.Array arrayValue) <- value =
-            <$> foldr foldVector (Just []) arrayValue
+            Type.List <$> foldr foldVector (Just []) arrayValue
         | otherwise = coerceVariableValue listType value
       where
         foldVector _ Nothing = Nothing
@@ -97,13 +104,13 @@ instance VariableValue Aeson.Value where
 -- result map. Otherwise it fails with 'Nothing' if the Input Type is a
 -- Non-Nullable type, or returns the unchanged, original map.
 matchFieldValues :: forall a
-    . (In.Type -> a -> Maybe Value)
+    . (In.Type -> a -> Maybe Type.Value)
     -> HashMap Name a
     -> Name
     -> In.Type
-    -> Maybe Value
+    -> Maybe Type.Value
-    -> Maybe (HashMap Name Value)
+    -> Maybe (HashMap Name Type.Value)
-    -> Maybe (HashMap Name Value)
+    -> Maybe (HashMap Name Type.Value)
 matchFieldValues coerce values' fieldName type' defaultValue resultMap =
     case HashMap.lookup fieldName values' of
         Just variableValue -> coerceRuntimeValue $ coerce type' variableValue
@@ -114,44 +121,99 @@ matchFieldValues coerce values' fieldName type' defaultValue resultMap =
             , In.isNonNullType type' -> Nothing
             | otherwise -> resultMap
   where
-    coerceRuntimeValue (Just Null)
+    coerceRuntimeValue (Just Type.Null)
         | In.isNonNullType type' = Nothing
     coerceRuntimeValue coercedValue =
         HashMap.insert fieldName <$> coercedValue <*> resultMap
 
 -- | Coerces operation arguments according to the input coercion rules for the
 -- corresponding types.
-coerceInputLiteral :: In.Type -> Value -> Maybe Value
+coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value
 coerceInputLiteral (In.ScalarBaseType type') value
-    | (String stringValue) <- value
+    | (Type.String stringValue) <- value
-    , (ScalarType "String" _) <- type' = Just $ String stringValue
+    , (Type.ScalarType "String" _) <- type' = Just $ Type.String stringValue
-    | (Boolean booleanValue) <- value
+    | (Type.Boolean booleanValue) <- value
-    , (ScalarType "Boolean" _) <- type' = Just $ Boolean booleanValue
+    , (Type.ScalarType "Boolean" _) <- type' = Just $ Type.Boolean booleanValue
-    | (Int intValue) <- value
+    | (Type.Int intValue) <- value
-    , (ScalarType "Int" _) <- type' = Just $ Int intValue
+    , (Type.ScalarType "Int" _) <- type' = Just $ Type.Int intValue
-    | (Float floatValue) <- value
+    | (Type.Float floatValue) <- value
-    , (ScalarType "Float" _) <- type' = Just $ Float floatValue
+    , (Type.ScalarType "Float" _) <- type' = Just $ Type.Float floatValue
-    | (Int intValue) <- value
+    | (Type.Int intValue) <- value
-    , (ScalarType "Float" _) <- type' =
+    , (Type.ScalarType "Float" _) <- type' =
-        Just $ Float $ fromIntegral intValue
+        Just $ Type.Float $ fromIntegral intValue
-    | (String stringValue) <- value
+    | (Type.String stringValue) <- value
-    , (ScalarType "ID" _) <- type' = Just $ String stringValue
+    , (Type.ScalarType "ID" _) <- type' = Just $ Type.String stringValue
-    | (Int intValue) <- value
+    | (Type.Int intValue) <- value
-    , (ScalarType "ID" _) <- type' = Just $ decimal intValue
+    , (Type.ScalarType "ID" _) <- type' = Just $ decimal intValue
   where
-    decimal = String
+    decimal = Type.String
         . Text.Lazy.toStrict
         . Text.Builder.toLazyText
         . Text.Builder.decimal
-coerceInputLiteral (In.EnumBaseType type') (Enum enumValue)
+coerceInputLiteral (In.EnumBaseType type') (Type.Enum enumValue)
-    | member enumValue type' = Just $ Enum enumValue
+    | member enumValue type' = Just $ Type.Enum enumValue
   where
-    member value (EnumType _ _ members) = HashMap.member value members
+    member value (Type.EnumType _ _ members) = HashMap.member value members
-coerceInputLiteral (In.InputObjectBaseType type') (Object values) = 
+coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) = 
     let (In.InputObjectType _ _ inputFields) = type'
-        in Object
+        in Type.Object
             <$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields
   where
     matchFieldValues' values' fieldName (In.InputField _ inputFieldType defaultValue) =
         matchFieldValues coerceInputLiteral values' fieldName inputFieldType defaultValue
 coerceInputLiteral _ _ = Nothing
+
+-- | 'Serialize' describes how a @GraphQL@ value should be serialized.
+class Serialize a where
+    -- | Serializes a @GraphQL@ value according to the given serialization
+    -- format.
+    --
+    -- Type infomration is given as a hint, e.g. if you need to know what type
+    -- is being serialized to serialize it properly. Don't do any validation for
+    -- @GraphQL@ built-in types here.
+    --
+    -- If the value cannot be serialized without losing information, return
+    -- 'Nothing' — it will cause a field error.
+    serialize :: forall m
+        . Out.Type m -- ^ Expected output type.
+        -> Output a -- ^ The value to be serialized.
+        -> Maybe a -- ^ Serialized value on success or 'Nothing'.
+    -- | __null__ representation in the given serialization format.
+    null :: a
+
+-- | Intermediate type used to serialize a @GraphQL@ value.
+--
+-- The serialization is done during the execution, and 'Output' contains
+-- already serialized data (in 'List' and 'Object') as well as the new layer
+-- that has to be serialized in the current step. So 'Output' is parameterized
+-- by the serialization format.
+data Output a
+    = Int Int32
+    | Float Double
+    | String Text
+    | Boolean Bool
+    | Enum Name
+    | List [a]
+    | Object (Map Name a)
+    deriving (Eq, Show)
+
+instance forall a. IsString (Output a) where
+    fromString = String . fromString
+
+instance Serialize Aeson.Value where
+    serialize (Out.ScalarBaseType scalarType) value
+        | Type.ScalarType "Int" _ <- scalarType
+        , Int int <- value = Just $ Aeson.toJSON int
+        | Type.ScalarType "Float" _ <- scalarType
+        , Float float <- value = Just $ Aeson.toJSON float
+        | Type.ScalarType "String" _ <- scalarType
+        , String string <- value = Just $ Aeson.String string
+        | Type.ScalarType "ID" _ <- scalarType
+        , String string <- value = Just $ Aeson.String string
+        | Type.ScalarType "Boolean" _ <- scalarType
+        , Boolean boolean <- value = Just $ Aeson.Bool boolean
+    serialize _ (Enum enum) = Just $ Aeson.String enum
+    serialize _ (List list) = Just $ Aeson.toJSON list
+    serialize _ (Object object) = Just $ Aeson.toJSON object
+    serialize _ _ = Nothing
+    null = Aeson.Null

src/Language/GraphQL/Execute/Execution.hs

@@ -1,11 +1,11 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Language.GraphQL.Execute.Execution
     ( executeSelectionSet
     ) where
 
-import qualified Data.Aeson as Aeson
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Control.Monad.Trans.Reader (runReaderT)
@@ -22,16 +22,17 @@ import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Core
 import Language.GraphQL.Error
 import Language.GraphQL.Execute.Coerce
-import Language.GraphQL.Execute.Transform
+import qualified Language.GraphQL.Execute.Transform as Transform
 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
 import Language.GraphQL.Type.Schema
+import Prelude hiding (null)
 
 resolveFieldValue :: Monad m
-    => Definition.Value
+    => Type.Value
-    -> Definition.Subs
+    -> Type.Subs
     -> ActionT m a
     -> m (Either Text a)
 resolveFieldValue result args =
@@ -41,29 +42,29 @@ resolveFieldValue result args =
 
 collectFields :: Monad m
     => Out.ObjectType m
-    -> Seq (Selection m)
+    -> Seq (Transform.Selection m)
-    -> Map Name (NonEmpty (Field m))
+    -> Map Name (NonEmpty (Transform.Field m))
 collectFields objectType = foldl forEach Map.empty
   where
-    forEach groupedFields (SelectionField field) =
+    forEach groupedFields (Transform.SelectionField field) =
         let responseKey = aliasOrName field
          in Map.insertWith (<>) responseKey (field :| []) groupedFields
-    forEach groupedFields (SelectionFragment selectionFragment)
+    forEach groupedFields (Transform.SelectionFragment selectionFragment)
-        | Fragment fragmentType fragmentSelectionSet <- selectionFragment
+        | Transform.Fragment fragmentType fragmentSelectionSet <- selectionFragment
         , doesFragmentTypeApply fragmentType objectType =
             let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
              in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
         | otherwise = groupedFields
 
-aliasOrName :: forall m. Field m -> Name
+aliasOrName :: forall m. Transform.Field m -> Name
-aliasOrName (Field alias name _ _) = fromMaybe name alias
+aliasOrName (Transform.Field alias name _ _) = fromMaybe name alias
 
 resolveAbstractType :: Monad m
     => AbstractType m
-    -> HashMap Name Definition.Value
+    -> Type.Subs
     -> CollectErrsT m (Maybe (Out.ObjectType m))
 resolveAbstractType abstractType values'
-    | Just (Definition.String typeName) <- HashMap.lookup "__typename" values' = do
+    | Just (Type.String typeName) <- HashMap.lookup "__typename" values' = do
         types' <- gets types
         case HashMap.lookup typeName types' of
             Just (ObjectType objectType) ->
@@ -97,14 +98,14 @@ instanceOf objectType (AbstractUnionType unionType) =
   where
     go unionMemberType acc = acc || objectType == unionMemberType
 
-executeField :: Monad m
+executeField :: (Monad m, Serialize a)
     => Out.Resolver m
-    -> Definition.Value
+    -> Type.Value
-    -> NonEmpty (Field m)
+    -> NonEmpty (Transform.Field m)
-    -> CollectErrsT m Aeson.Value
+    -> CollectErrsT m a
 executeField (Out.Resolver fieldDefinition resolver) prev fields = do
     let Out.Field _ fieldType argumentDefinitions = fieldDefinition
-    let (Field _ _ arguments' _ :| []) = fields
+    let (Transform.Field _ _ arguments' _ :| []) = fields
     case coerceArgumentValues argumentDefinitions arguments' of
         Nothing -> errmsg "Argument coercing failed."
         Just argumentValues -> do
@@ -113,61 +114,80 @@ executeField (Out.Resolver fieldDefinition resolver) prev fields = do
                 Right result -> completeValue fieldType fields result
                 Left errorMessage -> errmsg errorMessage
 
-completeValue :: Monad m
+completeValue :: (Monad m, Serialize a)
     => Out.Type m
-    -> NonEmpty (Field m)
+    -> NonEmpty (Transform.Field m)
-    -> Definition.Value
+    -> Type.Value
-    -> CollectErrsT m Aeson.Value
+    -> CollectErrsT m a
-completeValue _ _ Definition.Null = pure Aeson.Null
+completeValue (Out.isNonNullType -> False) _ Type.Null = pure null
-completeValue _ _ (Definition.Int integer) = pure $ Aeson.toJSON integer
+completeValue outputType@(Out.ListBaseType listType) fields (Type.List list)
-completeValue _ _ (Definition.Boolean boolean') = pure $ Aeson.Bool boolean'
+    = traverse (completeValue listType fields) list
-completeValue _ _ (Definition.Float float') = pure $ Aeson.toJSON float'
+    >>= coerceResult outputType . List
-completeValue _ _ (Definition.Enum enum) = pure $ Aeson.String enum
+completeValue outputType@(Out.ScalarBaseType _) _ (Type.Int int) =
-completeValue _ _ (Definition.String string') = pure $ Aeson.String string'
+    coerceResult outputType $ Int int
-completeValue (Out.ListBaseType listType) fields (Definition.List list) =
+completeValue outputType@(Out.ScalarBaseType _) _ (Type.Boolean boolean) =
-    Aeson.toJSON <$> traverse (completeValue listType fields) list
+    coerceResult outputType $ Boolean boolean
+completeValue outputType@(Out.ScalarBaseType _) _ (Type.Float float) =
+    coerceResult outputType $ Float float
+completeValue outputType@(Out.ScalarBaseType _) _ (Type.String string) =
+    coerceResult outputType $ String string
+completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) =
+    let Type.EnumType _ _ enumMembers = enumType
+     in if HashMap.member enum enumMembers
+        then coerceResult outputType $ Enum enum
+        else errmsg "Value completion failed."
 completeValue (Out.ObjectBaseType objectType) fields result =
     executeSelectionSet result objectType $ mergeSelectionSets fields
 completeValue (Out.InterfaceBaseType interfaceType) fields result
-    | Definition.Object objectMap <- result = do
+    | Type.Object objectMap <- result = do
-        abstractType <- resolveAbstractType (AbstractInterfaceType interfaceType) objectMap
+        let abstractType = AbstractInterfaceType interfaceType
-        case abstractType of
+        concreteType <- resolveAbstractType abstractType objectMap
+        case concreteType of
             Just objectType -> executeSelectionSet result objectType
                 $ mergeSelectionSets fields
             Nothing -> errmsg "Value completion failed."
 completeValue (Out.UnionBaseType unionType) fields result
-    | Definition.Object objectMap <- result = do
+    | Type.Object objectMap <- result = do
-        abstractType <- resolveAbstractType (AbstractUnionType unionType) objectMap
+        let abstractType = AbstractUnionType unionType
-        case abstractType of
+        concreteType <- resolveAbstractType abstractType objectMap
+        case concreteType of
             Just objectType -> executeSelectionSet result objectType
                 $ mergeSelectionSets fields
             Nothing -> errmsg "Value completion failed."
 completeValue _ _ _ = errmsg "Value completion failed."
 
-mergeSelectionSets :: Monad m => NonEmpty (Field m) -> Seq (Selection m)
+mergeSelectionSets :: Monad m => NonEmpty (Transform.Field m) -> Seq (Transform.Selection m)
-mergeSelectionSets fields = foldr forEach mempty fields
+mergeSelectionSets = foldr forEach mempty
   where
-    forEach (Field _ _ _ fieldSelectionSet) selectionSet =
+    forEach (Transform.Field _ _ _ fieldSelectionSet) selectionSet =
         selectionSet <> fieldSelectionSet
 
-errmsg :: Monad m => Text -> CollectErrsT m Aeson.Value
+errmsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
-errmsg errorMessage = addErrMsg errorMessage >> pure Aeson.Null
+errmsg errorMessage = addErrMsg errorMessage >> pure null
 
--- | Takes an 'Out.ObjectType' and a list of 'Selection's and applies each field
+coerceResult :: (Monad m, Serialize a)
--- to each 'Selection'. Resolves into a value containing the resolved
+    => Out.Type m
--- 'Selection', or a null value and error information.
+    -> Output a
-executeSelectionSet :: Monad m
+    -> CollectErrsT m a
-    => Definition.Value
+coerceResult outputType result
+    | Just serialized <- serialize outputType result = pure serialized
+    | otherwise = errmsg "Result coercion failed."
+
+-- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
+-- each field to each 'Transform.Selection'. Resolves into a value containing
+-- the resolved 'Transform.Selection', or a null value and error information.
+executeSelectionSet :: (Monad m, Serialize a)
+    => Type.Value
     -> Out.ObjectType m
-    -> Seq (Selection m)
+    -> Seq (Transform.Selection m)
-    -> CollectErrsT m Aeson.Value
+    -> CollectErrsT m a
 executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selectionSet = do
     let fields = collectFields objectType selectionSet
     resolvedValues <- Map.traverseMaybeWithKey forEach fields
-    pure $ Aeson.toJSON resolvedValues
+    coerceResult (Out.NonNullObjectType objectType) $ Object resolvedValues
   where
     forEach _ fields@(field :| _) =
-        let Field _ name _ _ = field
+        let Transform.Field _ name _ _ = field
          in traverse (tryResolver fields) $ lookupResolver name
     lookupResolver = flip HashMap.lookup resolvers
     tryResolver fields resolver =
@@ -175,35 +195,35 @@ executeSelectionSet result objectType@(Out.ObjectType _ _ _ resolvers) selection
 
 coerceArgumentValues
     :: HashMap Name In.Argument
-    -> HashMap Name Input
+    -> HashMap Name Transform.Input
-    -> Maybe Definition.Subs
+    -> Maybe Type.Subs
 coerceArgumentValues argumentDefinitions argumentValues =
     HashMap.foldrWithKey forEach (pure mempty) argumentDefinitions
   where
     forEach variableName (In.Argument _ variableType defaultValue) =
         matchFieldValues coerceArgumentValue argumentValues variableName variableType defaultValue
-    coerceArgumentValue inputType (Int integer) =
+    coerceArgumentValue inputType (Transform.Int integer) =
-        coerceInputLiteral inputType (Definition.Int integer)
+        coerceInputLiteral inputType (Type.Int integer)
-    coerceArgumentValue inputType (Boolean boolean) =
+    coerceArgumentValue inputType (Transform.Boolean boolean) =
-        coerceInputLiteral inputType (Definition.Boolean boolean)
+        coerceInputLiteral inputType (Type.Boolean boolean)
-    coerceArgumentValue inputType (String string) =
+    coerceArgumentValue inputType (Transform.String string) =
-        coerceInputLiteral inputType (Definition.String string)
+        coerceInputLiteral inputType (Type.String string)
-    coerceArgumentValue inputType (Float float) =
+    coerceArgumentValue inputType (Transform.Float float) =
-        coerceInputLiteral inputType (Definition.Float float)
+        coerceInputLiteral inputType (Type.Float float)
-    coerceArgumentValue inputType (Enum enum) =
+    coerceArgumentValue inputType (Transform.Enum enum) =
-        coerceInputLiteral inputType (Definition.Enum enum)
+        coerceInputLiteral inputType (Type.Enum enum)
-    coerceArgumentValue inputType Null
+    coerceArgumentValue inputType Transform.Null
         | In.isNonNullType inputType = Nothing
-        | otherwise = coerceInputLiteral inputType Definition.Null
+        | otherwise = coerceInputLiteral inputType Type.Null
-    coerceArgumentValue (In.ListBaseType inputType) (List list) =
+    coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) =
         let coerceItem = coerceInputLiteral inputType
-         in Definition.List <$> traverse coerceItem list
+         in Type.List <$> traverse coerceItem list
-    coerceArgumentValue (In.InputObjectBaseType inputType) (Object object)
+    coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)
         | In.InputObjectType _ _ inputFields <- inputType = 
             let go = forEachField object
                 resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
-             in Definition.Object <$> resultMap
+             in Type.Object <$> resultMap
-    coerceArgumentValue _ (Variable variable) = pure variable
+    coerceArgumentValue _ (Transform.Variable variable) = pure variable
     coerceArgumentValue _ _ = Nothing
     forEachField object variableName (In.InputField _ variableType defaultValue) =
         matchFieldValues coerceArgumentValue object variableName variableType defaultValue

src/Language/GraphQL/Execute/Transform.hs

@@ -45,10 +45,10 @@ import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Core
-import Language.GraphQL.Execute.Coerce
+import qualified Language.GraphQL.Execute.Coerce as Coerce
 import Language.GraphQL.Type.Directive (Directive(..))
 import qualified Language.GraphQL.Type.Directive as Directive
-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
 import Language.GraphQL.Type.Schema
@@ -57,7 +57,7 @@ import Language.GraphQL.Type.Schema
 data Replacement m = Replacement
     { fragments :: HashMap Full.Name (Fragment m)
     , fragmentDefinitions :: FragmentDefinitions
-    , variableValues :: Definition.Subs
+    , variableValues :: Type.Subs
     , types :: HashMap Full.Name (Type m)
     }
 
@@ -110,9 +110,9 @@ data Input
     | Boolean Bool
     | Null
     | Enum Name
-    | List [Definition.Value]
+    | List [Type.Value]
     | Object (HashMap Name Input)
-    | Variable Definition.Value
+    | Variable Type.Value
     deriving (Eq, Show)
 
 queryError :: QueryError -> Text
@@ -168,12 +168,12 @@ lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
     = In.NonNullListType
     <$> lookupInputType nonNull types
 
-coerceVariableValues :: VariableValue a
+coerceVariableValues :: Coerce.VariableValue a
     => forall m
     . HashMap Full.Name (Type m)
     -> OperationDefinition
     -> HashMap.HashMap Full.Name a
-    -> Either QueryError Definition.Subs
+    -> Either QueryError Type.Subs
 coerceVariableValues types operationDefinition variableValues =
     let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
      in maybe (Left CoercionError) Right
@@ -185,27 +185,33 @@ coerceVariableValues types operationDefinition variableValues =
         let defaultValue' = constValue <$> defaultValue
         variableType <- lookupInputType variableTypeName types
 
-        matchFieldValues coerceVariableValue' variableValues variableName variableType defaultValue' coercedValues
+        Coerce.matchFieldValues
+            coerceVariableValue'
+            variableValues
+            variableName
+            variableType
+            defaultValue'
+            coercedValues
     coerceVariableValue' variableType value'
-        = coerceVariableValue variableType value'
+        = Coerce.coerceVariableValue variableType value'
-        >>= coerceInputLiteral variableType
+        >>= Coerce.coerceInputLiteral variableType
 
-constValue :: Full.ConstValue -> Definition.Value
+constValue :: Full.ConstValue -> Type.Value
-constValue (Full.ConstInt i) = Definition.Int i
+constValue (Full.ConstInt i) = Type.Int i
-constValue (Full.ConstFloat f) = Definition.Float f
+constValue (Full.ConstFloat f) = Type.Float f
-constValue (Full.ConstString x) = Definition.String x
+constValue (Full.ConstString x) = Type.String x
-constValue (Full.ConstBoolean b) = Definition.Boolean b
+constValue (Full.ConstBoolean b) = Type.Boolean b
-constValue Full.ConstNull = Definition.Null
+constValue Full.ConstNull = Type.Null
-constValue (Full.ConstEnum e) = Definition.Enum e
+constValue (Full.ConstEnum e) = Type.Enum e
-constValue (Full.ConstList l) = Definition.List $ constValue <$> l
+constValue (Full.ConstList l) = Type.List $ constValue <$> l
 constValue (Full.ConstObject o) =
-    Definition.Object $ HashMap.fromList $ constObjectField <$> o
+    Type.Object $ HashMap.fromList $ constObjectField <$> o
   where
     constObjectField (Full.ObjectField key value') = (key, constValue value')
 
 -- | Rewrites the original syntax tree into an intermediate representation used
 -- for query execution.
-document :: VariableValue a
+document :: Coerce.VariableValue a
     => forall m
     . Schema m
     -> Maybe Full.Name
@@ -386,30 +392,30 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
         let newFragments = HashMap.insert name newValue fragments
          in replacement{ fragments = newFragments }
 
-value :: forall m. Full.Value -> State (Replacement m) Definition.Value
+value :: forall m. Full.Value -> State (Replacement m) Type.Value
 value (Full.Variable name) =
-    gets (fromMaybe Definition.Null . HashMap.lookup name . variableValues)
+    gets (fromMaybe Type.Null . HashMap.lookup name . variableValues)
-value (Full.Int i) = pure $ Definition.Int i
+value (Full.Int int) = pure $ Type.Int int
-value (Full.Float f) = pure $ Definition.Float f
+value (Full.Float float) = pure $ Type.Float float
-value (Full.String x) = pure $ Definition.String x
+value (Full.String string) = pure $ Type.String string
-value (Full.Boolean b) = pure $ Definition.Boolean b
+value (Full.Boolean boolean) = pure $ Type.Boolean boolean
-value Full.Null = pure Definition.Null
+value Full.Null = pure Type.Null
-value (Full.Enum e) = pure $ Definition.Enum e
+value (Full.Enum enum) = pure $ Type.Enum enum
-value (Full.List l) = Definition.List <$> traverse value l
+value (Full.List list) = Type.List <$> traverse value list
-value (Full.Object o) =
+value (Full.Object object) =
-    Definition.Object . HashMap.fromList <$> traverse objectField o
+    Type.Object . HashMap.fromList <$> traverse objectField object
   where
     objectField (Full.ObjectField name value') = (name,) <$> value value'
 
 input :: forall m. Full.Value -> State (Replacement m) (Maybe Input)
 input (Full.Variable name) =
     gets (fmap Variable . HashMap.lookup name . variableValues)
-input (Full.Int i) = pure $ pure $ Int i
+input (Full.Int int) = pure $ pure $ Int int
-input (Full.Float f) = pure $ pure $ Float f
+input (Full.Float float) = pure $ pure $ Float float
-input (Full.String x) = pure $ pure $ String x
+input (Full.String string) = pure $ pure $ String string
-input (Full.Boolean b) = pure $ pure $ Boolean b
+input (Full.Boolean boolean) = pure $ pure $ Boolean boolean
 input Full.Null = pure $ pure Null
-input (Full.Enum e) = pure $ pure $ Enum e
+input (Full.Enum enum) = pure $ pure $ Enum enum
 input (Full.List list) = pure . List <$> traverse value list
 input (Full.Object object) = do
     objectFields <- foldM objectField HashMap.empty object

tests/Language/GraphQL/Execute/CoerceSpec.hs

@@ -9,7 +9,7 @@ import qualified Data.Aeson.Types as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (isNothing)
 import Data.Scientific (scientific)
-import Language.GraphQL.Execute.Coerce
+import qualified Language.GraphQL.Execute.Coerce as Coerce
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 import Prelude hiding (id)
@@ -30,55 +30,58 @@ singletonInputObject = In.NamedInputObjectType type'
     inputFields = HashMap.singleton "field" field
     field = In.InputField Nothing (In.NamedScalarType string) Nothing
 
+namedIdType :: In.Type
+namedIdType = In.NamedScalarType id
+
 spec :: Spec
 spec = do
     describe "VariableValue Aeson" $ do
         it "coerces strings" $
             let expected = Just (String "asdf")
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces non-null strings" $
             let expected = Just (String "asdf")
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NonNullScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces booleans" $
             let expected = Just (Boolean True)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType boolean) (Aeson.Bool True)
              in actual `shouldBe` expected
         it "coerces zero to an integer" $
             let expected = Just (Int 0)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType int) (Aeson.Number 0)
              in actual `shouldBe` expected
         it "rejects fractional if an integer is expected" $
-            let actual = coerceVariableValue
+            let actual = Coerce.coerceVariableValue
                     (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldSatisfy` isNothing
         it "coerces float numbers" $
             let expected = Just (Float 1.4)
-                actual = coerceVariableValue
+                actual = Coerce.coerceVariableValue
                     (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldBe` expected
         it "coerces IDs" $
             let expected = Just (String "1234")
-                actual = coerceVariableValue
+                json = Aeson.String "1234"
-                    (In.NamedScalarType id) (Aeson.String "1234")
+                actual = Coerce.coerceVariableValue namedIdType json
              in actual `shouldBe` expected
         it "coerces input objects" $
-            let actual = coerceVariableValue singletonInputObject
+            let actual = Coerce.coerceVariableValue singletonInputObject
                     $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
                 expected = Just $ Object $ HashMap.singleton "field" "asdf"
              in actual `shouldBe` expected
         it "skips the field if it is missing in the variables" $
-            let actual = coerceVariableValue
+            let actual = Coerce.coerceVariableValue
                     singletonInputObject Aeson.emptyObject
                 expected = Just $ Object HashMap.empty
              in actual `shouldBe` expected
         it "fails if input object value contains extra fields" $
-            let actual = coerceVariableValue singletonInputObject
+            let actual = Coerce.coerceVariableValue singletonInputObject
                     $ Aeson.object variableFields
                 variableFields =
                     [ "field" .= ("asdf" :: Aeson.Value)
@@ -86,26 +89,26 @@ spec = do
                     ]
              in actual `shouldSatisfy` isNothing
         it "preserves null" $
-            let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
+            let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
              in actual `shouldBe` Just Null
         it "preserves list order" $
             let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
                 listType = (In.ListType $ In.NamedScalarType string)
-                actual = coerceVariableValue listType list
+                actual = Coerce.coerceVariableValue listType list
                 expected = Just $ List [String "asdf", String "qwer"]
              in actual `shouldBe` expected
 
     describe "coerceInputLiterals" $ do
         it "coerces enums" $
             let expected = Just (Enum "NORTH")
-                actual = coerceInputLiteral
+                actual = Coerce.coerceInputLiteral
                     (In.NamedEnumType direction) (Enum "NORTH")
              in actual `shouldBe` expected
         it "fails with non-existing enum value" $
-            let actual = coerceInputLiteral
+            let actual = Coerce.coerceInputLiteral
                     (In.NamedEnumType direction) (Enum "NORTH_EAST")
              in actual `shouldSatisfy` isNothing
         it "coerces integers to IDs" $
             let expected = Just (String "1234")
-                actual = coerceInputLiteral (In.NamedScalarType id) (Int 1234)
+                actual = Coerce.coerceInputLiteral namedIdType (Int 1234)
              in actual `shouldBe` expected

tests/Language/GraphQL/ExecuteSpec.hs

@@ -12,7 +12,7 @@ import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Parser (document)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
-import Language.GraphQL.Type
+import Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Out as Out
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.Megaparsec (parse)
@@ -25,7 +25,7 @@ queryType = Out.ObjectType "Query" Nothing []
     $ HashMap.singleton "philosopher"
     $ Out.Resolver philosopherField
     $ pure
-    $ Object mempty
+    $ Type.Object mempty
   where
     philosopherField =
         Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
@@ -38,8 +38,8 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
         [ ("firstName", firstNameResolver)
         , ("lastName", lastNameResolver)
         ]
-    firstNameResolver = Out.Resolver firstNameField $ pure $ String "Friedrich"
+    firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
-    lastNameResolver = Out.Resolver lastNameField $ pure $ String "Nietzsche"
+    lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
     firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
     lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 

tests/Test/StarWars/Data.hs

@@ -184,7 +184,7 @@ getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 
 getEpisode :: Int -> Maybe Text
-getEpisode 4 = pure "NEWHOPE"
+getEpisode 4 = pure "NEW_HOPE"
 getEpisode 5 = pure "EMPIRE"
 getEpisode 6 = pure "JEDI"
 getEpisode _ = empty

tests/Test/StarWars/QuerySpec.hs

@@ -64,9 +64,9 @@ spec = describe "Star Wars Query Tests" $ do
                 friends {
                   name
                   appearsIn
-                    friends {
+                  friends {
-                      name
+                    name
-                    }
+                  }
                 }
               }
             }
@@ -77,7 +77,7 @@ spec = describe "Star Wars Query Tests" $ do
             , "friends" .= [
                   Aeson.object [
                       "name" .= ("Luke Skywalker" :: Text)
-                    , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .= [
                           Aeson.object [hanName]
                         , Aeson.object [leiaName]
@@ -87,7 +87,7 @@ spec = describe "Star Wars Query Tests" $ do
                     ]
                 , Aeson.object [
                       hanName
-                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .=
                         [ Aeson.object [lukeName]
                         , Aeson.object [leiaName]
@@ -96,7 +96,7 @@ spec = describe "Star Wars Query Tests" $ do
                     ]
                 , Aeson.object [
                       leiaName
-                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
+                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                     , "friends" .=
                         [ Aeson.object [lukeName]
                         , Aeson.object [hanName]

tests/Test/StarWars/Schema.hs

@@ -42,7 +42,7 @@ heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
     [ ("id", Out.Resolver idFieldType (idField "id"))
     , ("name", Out.Resolver nameFieldType (idField "name"))
     , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
     , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
     , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
     , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
@@ -55,7 +55,7 @@ droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
     [ ("id", Out.Resolver idFieldType (idField "id"))
     , ("name", Out.Resolver nameFieldType (idField "name"))
     , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInFieldType (idField "appearsIn"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
     , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
     , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
     , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
@@ -72,8 +72,11 @@ nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
 friendsFieldType :: Out.Field Identity
 friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
 
-appearsInFieldType :: Out.Field Identity
+appearsInField :: Out.Field Identity
-appearsInFieldType = Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty
+appearsInField = Out.Field (Just description) fieldType mempty
+  where
+    fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
+    description = "Which movies they appear in."
 
 secretBackstoryFieldType :: Out.Field Identity
 secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
@@ -97,7 +100,7 @@ hero :: ActionT Identity Value
 hero = do
   episode <- argument "episode"
   pure $ character $ case episode of
-      Enum "NEWHOPE" -> getHero 4
+      Enum "NEW_HOPE" -> getHero 4
       Enum "EMPIRE" -> getHero 5
       Enum "JEDI" -> getHero 6
       _ -> artoo