M example/example2.lisp +7 -6
@@ 42,7 42,7 @@
:description "A Dog is a dog!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "nickname"
:type (gql::named "String"))
,(gql::field :name "barkVolume"
@@ 58,7 58,7 @@
:description "A Human is a human!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "pets"
:type (gql::list-type (gql::non-null-type (gql::named "Pet")))))))
@@ 69,13 69,14 @@
;; (format t "~%~a" (cl-json:encode-json-to-string res)))))
(defun example2 (query)
- (with-schema (gql::make-schema :query *query* :types (list *dog* *human*))
- (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
+ (with-context (:schema (gql::make-schema :query *query* :types (list *dog* *human*))
+ :document (build-document query))
+ (let* ((res (gql::execute)))
(format t "~%~a" (cl-json:encode-json-to-string res)))))
;; (example2 "{ __schema { types { name ofType { name } } } }")
-;; (example2 "{ __type(name: \"Dog\") { name fields { name type { name } } } }")
+(example2 "{ __type(name: \"Dog\") { name fields { name type { name } } } }")
;; (example2 "query { dog { name owner { name pets { name } } } }")
-(example2 "query { dog { name owner { name } } }")
+;; (example2 "query { dog { name owner { name } } }")
;; (example2 "query { dog { name owner: wingle { name pets: dogs { name } } } }")
M src/execution.lisp +28 -34
@@ 4,7 4,7 @@
(defun fragment-type-applies-p (object-type fragment-type)
;; TODO: https://spec.graphql.org/draft/#DoesFragmentTypeApply()
- (let ((type-definition (gethash object-type (type-map *schema*))))
+ (let ((type-definition (gethash object-type (type-map (schema *context*)))))
(typecase type-definition
(object-type-definition
(string= (nameof type-definition)
@@ 77,7 77,7 @@
;; TODO: https://spec.graphql.org/draft/#IsInputType()
(if (typep (kind type) 'wrapper-type)
(input-type-p (ty type))
- (let ((possible-type (gethash (nameof type) (type-map *schema*))))
+ (let ((possible-type (gethash (nameof type) (type-map (schema *context*)))))
(if possible-type
(typep (kind possible-type) 'input-types)
(typep (nameof type) 'built-in-scalar)))))
@@ 86,7 86,7 @@
;; TODO: https://spec.graphql.org/draft/#IsOutputType()
(if (typep (kind type) 'wrapper-type)
(output-type-p (ty type))
- (let ((possible-type (gethash (nameof type) (type-map *schema*))))
+ (let ((possible-type (gethash (nameof type) (type-map (schema *context*)))))
(if possible-type
(typep (kind possible-type) 'output-types)
(typep (nameof type) 'built-in-scalar)))))
@@ 94,7 94,7 @@
(declaim (ftype (function (operation-definition hash-table t) hash-table) execute-query))
(defun execute-query (query variable-values initial-value)
;; TODO: https://spec.graphql.org/draft/#sec-Query
- (let ((query-type (query-type *schema*)))
+ (let ((query-type (query-type (schema *context*))))
(check-type query-type object-type-definition)
(with-slots (selection-set) query
(setf (gethash "data" *result*)
@@ 108,7 108,7 @@
(declaim (ftype (function (operation-definition hash-table t) hash-table) execute-mutation))
(defun execute-mutation (mutation variable-values initial-value)
;; TODO: https://spec.graphql.org/draft/#ExecuteMutation()
- (let ((mutation-type (gethash "Mutation" *all-types*)))
+ (let ((mutation-type (mutation-type (schema *context*))))
(check-type mutation-type object-type-definition)
(with-slots (selection-set) mutation
(setf (gethash "data" *result*)
@@ 187,18 187,10 @@
(defun resolve-field-value ()
;; TODO: https://spec.graphql.org/draft/#ResolveFieldValue()
- ;;
- ;; This function should access the hash table *resolvers* created by the
- ;; implementors of the api. It is good form to make sure that all the fields
- ;; are covered.
-
- ;; (unless (resolver field-definition)
- ;; (gql-error "Woops, we need a resolver for ~a" (nameof field-definition)))
- (if (resolver (field-definition *execution-context*))
- ;; (funcall (resolver field-definition) object-value arg-values)
- (funcall (resolver (field-definition *execution-context*)))
- ;; (resolve object-type object-value field-name arg-values)
- ))
+ (declare (optimize (debug 3)))
+ (let ((c *context*))
+ (when (resolver (field-definition (execution-context c)))
+ (funcall (resolver (field-definition (execution-context *context*)))))))
(defun complete-value (field-type fields result variable-values)
@@ 220,7 212,7 @@
result)))
;; TODO: We don't handle nil/null/'null yet
(named-type
- (let ((type-definition (gethash (nameof field-type) (type-map *schema*)))) ;; TODO: #32
+ (let ((type-definition (gethash (nameof field-type) (type-map (schema *context*))))) ;; TODO: #32
;; TODO: Maybe check for presentness rather than nil?
(if (typep (nameof field-type) 'built-in-scalar)
(coerce-result field-type result)
@@ 282,24 274,24 @@
(check-type object-value gql-object)
(with-slots (type-name) object-value
(etypecase abstract-type
- (interface-type-definition (gethash type-name (type-map *schema*)))
+ (interface-type-definition (gethash type-name (type-map (schema *context*))))
(union-type-definition
(let ((union-member (gethash type-name (union-members abstract-type))))
- (gethash (nameof union-member) (type-map *schema*)))))))
+ (gethash (nameof union-member) (type-map (schema *context*))))))))
(defun execute-field (object-type object-value field-definition fields variable-values)
;; TODO: https://spec.graphql.org/draft/#sec-Executing-Fields
(let* ((field (car fields))
(field-name (name-or-alias field)) ;; TODO: Is nameof correct here??
- (arg-values (coerce-argument-values object-type field variable-values))
- (*execution-context* (make-instance 'execution-context
- :object-type object-type
- :object-value object-value
- :field-definition field-definition
- :field-name field-name
- :arg-values arg-values))
- (resolved-value (resolve-field-value)))
- (complete-value (ty field-definition) fields resolved-value variable-values)))
+ (arg-values (coerce-argument-values object-type field variable-values)))
+ (setf (execution-context *context*)
+ (make-instance 'execution-context
+ :object-type object-type
+ :object-value object-value
+ :field-definition field-definition
+ :field-name field-name
+ :arg-values arg-values))
+ (complete-value (ty field-definition) fields (resolve-field-value) variable-values)))
(declaim (ftype (function (operation-definition hash-table) hash-table) coerce-vars))
(defun coerce-vars (operation variable-values)
@@ 328,10 320,10 @@
(coerce-result var-type val)))))))
:finally (return coerced-vars))))
-(defun execute-request (document operation-name variable-values initial-value)
+(defun execute-request (operation-name initial-value)
;; https://spec.graphql.org/draft/#sec-Executing-Requests
- (let* ((operation (get-operation document operation-name))
- (coerced-vars (coerce-vars operation variable-values)))
+ (let* ((operation (get-operation (document *context*) operation-name))
+ (coerced-vars (coerce-vars operation (variables *context*))))
(string-case (operation-type operation)
("Query" (execute-query operation coerced-vars initial-value))
("Mutation" (execute-mutation operation coerced-vars initial-value))
@@ 369,12 361,14 @@
:do (push selection selection-set))
:finally (return (nreverse selection-set))))
-(defun execute (document operation-name variable-values initial-value)
+(defun execute (&optional operation-name initial-value)
(let ((*result* (make-hash-table :test #'equal))
(*errors* nil))
;; TODO: We can't really validate yet
;; (validate document)
+ (unless (document *context*)
+ (gql-error "We need a document to execute"))
(if *errors*
(setf (gethash "errors" *result*) *errors*)
- (execute-request document operation-name variable-values initial-value))
+ (execute-request operation-name initial-value))
*result*))
M src/gql.lisp +1 -1
@@ 35,5 35,5 @@ This is a simple helper to create a pars
(parse 'document)))
(:method ((types list))
(make-instance 'document :definitions types))
- (:documentation "Build a GraphQL schema.
+ (:documentation "Build a GraphQL document.
This is a simple helper to create a parsed document."))
M src/introspection.lisp +46 -41
@@ 6,7 6,7 @@
:fields `(,(field :name "description"
:description "A description of the current schema."
:type (named "String")
- :resolver (lambda () (description *schema*)))
+ :resolver (lambda () (description (schema *context*))))
,(field :name "types"
:description "A list of all types supported by this server."
:type (non-null-type (list-type (non-null-type (named "__Type"))))
@@ 15,23 15,23 @@
(maphash (lambda (k v)
(unless (uiop:string-prefix-p "__" k)
(push v types)))
- (type-map *schema*))
+ (type-map (schema *context*)))
types)))
,(field :name "queryType"
:description "The type that query operations will be rooted at."
:type (non-null-type (named "__Type"))
- :resolver (lambda () (query-type *schema*)))
+ :resolver (lambda () (query-type (schema *context*))))
,(field :name "mutationType"
:description "If this server supports mutation, the type that mutation operations will be rooted at."
:type (named "__Type")
- :resolver (lambda () (mutation-type *schema*)))
+ :resolver (lambda () (mutation-type (schema *context*))))
,(field :name "subscriptionType"
:description "If this server supports subscription, the type that subscription operations will be rooted at."
:type (named "__Type")
- :resolver (lambda () (subscription-type *schema*)))
+ :resolver (lambda () (subscription-type (schema *context*))))
,(field :name "directives"
:type (non-null-type (list-type (non-null-type "__Directive")))
- :resolver (lambda () (directives *schema*))))))
+ :resolver (lambda () (directives (schema *context*)))))))
(defvar *__type*
(object :name "__Type"
@@ 39,13 39,18 @@
:type (non-null-type "__TypeKind"))
,(field :name "name"
:type (named "String")
- :resolver (lambda () (name (object-value *execution-context*))))
+ :resolver (lambda () (name (object-value (execution-context *context*)))))
,(field :name "description"
:type (named "String")
- :resolver (lambda () (description (object-value *execution-context*))))
+ :resolver (lambda () (description (object-value (execution-context *context*)))))
,(field :name "fields"
:type (list-type (non-null-type (named "__Field")))
- :resolver (lambda () (fields (object-value *execution-context*))))
+ :resolver (lambda ()
+ (let ((fields nil))
+ (maphash (lambda (k v) (declare (ignore k))
+ (push v fields))
+ (fields (object-value (execution-context *context*))))
+ fields)))
,(field :name "interfaces"
:type (list-type (non-null-type (named "__Type"))))
,(field :name "possibleTypes"
@@ 64,28 69,28 @@
(defvar *__type-kind*
(enum :name "__TypeKind"
:description "An enum describing what kind of type a given `__Type` is"
- :enum-values `(,(enum-val :value "SCALAR")
- ,(enum-val :value "OBJECT")
- ,(enum-val :value "INTERFACE")
- ,(enum-val :value "UNION")
- ,(enum-val :value "ENUM")
- ,(enum-val :value "INPUT_OBJECT")
- ,(enum-val :value "LIST")
- ,(enum-val :value "NON_NULL"))))
+ :enum-values `(,(enum-val :enum-value "SCALAR")
+ ,(enum-val :enum-value "OBJECT")
+ ,(enum-val :enum-value "INTERFACE")
+ ,(enum-val :enum-value "UNION")
+ ,(enum-val :enum-value "ENUM")
+ ,(enum-val :enum-value "INPUT_OBJECT")
+ ,(enum-val :enum-value "LIST")
+ ,(enum-val :enum-value "NON_NULL"))))
(defvar *__field*
(object :name "__Field"
:description "Object and Interface types are described by a list of Fields, each of which has a name, potentially a list of arguments, and a return type."
:fields `(,(field :name "name"
:type (non-null-type (named "String"))
- :resolver (lambda () (name (object-value *execution-context*))))
+ :resolver (lambda () (name (object-value (execution-context *context*)))))
,(field :name "description"
:type (named "String"))
,(field :name "args"
:type (non-null-type (list-type (non-null-type (named "__InputValue")))))
,(field :name "type"
:type (non-null-type (named "__Type"))
- :resolver (lambda () (ty (object-value *execution-context*))))
+ :resolver (lambda () (ty (object-value (execution-context *context*)))))
,(field :name "isDeprecated"
:type (non-null-type (named "Boolean")))
,(field :name "deprecationReason"
@@ 126,31 131,31 @@
(defvar *__directive-location*
(enum :name "__DirectiveLocation"
- :enum-values `(,(enum-val :value "QUERY")
- ,(enum-val :value "MUTATION")
- ,(enum-val :value "SUBSCRIPTION")
- ,(enum-val :value "FIELD")
- ,(enum-val :value "FRAGMENT_DEFINITION")
- ,(enum-val :value "FRAGMENT_SPREAD")
- ,(enum-val :value "INLINE_FRAGMENT")
- ,(enum-val :value "SCHEMA")
- ,(enum-val :value "SCALAR")
- ,(enum-val :value "OBJECT")
- ,(enum-val :value "FIELD_DEFINITION")
- ,(enum-val :value "ARGUMENT_DEFINITION")
- ,(enum-val :value "INTERFACE")
- ,(enum-val :value "UNION")
- ,(enum-val :value "ENUM")
- ,(enum-val :value "ENUM_VALUE")
- ,(enum-val :value "INPUT_OBJECT")
- ,(enum-val :value "INPUT_FIELD_DEFINITION"))))
+ :enum-values `(,(enum-val :enum-value "QUERY")
+ ,(enum-val :enum-value "MUTATION")
+ ,(enum-val :enum-value "SUBSCRIPTION")
+ ,(enum-val :enum-value "FIELD")
+ ,(enum-val :enum-value "FRAGMENT_DEFINITION")
+ ,(enum-val :enum-value "FRAGMENT_SPREAD")
+ ,(enum-val :enum-value "INLINE_FRAGMENT")
+ ,(enum-val :enum-value "SCHEMA")
+ ,(enum-val :enum-value "SCALAR")
+ ,(enum-val :enum-value "OBJECT")
+ ,(enum-val :enum-value "FIELD_DEFINITION")
+ ,(enum-val :enum-value "ARGUMENT_DEFINITION")
+ ,(enum-val :enum-value "INTERFACE")
+ ,(enum-val :enum-value "UNION")
+ ,(enum-val :enum-value "ENUM")
+ ,(enum-val :enum-value "ENUM_VALUE")
+ ,(enum-val :enum-value "INPUT_OBJECT")
+ ,(enum-val :enum-value "INPUT_FIELD_DEFINITION"))))
(defvar *__schema-field-definition*
(field :description "Request the schema information."
:name "__schema"
:args nil
:type (non-null-type (named "__Schema"))
- :resolver (lambda () *schema*)))
+ :resolver (lambda () (schema *context*))))
(defvar *__type-field-definition*
(field :description "Request the type information of a single type."
@@ 161,13 166,13 @@
:ty (non-null-type (named "String"))))
:type (named "__Type")
:resolver (lambda ()
- (let* ((args (arg-values *execution-context*))
+ (let* ((args (arg-values (execution-context *context*)))
(name (gethash "name" args)))
- (gethash name (type-map *schema*))))))
+ (gethash name (type-map (schema *context*)))))))
(defvar *__typename-field-definition*
(field :description "The name of the current Object type at runtime."
:name "__typename"
:args nil
:type (non-null-type (named "String"))
- :resolver (lambda () (name (object-type *execution-context*)))))
+ :resolver (lambda () (name (object-type (execution-context *context*))))))
M src/package.lisp +2 -2
@@ 5,10 5,10 @@
(:export
#:gql
#:build-schema
+ #:build-document
#:generate
- #:with-schema
+ #:with-context
#:execute
- #:*resolvers*
#:resolve
#:bool
#:true
M src/specials.lisp +7 -5
@@ 20,19 20,21 @@ being set to an instance of GQL:TOKEN.")
Note: This is probably not a really good way to do things, as we need to
ensure we have initialized the schema.")
-(defvar *all-types* nil
- "Hash-table containing all types from schema *SCHEMA*.
-Should be bound together with *schema* when needed.")
-
(defvar *result* nil
"Hash table to contain the results of an execution.")
(defvar *errors* nil
"Errors to be returned to client after validation and execution.")
-(defvar *resolvers* nil
+(defvar *context* nil
"Hash table to store the resolvers corresponding to the schema")
+(defclass context ()
+ ((schema :initarg :schema :accessor schema)
+ (document :initarg :document :accessor document)
+ (variables :initarg :variables :accessor variables)
+ (execution-context :initarg :execution-context :accessor execution-context)))
+
(defclass execution-context ()
((object-type :initarg :object-type :accessor object-type)
(object-value :initarg :object-value :accessor object-value)
M src/utils.lisp +29 -32
@@ 25,7 25,7 @@
(maphash (lambda (k v)
(when (equal (kind v) 'fragment-definition)
(setf (gethash k table) v)))
- (type-map *schema*))
+ (type-map (schema *context*)))
table))
(defun get-types (node document)
@@ 41,28 41,6 @@
;; TODO: In this case we are probably an anonymous operation-definition
(setf (gethash (operation-type node) node-table) node))))))
-(defun all-types ()
- "Get all user defined types within a schema."
- (unless *schema*
- (gql-error "Schema not bound, cannot get all-types. Consider your options."))
- (with-slots (definitions) *schema*
- (let ((node-table (make-hash-table :test #'equal))
- (nodes
- (remove-if-not
- (lambda (x)
- (let ((kind (kind x)))
- (or
- (eq kind 'scalar-type-definition)
- (eq kind 'object-type-definition)
- (eq kind 'interface-type-definition)
- (eq kind 'union-type-definition)
- (eq kind 'enum-type-definition)
- (eq kind 'input-object-type-definition))))
- definitions)))
- (dolist (node nodes node-table)
- (with-slots (name) node
- (setf (gethash (name name) node-table) node))))))
-
(defclass* errors
message
locations
@@ 99,10 77,32 @@
(defun nameof (type)
(name (name type)))
+(defun make-context (&key schema document execution-context)
+ (make-instance 'context
+ :schema schema
+ :document document
+ :execution-context execution-context))
+
(defmacro with-schema (schema &body body)
- `(let* ((*schema* ,schema))
+ `(let ((*schema* ,schema))
,@body))
+(defmacro with-context ((&key schema document variables execution-context) &body body)
+ (let ((s (gensym))
+ (d (gensym))
+ (v (gensym))
+ (e (gensym)))
+ `(let* ((,s ,schema)
+ (,d ,document)
+ (,v (or ,variables ,(make-hash-table :test #'equal)))
+ (,e ,execution-context)
+ (*context* (make-instance 'context
+ :schema ,s
+ :document ,d
+ :variables ,v
+ :execution-context ,e)))
+ ,@body)))
+
(defun get-field-definition (field object-type)
(declare (optimize (debug 3)))
(let ((field-name (name-or-alias field)))
@@ 110,7 110,7 @@
((string= "__schema" field-name) *__schema-field-definition*)
((string= "__type" field-name) *__type-field-definition*)
(t
- (let ((object (gethash (nameof object-type) (type-map *schema*))))
+ (let ((object (gethash (nameof object-type) (type-map (schema *context*)))))
(gethash field-name (fields object)))))))
(defclass gql-object ()
@@ 188,16 188,13 @@
:description description
:name (make-name name)))
-(defun enum-val (&key value)
- (make-instance 'enum-value
+(defun enum-val (&key enum-value)
+ (make-instance 'enum-value-definition
:kind 'enum-value
- :value value))
+ :enum-value enum-value))
(defun set-resolver (type-name field-name fn)
(declare (optimize (debug 3)))
(let ((field-definition
- (gethash field-name (fields (gethash type-name (type-map *schema*))))
- ;; (find-if (lambda (f) (string= (nameof f) field-name))
- ;; )
- ))
+ (gethash field-name (fields (gethash type-name (type-map (schema *context*)))))))
(setf (resolver field-definition) fn)))
M t/execution-tests.lisp +86 -96
@@ 5,7 5,7 @@
(let* ((definitions (gql::definitions
(build-schema "{ a { subfield1 } ...ExampleFragment } fragment ExampleFragment on Query { a { subfield2 } b }")))
(query-type (gql::object :name "Query")))
- (with-schema (gql::make-schema :query query-type :types (cdr definitions))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types (cdr definitions)))
(let* ((operation (find-if (lambda (x) (string= (gql::operation-type x) "Query")) definitions))
(operation-type (gql::operation-type operation))
(selection-set (gql::selection-set operation))
@@ 30,12 30,13 @@
(testing "merge-selection-sets should merge multiple fields"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)
+ :document (build-schema "query { dog { name } dog { owner { name } } }"))
(gql::set-resolver "Human" "name" (lambda () "Bingo-bongo-pappa"))
(gql::set-resolver "Dog" "name" (lambda () "Bingo-bongo"))
(gql::set-resolver "Dog" "owner" (lambda () t))
(gql::set-resolver "Query" "dog" (lambda () t))
- (let* ((res (gql::execute (build-schema "query { dog { name } dog { owner { name } } }") nil (make-hash-table) nil))
+ (let* ((res (gql::execute nil nil))
(data (gethash "data" res))
(dog-res (gethash "dog" data)))
(ok (typep res 'hash-table))
@@ 46,12 47,13 @@
(testing "A query should handle alias"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)
+ :document (build-schema "query { dog { name owner { name: nameAlias } } }"))
(gql::set-resolver "Human" "name" (lambda () "Bingo-bongo-pappa"))
(gql::set-resolver "Dog" "name" (lambda () "Bingo-bongo"))
(gql::set-resolver "Dog" "owner" (lambda () t))
(gql::set-resolver "Query" "dog" (lambda () t))
- (let* ((res (gql::execute (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
+ (let* ((res (gql::execute nil nil))
(data (gethash "data" res))
(dog-res (gethash "dog" data)))
(ok (typep res 'hash-table))
@@ 62,24 64,20 @@
(testing "A query should handle variables and arguments"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((variable-values (make-hash-table :test #'equal)))
- (setf (gethash "sit" variable-values) "SIT")
- (gql::set-resolver "Dog" "name" (lambda () "Bingo-bongo"))
- (gql::set-resolver "Dog" "doesKnowCommand"
- (lambda ()
- (if (string= (gethash "dogCommand" (gql::arg-values gql::*execution-context* )) "SIT")
- 'true 'false)))
- (gql::set-resolver "Query" "dog" (lambda () t))
- (let* ((res (gql::execute
- (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
- nil
- variable-values
- nil))
- (data (gethash "data" res))
- (dog (gethash "dog" data))
- (command (gethash "doesKnowCommand" dog)))
- (ok (string= command "true")))))))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)
+ :document (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }"))
+ (setf (gethash "sit" (gql::variables gql::*context*)) "SIT")
+ (gql::set-resolver "Dog" "name" (lambda () "Bingo-bongo"))
+ (gql::set-resolver "Dog" "doesKnowCommand"
+ (lambda ()
+ (if (string= (gethash "dogCommand" (gql::arg-values (gql::execution-context gql::*context*) )) "SIT")
+ 'true 'false)))
+ (gql::set-resolver "Query" "dog" (lambda () t))
+ (let* ((res (gql::execute nil nil))
+ (data (gethash "data" res))
+ (dog (gethash "dog" data))
+ (command (gethash "doesKnowCommand" dog)))
+ (ok (string= command "true"))))))
(testing "Result coercing"
(flet ((named-type (name)
(make-instance 'gql::named-type
@@ 111,20 109,21 @@
(testing "Using resolvers that access the object from the 'db'"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)
+ :document (build-schema "query { dog { name } }"))
(gql::defclass* dog name owner)
(gql::set-resolver "Dog" "name"
- (lambda () (name (gql::object-value gql::*execution-context*))))
+ (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
(gql::set-resolver "Dog" "owner" (lambda () t))
(gql::set-resolver "Query" "dog" (lambda () (make-instance 'dog :name "Bingo-bongo")))
- (let* ((res (gql::execute
- (build-schema "query { dog { name } }") nil (make-hash-table) nil))
+ (let* ((res (gql::execute nil nil))
(data (gethash "data" res))
(dog (gethash "dog" data))
(name (gethash "name" dog)))
(ok (string= name "Bingo-bongo")))
- (let* ((res (gql::execute
- (build-schema "query { dog { name: bongo } }") nil (make-hash-table) nil))
+ (setf (gql::document gql::*context*)
+ (build-schema "query { dog { name: bongo } }"))
+ (let* ((res (gql::execute nil nil))
(data (gethash "data" res))
(dog (gethash "dog" data))
(name (gethash "bongo" dog)))
@@ 132,60 131,50 @@
(testing "A query should handle variables and arguments"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((variable-values (make-hash-table :test #'equal)))
- (gql::defclass* dog name does-know-command)
- (setf (gethash "sit" variable-values) "SIT")
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
+ (gql::defclass* dog name does-know-command)
+ (setf (gethash "sit" (gql::variables gql::*context*)) "SIT")
- (gql::set-resolver "Dog" "name"
- (lambda () (name (gql::object-value gql::*execution-context*))))
- (gql::set-resolver "Dog" "doesKnowCommand"
- (lambda ()
- (with-slots (does-know-command) (gql::object-value gql::*execution-context*)
- (if (member (gethash "dogCommand" (gql::arg-values gql::*execution-context*)) does-know-command
- :test #'equal)
- 'true 'false))))
- (gql::set-resolver "Query" "dog" (lambda () (make-instance 'dog
- :name "Bingo-bongo"
- :does-know-command '("SIT" "DOWN" "HEEL"))))
- (let* ((res (gql::execute
- (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
- nil
- variable-values
- nil))
- (data (gethash "data" res))
- (dog (gethash "dog" data))
- (command (gethash "doesKnowCommand" dog)))
- (ok (string= command "true")))
- (setf (gethash "sit" variable-values) "SITT")
- (let* ((res (gql::execute
- (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
- nil
- variable-values
- nil))
- (data (gethash "data" res))
- (dog (gethash "dog" data))
- (command (gethash "doesKnowCommand" dog)))
- (ok (string= command "false")))
- ;; (setf (gethash "sit" variable-values) "SIT")
- ;; (let* ((res (gql::execute
- ;; (build-schema "query { dog { doesKnowCommand(dogCommand: \"SIT\") } }")
- ;; nil
- ;; variable-values
- ;; nil))
- ;; (data (gethash "data" res))
- ;; (dog (gethash "dog" data))
- ;; (command (gethash "doesKnowCommand" dog)))
- ;; (ok (string= command "true")))
- (let* ((res (gql::execute
- (build-schema "query { dog { doesKnowCommand(dogCommand: \"LOL\") } }")
- nil
- variable-values
- nil))
- (data (gethash "data" res))
- (dog (gethash "dog" data))
- (command (gethash "doesKnowCommand" dog)))
- (ok (string= command "false"))))))))
+ (gql::set-resolver "Dog" "name"
+ (lambda () (name (gql::object-value gql::*execution-context*))))
+ (gql::set-resolver "Dog" "doesKnowCommand"
+ (lambda ()
+ (with-slots (does-know-command) (gql::object-value (gql::execution-context gql::*context*))
+ (if (member (gethash "dogCommand" (gql::arg-values (gql::execution-context gql::*context*))) does-know-command
+ :test #'equal)
+ 'true 'false))))
+ (gql::set-resolver "Query" "dog" (lambda () (make-instance 'dog
+ :name "Bingo-bongo"
+ :does-know-command '("SIT" "DOWN" "HEEL"))))
+ (setf (gql::document gql::*context*) (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }"))
+ (let* ((res (gql::execute nil nil))
+ (data (gethash "data" res))
+ (dog (gethash "dog" data))
+ (command (gethash "doesKnowCommand" dog)))
+ (ok (string= command "true")))
+ (setf (gethash "sit" (gql::variables gql::*context*)) "SITT")
+ (setf (gql::document gql::*context*) (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }"))
+ (let* ((res (gql::execute nil nil))
+ (data (gethash "data" res))
+ (dog (gethash "dog" data))
+ (command (gethash "doesKnowCommand" dog)))
+ (ok (string= command "false")))
+ ;; (setf (gethash "sit" variable-values) "SIT")
+ ;; (let* ((res (gql::execute
+ ;; (build-schema "query { dog { doesKnowCommand(dogCommand: \"SIT\") } }")
+ ;; nil
+ ;; variable-values
+ ;; nil))
+ ;; (data (gethash "data" res))
+ ;; (dog (gethash "dog" data))
+ ;; (command (gethash "doesKnowCommand" dog)))
+ ;; (ok (string= command "true")))
+ (setf (gql::document gql::*context*) (build-schema "query { dog { doesKnowCommand(dogCommand: \"LOL\") } }"))
+ (let* ((res (gql::execute nil nil))
+ (data (gethash "data" res))
+ (dog (gethash "dog" data))
+ (command (gethash "doesKnowCommand" dog)))
+ (ok (string= command "false")))))))
(deftest abstract-type-resolvers
(testing "Getting object-type-definition from union or interface"
@@ 199,12 188,12 @@
(let* ((doggo (make-instance 'dog :name "Bingo-Bongo" :type-name "Dog"))
(definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
;; We want to know if we did get the actual same reference.
- (ok (eq (gql::resolve-abstract-type (gethash "CatOrDog" (gql::type-map gql::*schema*)) doggo)
- (gethash "Dog" (gql::type-map gql::*schema*))))
- (ok (eq (gql::resolve-abstract-type (gethash "Pet" (gql::type-map gql::*schema*)) doggo)
- (gethash "Dog" (gql::type-map gql::*schema*))))))))
+ (ok (eq (gql::resolve-abstract-type (gethash "CatOrDog" (gql::type-map (gql::schema gql::*context*))) doggo)
+ (gethash "Dog" (gql::type-map (gql::schema gql::*context*)))))
+ (ok (eq (gql::resolve-abstract-type (gethash "Pet" (gql::type-map (gql::schema gql::*context*))) doggo)
+ (gethash "Dog" (gql::type-map (gql::schema gql::*context*)))))))))
(deftest doggo-test
(testing "Doggo-testing"
@@ 257,25 246,25 @@
:description "A Pet is a pet!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*)))))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*))))))))
(human-type
(gql::object :name "Human"
:description "A Human is a human!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "pets"
:type (gql::list-type (gql::non-null-type (gql::named "Pet")))
- :resolver (lambda () (pets (gql::object-value gql::*execution-context*)))))))
+ :resolver (lambda () (pets (gql::object-value (gql::execution-context gql::*context*))))))))
(dog-type
(gql::object :name "Dog"
:description "A Dog is a dog!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "nickname"
:type (gql::named "String")
- :resolver (lambda () (nickname (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (nickname (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "owner"
:type (gql::named "Human")
:resolver (lambda () human)))))
@@ 284,14 273,15 @@
:description "A Cat is a cat!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "nickname"
:type (gql::named "String")
- :resolver (lambda () (nickname (gql::object-value gql::*execution-context*))))))))
+ :resolver (lambda () (nickname (gql::object-value (gql::execution-context gql::*context*)))))))))
(flet ((doggo-test (query)
- (with-schema (gql::make-schema :query query-type :types (list dog-type human-type cat-type pet-interface))
- (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types (list dog-type human-type cat-type pet-interface))
+ :document (build-schema query))
+ (let* ((res (gql::execute nil nil)))
(format nil "~a" (cl-json:encode-json-to-string res))))))
(ok (string=
M t/introspection-tests.lisp +5 -4
@@ 48,7 48,7 @@
:description "A Human is a human!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "pets"
:type (gql::list-type (gql::non-null-type (gql::named "Pet")))))))
(dog-type
@@ 56,7 56,7 @@
:description "A Dog is a dog!"
:fields `(,(gql::field :name "name"
:type (gql::named "String")
- :resolver (lambda () (name (gql::object-value gql::*execution-context*))))
+ :resolver (lambda () (name (gql::object-value (gql::execution-context gql::*context*)))))
,(gql::field :name "nickname"
:type (gql::named "String"))
,(gql::field :name "owner"
@@ 66,8 66,9 @@
:pets '())))))))
(flet ((doggo-test (query)
- (with-schema (gql::make-schema :query query-type :types (list dog-type human-type))
- (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types (list dog-type human-type))
+ :document (build-schema query))
+ (let* ((res (gql::execute nil nil)))
(format nil "~a" (cl-json:encode-json-to-string res))))))
(ok (string=
M t/type-system-tests.lisp +8 -8
@@ 128,8 128,8 @@ scalar Url
(testing "scalar"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((dog (gethash "Dog" (gql::type-map gql::*schema*))))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
+ (let ((dog (gethash "Dog" (gql::type-map (gql::schema gql::*context*)))))
(ok (gql::input-type-p (gql::ty (gethash "name" (gql::fields dog)))))
(ok (gql::input-type-p (gql::ty (gethash "nickname" (gql::fields dog)))))
(ok (gql::output-type-p (gql::ty (gethash "barkVolume" (gql::fields dog)))))
@@ 137,8 137,8 @@ scalar Url
(testing "union"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((human-or-alien (gethash "HumanOrAlien" (gql::type-map gql::*schema*))))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
+ (let ((human-or-alien (gethash "HumanOrAlien" (gql::type-map (gql::schema gql::*context*)))))
(ng (gql::input-type-p (gethash "Human" (gql::union-members human-or-alien))))
(ng (gql::input-type-p (gethash "Alien" (gql::union-members human-or-alien))))
(ok (gql::output-type-p (gethash "Human" (gql::union-members human-or-alien))))
@@ 146,8 146,8 @@ scalar Url
(testing "object"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((dog-or-human (gethash "DogOrHuman" (gql::type-map gql::*schema*))))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
+ (let ((dog-or-human (gethash "DogOrHuman" (gql::type-map (gql::schema gql::*context*)))))
(ng (gql::input-type-p (gethash "Dog" (gql::union-members dog-or-human))))
(ng (gql::input-type-p (gethash "Human" (gql::union-members dog-or-human))))
(ok (gql::output-type-p (gethash "Dog" (gql::union-members dog-or-human))))
@@ 155,7 155,7 @@ scalar Url
(testing "interface"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
- (with-schema (gql::make-schema :query query-type :types definitions)
- (let ((cat (gethash "Cat" (gql::type-map gql::*schema*))))
+ (gql::with-context (:schema (gql::make-schema :query query-type :types definitions))
+ (let ((cat (gethash "Cat" (gql::type-map (gql::schema gql::*context*)))))
(ng (gql::input-type-p (gethash "Pet" (gql::interfaces cat))))
(ok (gql::output-type-p (gethash "Pet" (gql::interfaces cat)))))))))
M t/utils.lisp +3 -3
@@ 41,9 41,9 @@
#p"t/test-files/validation-schema.graphql"))) ))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions))
(subscription-type (find-if (lambda (x) (string= (gql::nameof x) "Subscription")) definitions)))
- (with-schema (gql::make-schema :query query-type
- :subscription subscription-type
- :types definitions)
+ (with-context (:schema (gql::make-schema :query query-type
+ :subscription subscription-type
+ :types definitions))
(let ((gql::*errors* nil))
(gql::validate (build-schema input))