@@ -4,7 +4,7 @@ import Prelude
44
55import Control.Lazy (class Lazy)
66import Control.Monad.Error.Class (class MonadError, catchError, throwError)
7−import Data.Argonaut.Core as Json
7+import Data.Argonaut as Json
88import Data.Array as Array
99import Data.Bifunctor (lmap)
1010import Data.Either (Either(..), note)
@@ -20,6 +20,7 @@ import Effect.Exception (Error, error, message)
2020import GraphQL.Execution.Result (Result(..))
2121import GraphQL.Language.AST as AST
2222import GraphQL.Type.Introspection.Datatypes as IntrospectionTypes
23+import Prim.Row (class Lacks, class Cons)
2324import Record as Record
2425import Type.Data.RowList (RLProxy(..))
2526import Type.Row as Row
@@ -72,6 +73,7 @@ instance graphqlTypeScalarType :: GraphQLType ScalarType where
7273 , name: Just name
7374 , description
7475 , fields: Nothing
76+ , inputs: Nothing
7577 , enumValues: Nothing
7678 , ofType: Nothing
7779 }
@@ -203,6 +205,7 @@ instance graphqlTypeEnumType :: GraphQLType EnumType where
203205 , name: Just name
204206 , description
205207 , fields: Nothing
208+ , inputs: Nothing
206209 , enumValues: pure $ values <#> \(EnumValue val) ->
207210 IntrospectionTypes.EnumValueIntrospection
208211 { name: val.name
@@ -245,6 +248,60 @@ instance outputTypeEnumType :: MonadError Error m => OutputType m EnumType where
245248
246249 output _ _ _ _ = pure $ ResultError "Invalid subselection on enum type!"
247250
251+newtype InputObjectType a = InputObjectType (Unit ->
252+ { name :: String
253+ , description :: Maybe String
254+ , fieldIntrospection :: Array IntrospectionTypes.InputValueIntrospection
255+ , input :: Maybe AST.ValueNode -> ExecutionContext -> Either String a
256+ }
257+)
258+
259+instance graphqlTypeInputObjectType :: GraphQLType InputObjectType where
260+ introspect (InputObjectType config) =
261+ IntrospectionTypes.TypeIntrospection
262+ { kind: IntrospectionTypes.InputObject
263+ , name: Just (config unit).name
264+ , description: (config unit).description
265+ , fields: Nothing
266+ , inputs: Just $ (config unit).fieldIntrospection
267+ , enumValues: Nothing
268+ , ofType: Nothing
269+ }
270+
271+instance inputTypeInputObjectType :: InputType InputObjectType where
272+ input (InputObjectType config) = (config unit).input
273+
274+derive instance newtypeInputObjectType :: Newtype (InputObjectType a) _
275+
276+instance lazyInputObjectType :: Lazy (InputObjectType a) where
277+ defer fn = InputObjectType $ \_ -> unwrap (fn unit) unit
278+
279+inputObjectType :: String -> InputObjectType {}
280+inputObjectType name = InputObjectType \_ ->
281+ { name
282+ , description: Nothing
283+ , fieldIntrospection: []
284+ , input: \_ _ -> Right {}
285+ }
286+
287+newtype InputField l a = InputField
288+ { name :: SProxy l
289+ , introspection :: IntrospectionTypes.InputValueIntrospection
290+ , input :: Maybe AST.ValueNode -> ExecutionContext -> Either String a
291+ }
292+
293+inputField :: forall t l a. IsSymbol l => InputType t => t a -> SProxy l -> InputField l a
294+inputField inputType label = InputField
295+ { name: label
296+ , introspection:
297+ IntrospectionTypes.InputValueIntrospection
298+ { name: reflectSymbol label
299+ , description: Nothing
300+ , defaultValue: Nothing
301+ , type: \_ -> introspect inputType
302+ }
303+ , input: input inputType }
304+
248305-- | Creates an empty object type with the given name. Fields can be added to the object type using
249306-- | the `:>` operator from this module.
250307objectType :: forall m a. String -> ObjectType m a
@@ -255,6 +312,7 @@ objectType name =
255312 , name: Just name
256313 , description: Nothing
257314 , fields: Just []
315+ , inputs: Nothing
258316 , enumValues: Nothing
259317 , ofType: Nothing
260318 }
@@ -282,6 +340,7 @@ field name t =
282340 , name: Nothing
283341 , description: Nothing
284342 , fields: Nothing
343+ , inputs: Nothing
285344 , enumValues: Nothing
286345 , ofType: Just $ \_ -> introspect t
287346 }
@@ -317,6 +376,7 @@ listField name t =
317376 , description: Nothing
318377 , fields: Nothing
319378 , enumValues: Nothing
379+ , inputs: Nothing
320380 , ofType: Just $ \_ ->
321381 IntrospectionTypes.TypeIntrospection
322382 { kind: IntrospectionTypes.List
@@ -324,6 +384,7 @@ listField name t =
324384 , description: Nothing
325385 , fields: Nothing
326386 , enumValues: Nothing
387+ , inputs: Nothing
327388 , ofType: Just $ \_ -> introspect t
328389 }
329390 }
@@ -396,6 +457,7 @@ nullableListField name t =
396457 , name: Nothing
397458 , description: Nothing
398459 , fields: Nothing
460+ , inputs: Nothing
399461 , enumValues: Nothing
400462 , ofType: Just $ \_ -> introspect t
401463 }
@@ -484,9 +546,20 @@ instance describeEnumType :: Describe (EnumType a) where
484546instance describeEnumValue :: Describe (EnumValue a) where
485547 describe (EnumValue config) s = EnumValue ( config { description = Just s })
486548
549+instance describeInputObjectType :: Describe (InputObjectType a) where
550+ describe (InputObjectType configFn) s =
551+ InputObjectType $ \_ -> (configFn unit) { description = Just s }
552+
553+instance describeInputField :: Describe (InputField s a) where
554+ describe (InputField config) s =
555+ InputField $ config { introspection = i }
556+ where
557+ { introspection: (IntrospectionTypes.InputValueIntrospection introspection)} = config
558+ i = IntrospectionTypes.InputValueIntrospection $ introspection { description = Just s }
559+
487560-- | The `withField` function is used to add fields to an object type.
488561-- |
489−-- | When added to an object type the information about the field's argument are hidden in the
562+-- | When added to an object type the information about the field's arguments are hidden in the
490563-- | closure by being converted to the `ExecutableField` type.
491564withField :: forall m a argsd argsp.
492565 ArgsDefToArgsParam argsd argsp =>
@@ -596,7 +669,7 @@ instance argsFromRowsCons ::
596669 -- Extract the argument value if the node can be found. If not use null value
597670 -- TODO: Implement default values where we would try to use the default value first
598671 valueNode = map (\(AST.ArgumentNode { value }) -> value) argumentNode
599− improveInputError err = "Error when reading variable '" <> reflectSymbol key <> "': " <> err
672+ improveInputError err = "Error when reading argument '" <> reflectSymbol key <> "': " <> err
600673 resolvedValue = lmap improveInputError $ argConfig.resolveValue valueNode variables
601674 tail =
602675 argsFromRows
@@ -723,6 +796,63 @@ withMappingResolver fld resolver = withSimpleResolver fld (resolver >>> pure)
723796-- | ```
724797infixl 6 withMappingResolver as !#>
725798
799+-- | Add a field to an input object type.
800+-- | Usually this functions operator alias
801+withInputField :: forall l a r1 r2.
802+ IsSymbol l
803+ => Lacks l r1
804+ => Cons l a r1 r2
805+ => InputObjectType { | r1 }
806+ -> InputField l a
807+ -> InputObjectType { | r2 }
808+withInputField (InputObjectType objConfig) (InputField inputConfig) =InputObjectType (\_ ->
809+ let
810+ config = (objConfig unit)
811+ fieldLabel = (SProxy :: SProxy l)
812+ fieldName = reflectSymbol fieldLabel
813+
814+ input :: Maybe AST.ValueNode -> ExecutionContext -> Either String (Record r2)
815+ input variableNode execCtx = do
816+ let readField = Json.caseJsonObject (Right Nothing) (flip Json.getFieldOptional' fieldName)
817+ recValue <- config.input variableNode execCtx
818+ case variableNode of
819+ (Just (AST.VariableNode { name: AST.NameNode n })) ->
820+ case lookup n.value execCtx.variables of
821+ Just json -> do
822+ maybeValue <- readField json
823+ let hackedVariables = insert "variable_hack" (fromMaybe Json.jsonNull maybeValue) empty
824+ let hackedCtx = { fragments: execCtx.fragments, variables: hackedVariables }
825+ fieldValue <-
826+ inputConfig.input
827+ (Just (AST.VariableNode { name: (AST.NameNode { value: "variable_hack" }) }))
828+ hackedCtx
829+ pure $ Record.insert fieldLabel fieldValue recValue
830+ Nothing -> Left ("Unknown variable \"" <> n.value <> "\".")
831+
832+ (Just (AST.ObjectValueNode { fields })) ->
833+ case find (\(AST.ObjectFieldNode { name: AST.NameNode n }) -> n.value == fieldName) fields of
834+ Just (AST.ObjectFieldNode { value }) -> do
835+ fieldValue <- inputConfig.input (Just value) execCtx
836+ pure $ Record.insert fieldLabel fieldValue recValue
837+ Nothing -> Left ("Field '" <> fieldName <> "' is required in object type.")
838+
839+ _ -> Left "Must provide value for required input object value."
840+
841+ fieldIntrospection = Array.cons inputConfig.introspection config.fieldIntrospection
842+
843+ in config { input = input, fieldIntrospection = fieldIntrospection }
844+ )
845+
846+-- | Add a field to an input object type.
847+-- |
848+-- | *Example:*
849+-- | ```purescript
850+-- | inputObjectType "User"
851+-- | :?> inputField "name" Scalar.string
852+-- | .> "The name of the user"
853+-- | ```
854+infixl 6 withInputField as :?>
855+
726856-- | Take a bounded enum and infer an enum type from that value using it's show instance to
727857-- | represent the enum string. The show function cannot return values that are not valid GraphQL
728858-- | indentifier strings. For practical reasons this is not checked at compile time. Please refer to