Split input/output types and values into 2 modules

CHANGELOG.md

@@ -29,13 +29,17 @@ and this project adheres to
   `AST.Document.Document` into `Execute.Transform.Document`.
 - `AST.Core.Value` was moved into `Type.In`. Input values are used only in the
   execution and type system, it is not a part of the parsing tree.
+- `Type` module is superseded by `Type.Out`. This module contains now only
+  exports from other module that complete `Type.In` and `Type.Out` exports.
 
 ### Added
-- `Type.Definition` contains input and the most output types.
+- `Type.Definition` contains base type system definition, e.g. Enums and
+  Scalars.
 - `Type.Schema` describes a schema. Both public functions that execute queries
   accept a `Schema` now instead of a `HashMap`. The execution fails if the root
   operation doesn't match the root Query type in the schema.
-- `Type.In` and `Type.Out`.
+- `Type.In` and `Type.Out` contain definitions for input and the most output
+  types.
 - `Execute.Coerce` defines a typeclass responsible for input, variable value
   coercion. It decouples us a bit from JSON since any format can be used to pass
   query variables. Execution functions accept (`HashMap Name a`) instead of
@@ -51,7 +55,6 @@ and this project adheres to
   GraphQL. E.g. GraphQL distinguishes between Floats and Integersa and we need
   a way to represent objects as a "Field Name -> Resolver" map.
 - `Schema.wrappedObject`. `Schema.object` creates now wrapped objects.
-- `Type` module. Superseded by `Type.Out`.
 
 ## [0.7.0.0] - 2020-05-11
 ### Fixed

docs/tutorial/tutorial.lhs

@@ -23,9 +23,9 @@ Since this file is a literate haskell file, we start by importing some dependenc
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
-> import Language.GraphQL.Type.Definition
+> import Language.GraphQL.Trans
-> import Language.GraphQL.Type.Schema
+> import Language.GraphQL.Type
-> import qualified Language.GraphQL.Type as Type
+> import qualified Language.GraphQL.Type.Out as Out
 >
 > import Prelude hiding (putStrLn)
 
@@ -42,10 +42,10 @@ First we build a GraphQL schema.
 > queryType :: ObjectType IO
 > queryType = ObjectType "Query" Nothing
 >   $ HashMap.singleton "hello"
->   $ Field Nothing (ScalarOutputType string) mempty hello
+>   $ Field Nothing (Out.NamedScalarType string) mempty hello
 >
-> hello :: FieldResolver IO
+> hello :: ActionT IO (Out.Value IO)
-> hello = NestingResolver $ pure $ Type.S "it's me"
+> hello = pure $ Out.String "it's me"
 
 This defines a simple schema with one type and one field, that resolves to a fixed value.
 
@@ -77,12 +77,12 @@ For this example, we're going to be using time.
 > queryType2 :: ObjectType IO
 > queryType2 = ObjectType "Query" Nothing
 >   $ HashMap.singleton "time"
->   $ Field Nothing (ScalarOutputType string) mempty time
+>   $ Field Nothing (Out.NamedScalarType string) mempty time
 >
-> time :: FieldResolver IO
+> time :: ActionT IO (Out.Value IO)
-> time = NestingResolver $ do
+> time = do
 >   t <- liftIO getCurrentTime
->   pure $ Type.S $ Text.pack $ show t
+>   pure $ Out.String $ Text.pack $ show t
 
 This defines a simple schema with one type and one field,
 which resolves to the current time.
@@ -140,8 +140,8 @@ Now that we have two resolvers, we can define a schema which uses them both.
 >
 > queryType3 :: ObjectType IO
 > queryType3 = ObjectType "Query" Nothing $ HashMap.fromList
