@@ -5,19 +5,21 @@ import Prelude
55import Control.Lazy (class Lazy)
66import Control.Monad.Error.Class (class MonadError, catchError, throwError)
77import Data.Argonaut.Core as Json
8+import Data.Array as Array
89import Data.Bifunctor (lmap)
910import Data.Either (Either(..), note)
1011import Data.Enum (class Enum, enumFromTo)
1112import Data.List (List, fromFoldable)
1213import Data.Map (Map, empty, insert, lookup)
1314import Data.Maybe (Maybe(..), fromMaybe)
14−import Data.Newtype (class Newtype, unwrap)
15+import Data.Newtype (class Newtype, unwrap, wrap)
1516import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
1617import Data.Traversable (class Traversable, find, traverse)
1718import Data.Tuple (Tuple(..))
1819import Effect.Exception (Error, error, message)
1920import GraphQL.Execution.Result (Result(..))
2021import GraphQL.Language.AST as AST
22+import GraphQL.Type.Introspection.Datatypes as IntrospectionTypes
2123import Record as Record
2224import Type.Data.RowList (RLProxy(..))
2325import Type.Row as Row
@@ -29,13 +31,17 @@ newtype Schema m a = Schema { query :: ObjectType m a, mutation :: Maybe (Object
2931
3032type VariableMap = Map String Json.Json
3133
34+-- | The type class for all GraphQL types
35+class GraphQLType t where
36+ introspect :: forall a. t a -> IntrospectionTypes.TypeIntrospection
37+
3238-- | The input type class is used for all GraphQL types that can be used as input types.
33−class InputType t where
39+class GraphQLType t <= InputType t where
3440 input :: forall a. t a -> Maybe AST.ValueNode -> VariableMap -> Either String a
3541
3642-- | The output type class is used for all GraphQL types that can be used as output types.
3743-- | It has instances for GraphQL types that can resolve a value within a certain monad error.
38−class MonadError Error m <= OutputType m t where
44+class (MonadError Error m, GraphQLType t) <= OutputType m t where
3945 output :: forall a. t a -> Maybe AST.SelectionSetNode -> VariableMap -> m a -> m Result
4046
4147-- | Scalar types are the leaf nodes of a GraphQL schema. Scalar types can be serialised into JSON
@@ -56,6 +62,16 @@ newtype ScalarType a =
5662 , serialize :: a -> Json.Json
5763 }
5864
65+instance graphqlTypeScalarType :: GraphQLType ScalarType where
66+ introspect (ScalarType { name, description }) =
67+ IntrospectionTypes.TypeIntrospection
68+ { kind: IntrospectionTypes.Scalar
69+ , name
70+ , description
71+ , fields: Nothing
72+ , enumValues: Nothing
73+ }
74+
5975instance inputTypeScalarType :: InputType ScalarType where
6076 input (ScalarType config) (Just node) variables = case node of
6177 (AST.VariableNode { name: AST.NameNode { value }}) -> do
@@ -73,22 +89,25 @@ instance showScalarType :: Show (ScalarType a) where
7389 show (ScalarType { name }) = "scalar " <> name
7490
7591newtype ObjectType m a =
76− ObjectType
77− (Unit -> { name :: String
78− , description :: Maybe String
92+ ObjectType (Unit ->
93+ { name :: String
7994 , fields :: Map String (ExecutableField m a)
80− })
95+ , introspection :: IntrospectionTypes.TypeIntrospection
96+ }
97+ )
98+
99+instance graphqlTypeObjectType :: GraphQLType (ObjectType m) where
100+ introspect (ObjectType configFn) = (configFn unit).introspection
81101
82102instance outputTypeObjectType :: (MonadError Error m) => OutputType m (ObjectType m) where
83103 output (ObjectType fno) (Just (AST.SelectionSetNode { selections })) variables val =
84104 ResultObject <$> traverse serializeField selections
85105 where
86− o = fno unit
87−
88106 serializeField :: AST.SelectionNode -> m (Tuple String Result)
89107 serializeField node@(AST.FieldNode fld) =
90108 let (AST.NameNode { value: name }) = fld.name
91109 (AST.NameNode { value: alias }) = fromMaybe fld.name fld.alias
110+ o = fno unit
92111 in case lookup name o.fields of
93112 Just (ExecutableField { execute }) ->
94113 Tuple alias <$>
@@ -129,6 +148,8 @@ newtype Field m a argsd argsp =
129148 Field
130149 { name :: String
131150 , description :: Maybe String
151+ , typeIntrospection :: Unit -> IntrospectionTypes.TypeIntrospection
152+ , argumentIntrospections :: Array IntrospectionTypes.InputValueIntrospection
132153 , args :: Record argsd
133154 , serialize :: AST.SelectionNode -> VariableMap -> Record argsp -> m a -> m Result
134155 }
@@ -138,9 +159,12 @@ newtype Field m a argsd argsp =
138159newtype Argument a =
139160 Argument
140161 { description :: Maybe String
162+ , typeIntrospection :: Unit -> IntrospectionTypes.TypeIntrospection
141163 , resolveValue :: Maybe AST.ValueNode -> VariableMap -> Either String a
142164 }
143165
166+derive instance newtypeArgument :: Newtype (Argument a) _
167+
144168newtype EnumType a =
145169 EnumType
146170 { name :: String
@@ -155,6 +179,21 @@ newtype EnumValue a =
155179 , value :: a
156180 , isValue :: a -> Boolean }
157181
182+instance graphqlTypeEnumType :: GraphQLType EnumType where
183+ introspect (EnumType { name, description, values }) =
184+ IntrospectionTypes.TypeIntrospection
185+ { kind: IntrospectionTypes.Enum
186+ , name
187+ , description
188+ , fields: Nothing
189+ , enumValues: pure $ values <#> \(EnumValue val) ->
190+ IntrospectionTypes.EnumValueIntrospection
191+ { name: val.name
192+ , description: val.description
193+ , deprecationReason: Nothing
194+ }
195+ }
196+
158197instance inputTypeEnumType :: InputType EnumType where
159198 input (EnumType config) (Just node) variables =
160199 let lookupName name =
@@ -192,15 +231,31 @@ instance outputTypeEnumType :: MonadError Error m => OutputType m EnumType where
192231-- | the `:>` operator from this module.
193232objectType :: forall m a. String -> ObjectType m a
194233objectType name =
195− ObjectType (\_ -> { name, description: Nothing, fields: empty })
234+ let
235+ introspection = IntrospectionTypes.TypeIntrospection
236+ { kind: IntrospectionTypes.Object
237+ , name
238+ , description: Nothing
239+ , fields: Just []
240+ , enumValues: Nothing
241+ }
242+ in
243+ ObjectType (\_ -> { name, fields: empty, introspection })
196244
197245-- | Create a new field for an object type. This function is typically used together with the
198246-- | `:>` operator that automatically converts the field into an executable field.
199247field :: forall m t a. OutputType m t => MonadError Error m => String -> t a -> Field m a () ()
200−field name t = Field { name, description: Nothing, args: {}, serialize }
201− where
202− serialize (AST.FieldNode node) variables _ val = output t node.selectionSet variables val
203− serialize _ _ _ _ = pure $ ResultError "Obtained non FieldNode for field serialisation."
248+field name t =
249+ Field
250+ { name
251+ , description: Nothing
252+ , args: {}
253+ , serialize
254+ , argumentIntrospections: []
255+ , typeIntrospection: \_ -> introspect t }
256+ where
257+ serialize (AST.FieldNode node) variables _ val = output t node.selectionSet variables val
258+ serialize _ _ _ _ = pure $ ResultError "Obtained non FieldNode for field serialisation."
204259
205260-- | Create a new field for an object type that is a list. You can return any `Foldable` in the
206261-- | resolver.
@@ -211,14 +266,21 @@ listField :: forall m f t a.
211266 String ->
212267 t a ->
213268 Field m (f a) () ()
214−listField name t = Field { name, description: Nothing, args: {}, serialize }
215− where
216− serialize (AST.FieldNode node) variables _ mVals = do
217− vals <- mVals
218− ResultList <$> fromFoldable <$> traverse (output t node.selectionSet variables) (pure <$> vals)
269+listField name t =
270+ Field
271+ { name
272+ , description: Nothing
273+ , args: {}
274+ , serialize
275+ , argumentIntrospections: []
276+ , typeIntrospection: \_ -> introspect t }
277+ where
278+ serialize (AST.FieldNode node) variables _ mVals = do
279+ vals <- mVals
280+ ResultList <$> fromFoldable <$> traverse (output t node.selectionSet variables) (pure <$> vals)
219281
220− serialize _ _ _ _ =
221− pure $ ResultError "Obtained non FieldNode for field serialisation."
282+ serialize _ _ _ _ =
283+ pure $ ResultError "Obtained non FieldNode for field serialisation."
222284
223285-- | Create a new field for an object type that is optional (i.e. it can be null). The resolver
224286-- | must now return a `Maybe`.
@@ -228,26 +290,71 @@ nullableField :: forall m t a.
228290 String ->
229291 t a ->
230292 Field m (Maybe a) () ()
231−nullableField name t = Field { name, description: Nothing, args: {}, serialize }
232− where
233− serialize (AST.FieldNode node) variables _ mValue = do
234− value <- mValue
235− case value of
236− Nothing ->
237− pure $ ResultNullable Nothing
293+nullableField name t =
294+ Field
295+ { name
296+ , description: Nothing
297+ , args: {}
298+ , serialize
299+ , argumentIntrospections: []
300+ , typeIntrospection: \_ -> introspect t }
301+ where
302+ serialize (AST.FieldNode node) variables _ mValue = do
303+ value <- mValue
304+ case value of
305+ Nothing ->
306+ pure $ ResultNullable Nothing
307+
308+ Just val ->
309+ ResultNullable <$> Just <$> output t node.selectionSet variables (pure val)
238310
239− Just val ->
240− ResultNullable <$> Just <$> output t node.selectionSet variables (pure val)
311+ serialize _ _ _ _ =
312+ pure $ ResultError "Obtained non FieldNode for field serialisation."
241313
242− serialize _ _ _ _ =
243− pure $ ResultError "Obtained non FieldNode for field serialisation."
314+
315+-- | Create a new field for an object type that is optional (i.e. it can be null) and returns a
316+-- | list. The resolver must now return a `Maybe`.
317+nullableListField :: forall m f t a.
318+ MonadError Error m =>
319+ Traversable f =>
320+ OutputType m t =>
321+ String ->
322+ t a ->
323+ Field m (Maybe (f a)) () ()
324+nullableListField name t =
325+ Field
326+ { name
327+ , description: Nothing
328+ , args: {}
329+ , serialize
330+ , argumentIntrospections: []
331+ , typeIntrospection: \_ -> introspect t }
332+ where
333+ serialize (AST.FieldNode node) variables _ mVals = do
334+ values <- mVals
335+ case values of
336+ Nothing ->
337+ pure $ ResultNullable Nothing
338+
339+ Just vals ->
340+ ResultNullable <$>
341+ Just <$>
342+ ResultList <$>
343+ fromFoldable <$>
344+ traverse (output t node.selectionSet variables) (pure <$> vals)
345+ serialize _ _ _ _ =
346+ pure $ ResultError "Obtained non FieldNode for field serialisation."
244347
245348-- | Create a tuple with a given name and a plain argument of the given type.
246349-- | The name argument tuple can then be used to be added to a field using the `?>` operator.
247350arg :: forall t a n. InputType t => IsSymbol n => t a -> SProxy n -> Tuple (SProxy n) (Argument a)
248351arg t name =
249352 Tuple (SProxy :: _ n) $
250− Argument { description: Nothing, resolveValue: input t }
353+ Argument
354+ { description: Nothing
355+ , resolveValue: input t
356+ , typeIntrospection: \_ -> introspect t
357+ }
251358
252359-- * Combinator operators
253360
@@ -268,7 +375,13 @@ class Describe a where
268375infixl 8 describe as .>
269376
270377instance describeObjectType :: Describe (ObjectType m a) where
271− describe (ObjectType config) s = ObjectType $ \_ -> ((config unit) { description = Just s })
378+ describe (ObjectType configFn) s =
379+ ObjectType $ \_ ->
380+ let
381+ config = configFn unit
382+ newIntrospection = wrap $ (unwrap config.introspection) { description = Just s }
383+ in
384+ config { introspection = newIntrospection }
272385
273386instance describeField :: Describe (Field m a argsd argsp) where
274387 describe (Field config) s = Field (config { description = Just s })
@@ -295,10 +408,31 @@ withField :: forall m a argsd argsp.
295408 ObjectType m a ->
296409 Field m a argsd argsp ->
297410 ObjectType m a
298−withField (ObjectType objectConfigFn) fld@(Field { name }) =
299− ObjectType $ \_ -> objectConfig { fields = insert name (makeExecutable fld) objectConfig.fields }
411+withField (ObjectType objectConfigFn) fld@(
412+ Field { name, description, typeIntrospection, argumentIntrospections }
413+) =
414+ ObjectType updated
300415 where
301− objectConfig = objectConfigFn unit
416+ updated _ =
417+ let
418+ objectConfig = objectConfigFn unit
419+ updatedFields = insert name (makeExecutable fld) objectConfig.fields
420+
421+ fieldIntrospection = IntrospectionTypes.FieldIntrospection
422+ { name
423+ , description
424+ , args: argumentIntrospections
425+ , type: typeIntrospection
426+ , deprecationReason: Nothing
427+ }
428+
429+ introspection = unwrap objectConfig.introspection
430+
431+ updatedIntrospection =
432+ IntrospectionTypes.TypeIntrospection $
433+ introspection { fields = map (flip Array.snoc fieldIntrospection) (introspection.fields) }
434+ in
435+ objectConfig { fields = updatedFields, introspection = updatedIntrospection }
302436
303437 makeExecutable :: Field m a argsd argsp -> ExecutableField m a
304438 makeExecutable (Field { args, serialize: serialize' }) = ExecutableField { execute: execute' }
@@ -405,7 +539,7 @@ withArgument :: forall m a arg n argsdold argsdnew argspold argspnew.
405539 Tuple (SProxy n) (Argument arg) ->
406540 Field m a argsdnew argspnew
407541withArgument (Field fieldConfig) (Tuple proxy argument) =
408− Field $ fieldConfig { args = args', serialize = serialize' }
542+ Field $ fieldConfig { args = args', serialize = serialize', argumentIntrospections = intros' }
409543 where
410544 args' :: Record argsdnew
411545 args' = Record.insert proxy argument fieldConfig.args
@@ -419,6 +553,17 @@ withArgument (Field fieldConfig) (Tuple proxy argument) =
419553 serialize' node variables argsnew val =
420554 fieldConfig.serialize node variables (Record.delete proxy argsnew) val
421555
556+ intros' :: Array IntrospectionTypes.InputValueIntrospection
557+ intros' = Array.snoc fieldConfig.argumentIntrospections
558+ (
559+ IntrospectionTypes.InputValueIntrospection
560+ { name: reflectSymbol proxy
561+ , description: _.description $ unwrap argument
562+ , type: _.typeIntrospection $ unwrap argument
563+ , defaultValue: Nothing
564+ }
565+ )
566+
422567-- | Adds an argument to a field that can be used in the resolver.
423568-- |
424569-- | *Example:*