->   [ ("hello", Field Nothing (ScalarOutputType string) mempty hello)
+>   [ ("hello", Field Nothing (Out.NamedScalarType string) mempty hello)
->   , ("time", Field Nothing (ScalarOutputType string) mempty time)
+>   , ("time", Field Nothing (Out.NamedScalarType string) mempty time)
 >   ]
 >
 > query3 :: Text

src/Language/GraphQL/Execute.hs

@@ -16,7 +16,7 @@ import Language.GraphQL.Execute.Coerce
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Schema as Schema
-import qualified Language.GraphQL.Type.Definition as Definition
+import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 
 -- | The substitution is applied to the document, and the resolvers are applied
@@ -66,7 +66,7 @@ operation = schemaOperation
         . flip Schema.resolve queryFields
         . fmap getResolver
         . fields
-    fields (Definition.ObjectType _ _ objectFields) = objectFields
+    fields (Out.ObjectType _ _ objectFields) = objectFields
     lookupError = pure
         $ singleError "Root operation type couldn't be found in the schema."
     schemaOperation Schema {query} (AST.Core.Query _ fields') =
@@ -75,4 +75,4 @@ operation = schemaOperation
         resolve fields' mutation
     schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
         lookupError
-    getResolver (Definition.Field _ _ _ resolver) = resolver
+    getResolver (Out.Field _ _ _ resolver) = resolver

src/Language/GraphQL/Execute/Coerce.hs

@@ -4,7 +4,6 @@
 module Language.GraphQL.Execute.Coerce
     ( VariableValue(..)
     , coerceInputLiterals
-    , isNonNullInputType
     ) where
 
 import qualified Data.Aeson as Aeson
@@ -45,13 +44,13 @@ class VariableValue a where
     -- If a value cannot be coerced without losing information, 'Nothing' should
     -- be returned, the coercion will fail then and the query won't be executed.
     coerceVariableValue
-        :: InputType -- ^ Expected type (variable type given in the query).
+        :: In.Type -- ^ Expected type (variable type given in the query).
         -> a -- ^ Variable value being coerced.
         -> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
 
 instance VariableValue Aeson.Value where
     coerceVariableValue _ Aeson.Null = Just In.Null
-    coerceVariableValue (ScalarInputTypeDefinition scalarType) value
+    coerceVariableValue (In.ScalarBaseType scalarType) value
         | (Aeson.String stringValue) <- value = Just $ In.String stringValue
         | (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
         | (Aeson.Number numberValue) <- value
@@ -59,11 +58,11 @@ instance VariableValue Aeson.Value where
             Just $ In.Float $ toRealFloat numberValue
         | (Aeson.Number numberValue) <- value = -- ID or Int
             In.Int <$> toBoundedInteger numberValue
-    coerceVariableValue (EnumInputTypeDefinition _) (Aeson.String stringValue) =
+    coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
         Just $ In.Enum stringValue
-    coerceVariableValue (ObjectInputTypeDefinition objectType) value
+    coerceVariableValue (In.InputObjectBaseType objectType) value
         | (Aeson.Object objectValue) <- value = do
-            let (InputObjectType _ _ inputFields) = objectType
+            let (In.InputObjectType _ _ inputFields) = objectType
             (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
             if HashMap.null newObjectValue
                 then Just $ In.Object resultMap
@@ -73,7 +72,7 @@ instance VariableValue Aeson.Value where
             $ Just (objectValue, HashMap.empty)
         matchFieldValues _ _ Nothing = Nothing
         matchFieldValues fieldName inputField (Just (objectValue, resultMap)) =
-            let (InputField _ fieldType _) = inputField
+            let (In.InputField _ fieldType _) = inputField
                 insert = flip (HashMap.insert fieldName) resultMap
                 newObjectValue = HashMap.delete fieldName objectValue
              in case HashMap.lookup fieldName objectValue of
@@ -81,7 +80,7 @@ instance VariableValue Aeson.Value where
                         coerced <- coerceVariableValue fieldType variableValue
                         pure (newObjectValue, insert coerced)
                     Nothing -> Just (objectValue, resultMap)
-    coerceVariableValue (ListInputTypeDefinition listType) value
+    coerceVariableValue (In.ListBaseType listType) value
         | (Aeson.Array arrayValue) <- value = In.List
             <$> foldr foldVector (Just []) arrayValue
         | otherwise = coerceVariableValue listType value
@@ -95,7 +94,7 @@ instance VariableValue Aeson.Value where
 -- | Coerces operation arguments according to the input coercion rules for the
 --   corresponding types.
 coerceInputLiterals
-    :: HashMap Name InputType
+    :: HashMap Name In.Type
     -> HashMap Name In.Value
     -> Maybe Subs
 coerceInputLiterals variableTypes variableValues =
@@ -105,7 +104,7 @@ coerceInputLiterals variableTypes variableValues =
         HashMap.insert variableName
         <$> (lookupVariable variableName >>= coerceInputLiteral variableType)
         <*> resultMap
-    coerceInputLiteral (ScalarInputType type') value
+    coerceInputLiteral (In.NamedScalarType type') value
         | (In.String stringValue) <- value
         , (ScalarType "String" _) <- type' = Just $ In.String stringValue
         | (In.Boolean booleanValue) <- value
@@ -121,17 +120,17 @@ coerceInputLiterals variableTypes variableValues =
         , (ScalarType "ID" _) <- type' = Just $ In.String stringValue
         | (In.Int intValue) <- value
         , (ScalarType "ID" _) <- type' = Just $ decimal intValue
-    coerceInputLiteral (EnumInputType type') (In.Enum enumValue)
+    coerceInputLiteral (In.NamedEnumType type') (In.Enum enumValue)
         | member enumValue type' = Just $ In.Enum enumValue
-    coerceInputLiteral (ObjectInputType type') (In.Object _) = 
+    coerceInputLiteral (In.NamedInputObjectType type') (In.Object _) = 
-        let (InputObjectType _ _ inputFields) = type'
+        let (In.InputObjectType _ _ inputFields) = type'
             in In.Object <$> foldWithKey matchFieldValues inputFields
     coerceInputLiteral _ _ = Nothing
     member value (EnumType _ _ members) = Set.member value members
-    matchFieldValues fieldName (InputField _ type' defaultValue) resultMap =
+    matchFieldValues fieldName (In.InputField _ type' defaultValue) resultMap =
         case lookupVariable fieldName of
             Just In.Null
-                | isNonNullInputType type' -> Nothing
+                | In.isNonNullType type' -> Nothing
                 | otherwise ->
                     HashMap.insert fieldName In.Null <$> resultMap
             Just variableValue -> HashMap.insert fieldName
@@ -141,7 +140,7 @@ coerceInputLiterals variableTypes variableValues =
                 | Just value <- defaultValue ->
                     HashMap.insert fieldName value <$> resultMap
                 | Nothing <- defaultValue
-                , isNonNullInputType type' -> Nothing
+                , In.isNonNullType type' -> Nothing
                 | otherwise -> resultMap
     lookupVariable = flip HashMap.lookup variableValues
     foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
@@ -149,11 +148,3 @@ coerceInputLiterals variableTypes variableValues =
         . Text.Lazy.toStrict
         . Text.Builder.toLazyText
         . Text.Builder.decimal
-
--- | Checks whether the given input type is a non-null type.
-isNonNullInputType :: InputType -> Bool
-isNonNullInputType (NonNullScalarInputType _) = True
-isNonNullInputType (NonNullEnumInputType _) = True
-isNonNullInputType (NonNullObjectInputType _) = True
-isNonNullInputType (NonNullListInputType _) = True
-isNonNullInputType _ = False

src/Language/GraphQL/Execute/Transform.hs

@@ -30,7 +30,6 @@ import qualified Language.GraphQL.AST as Full
 import qualified Language.GraphQL.AST.Core as Core
 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
@@ -86,31 +85,31 @@ getOperation (Just operationName) operations
 
 lookupInputType
     :: Full.Type
-    -> HashMap.HashMap Full.Name (Definition.TypeDefinition m)
+    -> HashMap.HashMap Full.Name (Type m)
-    -> Maybe Definition.InputType
+    -> Maybe In.Type
 lookupInputType (Full.TypeNamed name) types =
     case HashMap.lookup name types of
-        Just (Definition.ScalarTypeDefinition scalarType) ->
+        Just (ScalarType scalarType) ->
-            Just $ Definition.ScalarInputType scalarType
+            Just $ In.NamedScalarType scalarType
-        Just (Definition.EnumTypeDefinition enumType) ->
+        Just (EnumType enumType) ->
-            Just $ Definition.EnumInputType enumType
+            Just $ In.NamedEnumType enumType
-        Just (Definition.InputObjectTypeDefinition objectType) ->
+        Just (InputObjectType objectType) ->
-            Just $ Definition.ObjectInputType objectType
+            Just $ In.NamedInputObjectType objectType
         _ -> Nothing
 lookupInputType (Full.TypeList list) types
-    = Definition.ListInputType
+    = In.ListType
     <$> lookupInputType list types
 lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types  =
     case HashMap.lookup nonNull types of
-        Just (Definition.ScalarTypeDefinition scalarType) ->
+        Just (ScalarType scalarType) ->
-            Just $ Definition.NonNullScalarInputType scalarType
+            Just $ In.NonNullScalarType scalarType
-        Just (Definition.EnumTypeDefinition enumType) ->
+        Just (EnumType enumType) ->
-            Just $ Definition.NonNullEnumInputType enumType
+            Just $ In.NonNullEnumType enumType
-        Just (Definition.InputObjectTypeDefinition objectType) ->
+        Just (InputObjectType objectType) ->
-            Just $ Definition.NonNullObjectInputType objectType
+            Just $ In.NonNullInputObjectType objectType
         _ -> Nothing
 lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types
-    = Definition.NonNullListInputType
+    = In.NonNullListType
     <$> lookupInputType nonNull types
 
 coerceVariableValues :: (Monad m, VariableValue a)
@@ -137,10 +136,10 @@ coerceVariableValues schema operationDefinition variableValues' =
             <*> coercedValues
     choose Nothing defaultValue variableType
         | Just _ <- defaultValue = defaultValue
-        | not (isNonNullInputType variableType) = Just In.Null
+        | not (In.isNonNullType variableType) = Just In.Null
     choose (Just value') _ variableType
         | Just coercedValue <- coerceVariableValue variableType value'
-        , not (isNonNullInputType variableType) || coercedValue /= In.Null =
+        , not (In.isNonNullType variableType) || coercedValue /= In.Null =
             Just coercedValue
     choose _ _ _ = Nothing
 

src/Language/GraphQL/Type.hs

@@ -0,0 +1,14 @@
+-- | Reexports non-conflicting type system and schema definitions.
+module Language.GraphQL.Type
+    ( In.InputField(..)
+    , In.InputObjectType(..)
+    , Out.Field(..)
+    , Out.ObjectType(..)
+    , module Language.GraphQL.Type.Definition
+    , module Language.GraphQL.Type.Schema
+    ) where
+
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema (Schema(..))
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out

src/Language/GraphQL/Type/Definition.hs

@@ -1,28 +1,9 @@
-{-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ViewPatterns #-}
 
--- | Types representing GraphQL type system.
+-- | Types that can be used as both input and output types.
 module Language.GraphQL.Type.Definition
-    ( Argument(..)
+    ( EnumType(..)
-    , EnumType(..)
-    , Field(..)
-    , InputField(..)
-    , InputObjectType(..)
-    , InputType(..)
-    , ObjectType(..)
-    , OutputType(..)
     , ScalarType(..)
-    , TypeDefinition(..)
-    , pattern EnumInputTypeDefinition
-    , pattern ListInputTypeDefinition
-    , pattern ObjectInputTypeDefinition
-    , pattern ScalarInputTypeDefinition
-    , pattern EnumOutputTypeDefinition
-    , pattern ListOutputTypeDefinition
-    , pattern ObjectOutputTypeDefinition
-    , pattern ScalarOutputTypeDefinition
     , boolean
     , float
     , id
@@ -30,31 +11,11 @@ module Language.GraphQL.Type.Definition
     , string
     ) where
 
-import Data.HashMap.Strict (HashMap)
 import Data.Set (Set)
 import Data.Text (Text)
 import Language.GraphQL.AST.Document (Name)
-import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type.In as In
-import qualified Language.GraphQL.Type.Out as Out
 import Prelude hiding (id)
 
--- | Object type definition.
---
---   Almost all of the GraphQL types you define will be object types. Object
---   types have a name, but most importantly describe their fields.
-data ObjectType m = ObjectType Name (Maybe Text) (HashMap Name (Field m))
-
--- | Output object field definition.
-data Field m = Field
-    (Maybe Text) -- ^ Description.
-    (OutputType m) -- ^ Field type.
-    (HashMap Name Argument) -- ^ Arguments.
-    (ActionT m (Out.Value m)) -- ^ Resolver.
-
--- | Field argument definition.
-data Argument = Argument (Maybe Text) InputType (Maybe In.Value)
-
 -- | Scalar type definition.
 --
 -- The leaf values of any request and input values to arguments are Scalars (or
@@ -68,45 +29,6 @@ data ScalarType = ScalarType Name (Maybe Text)
 -- kind of type, often integers.
 data EnumType = EnumType Name (Maybe Text) (Set Text)
 
--- | Single field of an 'InputObjectType'.
-data InputField = InputField (Maybe Text) InputType (Maybe In.Value)
-
--- | Input object type definition.
---
--- An input object defines a structured collection of fields which may be
--- supplied to a field argument.
-data InputObjectType = InputObjectType
-    Name (Maybe Text) (HashMap Name InputField)
-
--- | These types may be used as input types for arguments and directives.
-data InputType
-    = ScalarInputType ScalarType
-    | EnumInputType EnumType
-    | ObjectInputType InputObjectType
-    | ListInputType InputType
-    | NonNullScalarInputType ScalarType
-    | NonNullEnumInputType EnumType
-    | NonNullObjectInputType InputObjectType
-    | NonNullListInputType InputType
-
--- | These types may be used as output types as the result of fields.
-data OutputType m
-    = ScalarOutputType ScalarType
-    | EnumOutputType EnumType
-    | ObjectOutputType (ObjectType m)
-    | ListOutputType (OutputType m)
-    | NonNullScalarOutputType ScalarType
-    | NonNullEnumOutputType EnumType
-    | NonNullObjectOutputType (ObjectType m)
-    | NonNullListOutputType (OutputType m)
-
--- | These are all of the possible kinds of types.
-data TypeDefinition m
-    = ScalarTypeDefinition ScalarType
-    | EnumTypeDefinition EnumType
-    | ObjectTypeDefinition (ObjectType m)
-    | InputObjectTypeDefinition InputObjectType
-
 -- | The @String@ scalar type represents textual data, represented as UTF-8
 -- character sequences. The String type is most often used by GraphQL to
 -- represent free-form human-readable text.
@@ -158,95 +80,3 @@ id = ScalarType "ID" (Just description)
         \JSON response as a String; however, it is not intended to be \
         \human-readable. When expected as an input type, any string (such as \
         \`\"4\"`) or integer (such as `4`) input value will be accepted as an ID."
-
--- | Matches either 'ScalarInputType' or 'NonNullScalarInputType'.
-pattern ScalarInputTypeDefinition :: ScalarType -> InputType
-pattern ScalarInputTypeDefinition scalarType <-
-    (isScalarInputType -> Just scalarType)
-
--- | Matches either 'EnumInputType' or 'NonNullEnumInputType'.
-pattern EnumInputTypeDefinition :: EnumType -> InputType
-pattern EnumInputTypeDefinition enumType <-
-    (isEnumInputType -> Just enumType)
-
--- | Matches either 'ObjectInputType' or 'NonNullObjectInputType'.
-pattern ObjectInputTypeDefinition :: InputObjectType -> InputType
-pattern ObjectInputTypeDefinition objectType <-
-    (isObjectInputType -> Just objectType)
-
--- | Matches either 'ListInputType' or 'NonNullListInputType'.
-pattern ListInputTypeDefinition :: InputType -> InputType
-pattern ListInputTypeDefinition listType <-
-    (isListInputType -> Just listType)
-
-{-# COMPLETE EnumInputTypeDefinition
-    , ListInputTypeDefinition
-    , ObjectInputTypeDefinition
-    , ScalarInputTypeDefinition
-    #-}
-
--- | Matches either 'ScalarOutputType' or 'NonNullScalarOutputType'.
-pattern ScalarOutputTypeDefinition :: forall m. ScalarType -> OutputType m
-pattern ScalarOutputTypeDefinition scalarType <-
-    (isScalarOutputType -> Just scalarType)
-
--- | Matches either 'EnumOutputType' or 'NonNullEnumOutputType'.
-pattern EnumOutputTypeDefinition :: forall m. EnumType -> OutputType m
-pattern EnumOutputTypeDefinition enumType <-
-    (isEnumOutputType -> Just enumType)
-
--- | Matches either 'ObjectOutputType' or 'NonNullObjectOutputType'.
-pattern ObjectOutputTypeDefinition :: forall m. ObjectType m -> OutputType m
-pattern ObjectOutputTypeDefinition objectType <-
-    (isObjectOutputType -> Just objectType)
-
--- | Matches either 'ListOutputType' or 'NonNullListOutputType'.
-pattern ListOutputTypeDefinition :: forall m. OutputType m -> OutputType m
-pattern ListOutputTypeDefinition listType <-
-    (isListOutputType -> Just listType)
-
-{-# COMPLETE ScalarOutputTypeDefinition
-    , EnumOutputTypeDefinition
-    , ObjectOutputTypeDefinition
-    , ListOutputTypeDefinition
-    #-}
-
-isScalarInputType :: InputType -> Maybe ScalarType
-isScalarInputType (ScalarInputType inputType) = Just inputType
-isScalarInputType (NonNullScalarInputType inputType) = Just inputType
-isScalarInputType _ = Nothing
-
-isObjectInputType :: InputType -> Maybe InputObjectType
-isObjectInputType (ObjectInputType inputType) = Just inputType
-isObjectInputType (NonNullObjectInputType inputType) = Just inputType
-isObjectInputType _ = Nothing
-
-isEnumInputType :: InputType -> Maybe EnumType
-isEnumInputType (EnumInputType inputType) = Just inputType
-isEnumInputType (NonNullEnumInputType inputType) = Just inputType
-isEnumInputType _ = Nothing
-
-isListInputType :: InputType -> Maybe InputType
-isListInputType (ListInputType inputType) = Just inputType
-isListInputType (NonNullListInputType inputType) = Just inputType
-isListInputType _ = Nothing
-
-isScalarOutputType :: forall m. OutputType m -> Maybe ScalarType
-isScalarOutputType (ScalarOutputType outputType) = Just outputType
-isScalarOutputType (NonNullScalarOutputType outputType) = Just outputType
-isScalarOutputType _ = Nothing
-
-isObjectOutputType :: forall m. OutputType m -> Maybe (ObjectType m)
-isObjectOutputType (ObjectOutputType outputType) = Just outputType
-isObjectOutputType (NonNullObjectOutputType outputType) = Just outputType
-isObjectOutputType _ = Nothing
-
-isEnumOutputType :: forall m. OutputType m -> Maybe EnumType
-isEnumOutputType (EnumOutputType outputType) = Just outputType
-isEnumOutputType (NonNullEnumOutputType outputType) = Just outputType
-isEnumOutputType _ = Nothing
-
-isListOutputType :: forall m. OutputType m -> Maybe (OutputType m)
-isListOutputType (ListOutputType outputType) = Just outputType
-isListOutputType (NonNullListOutputType outputType) = Just outputType
-isListOutputType _ = Nothing

src/Language/GraphQL/Type/In.hs

@@ -1,7 +1,21 @@
--- | This module is intended to be imported qualified, to avoid name clashes
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Input types and values.
+--
+-- This module is intended to be imported qualified, to avoid name clashes
 -- with 'Language.GraphQL.Type.Out'.
 module Language.GraphQL.Type.In
-    ( Value(..)
+    ( Argument(..)
+    , InputField(..)
+    , InputObjectType(..)
+    , Type(..)
+    , Value(..)
+    , isNonNullType
+    , pattern EnumBaseType
+    , pattern ListBaseType
+    , pattern InputObjectBaseType
+    , pattern ScalarBaseType
     ) where
 
 import Data.HashMap.Strict (HashMap)
@@ -9,6 +23,28 @@ import Data.Int (Int32)
 import Data.String (IsString(..))
 import Data.Text (Text)
 import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Type.Definition
+
+-- | Single field of an 'InputObjectType'.
+data InputField = InputField (Maybe Text) Type (Maybe Value)
+
+-- | Input object type definition.
+--
+-- An input object defines a structured collection of fields which may be
+-- supplied to a field argument.
+data InputObjectType = InputObjectType
+    Name (Maybe Text) (HashMap Name InputField)
+
+-- | These types may be used as input types for arguments and directives.
+data Type
+    = NamedScalarType ScalarType
+    | NamedEnumType EnumType
+    | NamedInputObjectType InputObjectType
+    | ListType Type
+    | NonNullScalarType ScalarType
+    | NonNullEnumType EnumType
+    | NonNullInputObjectType InputObjectType
+    | NonNullListType Type
 
 -- | Represents accordingly typed GraphQL values.
 data Value
@@ -24,3 +60,52 @@ data Value
 
 instance IsString Value where
     fromString = String . fromString
+
+-- | Field argument definition.
+data Argument = Argument (Maybe Text) Type (Maybe Value)
+
+-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
+pattern ScalarBaseType :: ScalarType -> Type
+pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
+
+-- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
+pattern EnumBaseType :: EnumType -> Type
+pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
+
+-- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'.
+pattern InputObjectBaseType :: InputObjectType -> Type
+pattern InputObjectBaseType objectType <- (isInputObjectType -> Just objectType)
+
+-- | Matches either 'ListType' or 'NonNullListType'.
+pattern ListBaseType :: Type -> Type
+pattern ListBaseType listType <- (isListType -> Just listType)
+
+{-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-}
+
+isScalarType :: Type -> Maybe ScalarType
+isScalarType (NamedScalarType inputType) = Just inputType
+isScalarType (NonNullScalarType inputType) = Just inputType
+isScalarType _ = Nothing
+
+isInputObjectType :: Type -> Maybe InputObjectType
+isInputObjectType (NamedInputObjectType inputType) = Just inputType
+isInputObjectType (NonNullInputObjectType inputType) = Just inputType
+isInputObjectType _ = Nothing
+
+isEnumType :: Type -> Maybe EnumType
+isEnumType (NamedEnumType inputType) = Just inputType
+isEnumType (NonNullEnumType inputType) = Just inputType
+isEnumType _ = Nothing
+
+isListType :: Type -> Maybe Type
+isListType (ListType inputType) = Just inputType
+isListType (NonNullListType inputType) = Just inputType
+isListType _ = Nothing
+
+-- | Checks whether the given input type is a non-null type.
+isNonNullType :: Type -> Bool
+isNonNullType (NonNullScalarType _) = True
+isNonNullType (NonNullEnumType _) = True
+isNonNullType (NonNullInputObjectType _) = True
+isNonNullType (NonNullListType _) = True
+isNonNullType _ = False

src/Language/GraphQL/Type/Out.hs

@@ -1,9 +1,22 @@
+{-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
 
--- | This module is intended to be imported qualified, to avoid name clashes
+-- | Output types and values.
+--
+-- This module is intended to be imported qualified, to avoid name clashes
 -- with 'Language.GraphQL.Type.In'.
 module Language.GraphQL.Type.Out
-    ( Value(..)
+    ( Field(..)
+    , ObjectType(..)
+    , Type(..)
+    , Value(..)
+    , isNonNullType
+    , pattern EnumBaseType
+    , pattern ListBaseType
+    , pattern ObjectBaseType
+    , pattern ScalarBaseType
     ) where
 
 import Data.HashMap.Strict (HashMap)
@@ -14,6 +27,32 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document (Name)
 import Language.GraphQL.Trans
+import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.In as In
+--
+-- | Object type definition.
+--
+--   Almost all of the GraphQL types you define will be object types. Object
+--   types have a name, but most importantly describe their fields.
+data ObjectType m = ObjectType Name (Maybe Text) (HashMap Name (Field m))
+
+-- | Output object field definition.
+data Field m = Field
+    (Maybe Text) -- ^ Description.
+    (Type m) -- ^ Field type.
+    (HashMap Name In.Argument) -- ^ Arguments.
+    (ActionT m (Value m)) -- ^ Resolver.
+
+-- | These types may be used as output types as the result of fields.
+data Type m
+    = NamedScalarType ScalarType
+    | NamedEnumType EnumType
+    | NamedObjectType (ObjectType m)
+    | ListType (Type m)
+    | NonNullScalarType ScalarType
+    | NonNullEnumType EnumType
+    | NonNullObjectType (ObjectType m)
+    | NonNullListType (Type m)
 
 -- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
 -- type can wrap other wrapping or named types. Wrapping types are lists and
@@ -37,7 +76,7 @@ instance IsString (Value m) where
 
 instance Show (Value m) where
     show (Int integer) = "Int " ++ show integer
-    show (Float float) = "Float " ++ show float
+    show (Float float') = "Float " ++ show float'
     show (String text) = Text.unpack $ "String " <> text
     show (Boolean True) = "Boolean True"
     show (Boolean False) = "Boolean False"
@@ -56,3 +95,49 @@ instance Eq (Value m) where
     (List this) == (List that) = this == that
     (Object this) == (Object that) = HashMap.keys this == HashMap.keys that
     _ == _ = False
+
+-- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
+pattern ScalarBaseType :: forall m. ScalarType -> Type m
+pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
+
+-- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
+pattern EnumBaseType :: forall m. EnumType -> Type m
+pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
+
+-- | Matches either 'NamedObjectType' or 'NonNullObjectType'.
+pattern ObjectBaseType :: forall m. ObjectType m -> Type m
+pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
+
+-- | Matches either 'ListType' or 'NonNullListType'.
+pattern ListBaseType :: forall m. Type m -> Type m
+pattern ListBaseType listType <- (isListType -> Just listType)
+
+{-# COMPLETE ScalarBaseType, EnumBaseType, ObjectBaseType, ListBaseType #-}
+
+isScalarType :: forall m. Type m -> Maybe ScalarType
+isScalarType (NamedScalarType outputType) = Just outputType
+isScalarType (NonNullScalarType outputType) = Just outputType
+isScalarType _ = Nothing
+
+isObjectType :: forall m. Type m -> Maybe (ObjectType m)
+isObjectType (NamedObjectType outputType) = Just outputType
+isObjectType (NonNullObjectType outputType) = Just outputType
+isObjectType _ = Nothing
+
+isEnumType :: forall m. Type m -> Maybe EnumType
+isEnumType (NamedEnumType outputType) = Just outputType
+isEnumType (NonNullEnumType outputType) = Just outputType
+isEnumType _ = Nothing
+
+isListType :: forall m. Type m -> Maybe (Type m)
+isListType (ListType outputType) = Just outputType
+isListType (NonNullListType outputType) = Just outputType
+isListType _ = Nothing
+
+-- | Checks whether the given output type is a non-null type.
+isNonNullType :: forall m. Type m -> Bool
+isNonNullType (NonNullScalarType _) = True
+isNonNullType (NonNullEnumType _) = True
+isNonNullType (NonNullObjectType _) = True
+isNonNullType (NonNullListType _) = True
+isNonNullType _ = False

src/Language/GraphQL/Type/Schema.hs

@@ -3,13 +3,23 @@
 -- | Schema Definition.
 module Language.GraphQL.Type.Schema
     ( Schema(..)
+    , Type(..)
     , collectReferencedTypes
     ) where
 
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL.AST.Core (Name)
-import Language.GraphQL.Type.Definition
+import qualified Language.GraphQL.Type.Definition as Definition
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
+
+-- | These are all of the possible kinds of types.
+data Type m
+    = ScalarType Definition.ScalarType
+    | EnumType Definition.EnumType
+    | ObjectType (Out.ObjectType m)
+    | InputObjectType In.InputObjectType
 
 -- | A Schema is created by supplying the root types of each type of operation,
 --   query and mutation (optional). A schema definition is then supplied to the
@@ -19,12 +29,12 @@ import Language.GraphQL.Type.Definition
 --   are reachable by traversing the root types are included, other types must
 --   be explicitly referenced.
 data Schema m = Schema
-    { query :: ObjectType m
+    { query :: Out.ObjectType m
-    , mutation :: Maybe (ObjectType m)
+    , mutation :: Maybe (Out.ObjectType m)
     }
 
 -- | Traverses the schema and finds all referenced types.
-collectReferencedTypes :: forall m. Schema m -> HashMap Name (TypeDefinition m)
+collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m)
 collectReferencedTypes schema =
     let queryTypes = traverseObjectType (query schema) HashMap.empty
      in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
@@ -33,36 +43,36 @@ collectReferencedTypes schema =
         let newMap = HashMap.insert typeName element foundTypes
          in maybe (traverser newMap) (const foundTypes)
             $ HashMap.lookup typeName foundTypes
-    visitFields (Field _ outputType arguments _) foundTypes
+    visitFields (Out.Field _ outputType arguments _) foundTypes
         = traverseOutputType outputType
         $ foldr visitArguments foundTypes arguments
-    visitArguments (Argument _ inputType _) = traverseInputType inputType
+    visitArguments (In.Argument _ inputType _) = traverseInputType inputType
-    visitInputFields (InputField _ inputType _) = traverseInputType inputType
+    visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
-    traverseInputType (ObjectInputTypeDefinition objectType) =
+    traverseInputType (In.InputObjectBaseType objectType) =
-        let (InputObjectType typeName _ inputFields) = objectType
+        let (In.InputObjectType typeName _ inputFields) = objectType
-            element = InputObjectTypeDefinition objectType
+            element = InputObjectType objectType
             traverser = flip (foldr visitInputFields) inputFields
          in collect traverser typeName element
-    traverseInputType (ListInputTypeDefinition listType) =
+    traverseInputType (In.ListBaseType listType) =
         traverseInputType listType
-    traverseInputType (ScalarInputTypeDefinition scalarType) =
+    traverseInputType (In.ScalarBaseType scalarType) =
-        let (ScalarType typeName _) = scalarType
+        let (Definition.ScalarType typeName _) = scalarType
-         in collect Prelude.id typeName (ScalarTypeDefinition scalarType)
+         in collect Prelude.id typeName (ScalarType scalarType)
-    traverseInputType (EnumInputTypeDefinition enumType) =
+    traverseInputType (In.EnumBaseType enumType) =
-        let (EnumType typeName _ _) = enumType
+        let (Definition.EnumType typeName _ _) = enumType
-         in collect Prelude.id typeName (EnumTypeDefinition enumType)
+         in collect Prelude.id typeName (EnumType enumType)
-    traverseOutputType (ObjectOutputTypeDefinition objectType) =
+    traverseOutputType (Out.ObjectBaseType objectType) =
         traverseObjectType objectType
-    traverseOutputType (ListOutputTypeDefinition listType) =
+    traverseOutputType (Out.ListBaseType listType) =
         traverseOutputType listType
-    traverseOutputType (ScalarOutputTypeDefinition scalarType) =
+    traverseOutputType (Out.ScalarBaseType scalarType) =
-        let (ScalarType typeName _) = scalarType
+        let (Definition.ScalarType typeName _) = scalarType
-         in collect Prelude.id typeName (ScalarTypeDefinition scalarType)
+         in collect Prelude.id typeName (ScalarType scalarType)
-    traverseOutputType (EnumOutputTypeDefinition enumType) =
+    traverseOutputType (Out.EnumBaseType enumType) =
-        let (EnumType typeName _ _) = enumType
+        let (Definition.EnumType typeName _ _) = enumType
-         in collect Prelude.id typeName (EnumTypeDefinition enumType)
+         in collect Prelude.id typeName (EnumType enumType)
     traverseObjectType objectType foundTypes =
-        let (ObjectType typeName _ objectFields) = objectType
+        let (Out.ObjectType typeName _ objectFields) = objectType
-            element = ObjectTypeDefinition objectType
+            element = ObjectType objectType
             traverser = flip (foldr visitFields) objectFields
          in collect traverser typeName element foundTypes

tests/Language/GraphQL/Execute/CoerceSpec.hs

@@ -23,7 +23,7 @@ direction :: EnumType
 direction = EnumType "Direction" Nothing 
     $ Set.fromList ["NORTH", "EAST", "SOUTH", "WEST"]
 
-coerceInputLiteral :: InputType -> In.Value -> Maybe Subs
+coerceInputLiteral :: In.Type -> In.Value -> Maybe Subs
 coerceInputLiteral input value = coerceInputLiterals
     (HashMap.singleton "variableName" input)
     (HashMap.singleton "variableName" value)
@@ -31,12 +31,12 @@ coerceInputLiteral input value = coerceInputLiterals
 lookupActual :: Maybe (HashMap Name In.Value) -> Maybe In.Value
 lookupActual = (HashMap.lookup "variableName" =<<)
 
-singletonInputObject :: InputType
+singletonInputObject :: In.Type
-singletonInputObject = ObjectInputType type'
+singletonInputObject = In.NamedInputObjectType type'
   where
-    type' = InputObjectType "ObjectName" Nothing inputFields
+    type' = In.InputObjectType "ObjectName" Nothing inputFields
     inputFields = HashMap.singleton "field" field
-    field = InputField Nothing (ScalarInputType string) Nothing
+    field = In.InputField Nothing (In.NamedScalarType string) Nothing
 
 spec :: Spec
 spec = do
@@ -44,36 +44,36 @@ spec = do
         it "coerces strings" $
             let expected = Just (In.String "asdf")
                 actual = coerceVariableValue
-                    (ScalarInputType string) (Aeson.String "asdf")
+                    (In.NamedScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces non-null strings" $
             let expected = Just (In.String "asdf")
                 actual = coerceVariableValue
-                    (NonNullScalarInputType string) (Aeson.String "asdf")
+                    (In.NonNullScalarType string) (Aeson.String "asdf")
              in actual `shouldBe` expected
         it "coerces booleans" $
             let expected = Just (In.Boolean True)
                 actual = coerceVariableValue
-                    (ScalarInputType boolean) (Aeson.Bool True)
+                    (In.NamedScalarType boolean) (Aeson.Bool True)
              in actual `shouldBe` expected
         it "coerces zero to an integer" $
             let expected = Just (In.Int 0)
                 actual = coerceVariableValue
-                    (ScalarInputType int) (Aeson.Number 0)
+                    (In.NamedScalarType int) (Aeson.Number 0)
              in actual `shouldBe` expected
         it "rejects fractional if an integer is expected" $
             let actual = coerceVariableValue
-                    (ScalarInputType int) (Aeson.Number $ scientific 14 (-1))
+                    (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldSatisfy` isNothing
         it "coerces float numbers" $
             let expected = Just (In.Float 1.4)
                 actual = coerceVariableValue
-                    (ScalarInputType float) (Aeson.Number $ scientific 14 (-1))
+                    (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
              in actual `shouldBe` expected
         it "coerces IDs" $
             let expected = Just (In.String "1234")
                 actual = coerceVariableValue
-                    (ScalarInputType id) (Aeson.String "1234")
+                    (In.NamedScalarType id) (Aeson.String "1234")
              in actual `shouldBe` expected
         it "coerces input objects" $
             let actual = coerceVariableValue singletonInputObject
@@ -94,11 +94,11 @@ spec = do
                     ]
              in actual `shouldSatisfy` isNothing
         it "preserves null" $
-            let actual = coerceVariableValue (ScalarInputType id) Aeson.Null
+            let actual = coerceVariableValue (In.NamedScalarType id) Aeson.Null
              in actual `shouldBe` Just In.Null
         it "preserves list order" $
             let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
-                listType = (ListInputType $ ScalarInputType string)
+                listType = (In.ListType $ In.NamedScalarType string)
                 actual = coerceVariableValue listType list
                 expected = Just $ In.List [In.String "asdf", In.String "qwer"]
              in actual `shouldBe` expected
@@ -107,13 +107,13 @@ spec = do
         it "coerces enums" $
             let expected = Just (In.Enum "NORTH")
                 actual = coerceInputLiteral
-                    (EnumInputType direction) (In.Enum "NORTH")
+                    (In.NamedEnumType direction) (In.Enum "NORTH")
              in lookupActual actual `shouldBe` expected
         it "fails with non-existing enum value" $
             let actual = coerceInputLiteral
-                    (EnumInputType direction) (In.Enum "NORTH_EAST")
+                    (In.NamedEnumType direction) (In.Enum "NORTH_EAST")
              in actual `shouldSatisfy` isNothing
         it "coerces integers to IDs" $
             let expected = Just (In.String "1234")
-                actual = coerceInputLiteral (ScalarInputType id) (In.Int 1234)
+                actual = coerceInputLiteral (In.NamedScalarType id) (In.Int 1234)
              in lookupActual actual `shouldBe` expected

tests/Test/DirectiveSpec.hs

@@ -17,9 +17,9 @@ experimentalResolver :: Schema IO
 experimentalResolver = Schema { query = queryType, mutation = Nothing }
   where
     resolver = pure $ Out.Int 5
-    queryType = ObjectType "Query" Nothing
+    queryType = Out.ObjectType "Query" Nothing
         $ HashMap.singleton "experimentalField"
-        $ Field Nothing (ScalarOutputType int) mempty resolver
+        $ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
 
 emptyObject :: Value
 emptyObject = object

tests/Test/FragmentSpec.hs

@@ -50,17 +50,17 @@ hasErrors :: Value -> Bool
 hasErrors (Object object') = HashMap.member "errors" object'
 hasErrors _ = True
 
-shirtType :: ObjectType IO
+shirtType :: Out.ObjectType IO
-shirtType = ObjectType "Shirt" Nothing
+shirtType = Out.ObjectType "Shirt" Nothing
     $ HashMap.singleton resolverName
-    $ Field Nothing (ScalarOutputType string) mempty resolve
+    $ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
   where
     (Schema.Resolver resolverName resolve) = size
 
-hatType :: ObjectType IO
+hatType :: Out.ObjectType IO
-hatType = ObjectType "Hat" Nothing
+hatType = Out.ObjectType "Hat" Nothing
     $ HashMap.singleton resolverName
-    $ Field Nothing (ScalarOutputType int) mempty resolve
+    $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
   where
     (Schema.Resolver resolverName resolve) = circumference
 
@@ -69,9 +69,9 @@ toSchema (Schema.Resolver resolverName resolve) = Schema
     { query = queryType, mutation = Nothing }
   where
     unionMember = if resolverName == "Hat" then hatType else shirtType
-    queryType = ObjectType "Query" Nothing
+    queryType = Out.ObjectType "Query" Nothing
         $ HashMap.singleton resolverName
-        $ Field Nothing (ObjectOutputType unionMember) mempty resolve
+        $ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
 
 spec :: Spec
 spec = do

tests/Test/RootOperationSpec.hs

@@ -14,27 +14,27 @@ import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 
-hatType :: ObjectType IO
+hatType :: Out.ObjectType IO
-hatType = ObjectType "Hat" Nothing
+hatType = Out.ObjectType "Hat" Nothing
     $ HashMap.singleton resolverName
-    $ Field Nothing (ScalarOutputType int) mempty resolve
+    $ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
   where
     (Schema.Resolver resolverName resolve) =
         Schema.Resolver "circumference" $ pure $ Out.Int 60
 
 schema :: Schema IO
 schema = Schema
-    (ObjectType "Query" Nothing hatField)
+    (Out.ObjectType "Query" Nothing hatField)
-    (Just $ ObjectType "Mutation" Nothing incrementField)
+    (Just $ Out.ObjectType "Mutation" Nothing incrementField)
   where
     garment = pure $ Schema.object
         [ Schema.Resolver "circumference" $ pure $ Out.Int 60
         ]
     incrementField = HashMap.singleton "incrementCircumference"
-        $ Field Nothing (ScalarOutputType int) mempty
+        $ Out.Field Nothing (Out.NamedScalarType int) mempty
         $ pure $ Out.Int 61
     hatField = HashMap.singleton "garment"
-        $ Field Nothing (ObjectOutputType hatType) mempty garment
+        $ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
 
 spec :: Spec
 spec =

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 "NEWHOPE"
-getEpisode 5 = pure $ "EMPIRE"
+getEpisode 5 = pure "EMPIRE"
-getEpisode 6 = pure $ "JEDI"
+getEpisode 6 = pure "JEDI"
 getEpisode _ = empty

tests/Test/StarWars/Schema.hs

@@ -25,10 +25,10 @@ import Test.StarWars.Data
 schema :: Schema Identity
 schema = Schema { query = queryType, mutation = Nothing }
   where
-    queryType = ObjectType "Query" Nothing $ HashMap.fromList
+    queryType = Out.ObjectType "Query" Nothing $ HashMap.fromList
-        [ ("hero", Field Nothing (ScalarOutputType string) mempty hero)
+        [ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
-        , ("human", Field Nothing (ScalarOutputType string) mempty human)
+        , ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
-        , ("droid", Field Nothing (ScalarOutputType string) mempty droid)
+        , ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
         ]
 
 hero :: ActionT Identity (Out.Value Identity)
@@ -55,7 +55,7 @@ droid :: ActionT Identity (Out.Value Identity)
 droid = do
     id' <- argument "id"
     case id' of
-        In.String i -> getDroid i >>= pure . character
+        In.String i -> character <$> getDroid i
         _ -> ActionT $ throwE "Invalid arguments."
 
 character :: Character -> Out.Value Identity
@@ -63,7 +63,7 @@ character char = Schema.object
     [ Schema.Resolver "id" $ pure $ Out.String $ id_ char
     , Schema.Resolver "name" $ pure $ Out.String $ name_ char
     , Schema.Resolver "friends"
-        $ pure $ Out.List $ fmap character $ getFriends char
+        $ pure $ Out.List $ character <$> getFriends char
     , Schema.Resolver "appearsIn" $ pure
         $ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
     , Schema.Resolver "secretBackstory" $ Out.String