# HG changeset patch # User Theodor Thornhill # Date 1639578145 -3600 # Wed Dec 15 15:22:25 2021 +0100 # Node ID 19e576a569c51d6d83f653a4dd648e59db64f476 # Parent 3db33b44bdd233d6bc5f8468014ec1a5cc9f9a02 Add execution-context to the mix Let us throw a whole environment into the mix. diff --git a/example/example2.lisp b/example/example2.lisp --- a/example/example2.lisp +++ b/example/example2.lisp @@ -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 } } } }") diff --git a/src/execution.lisp b/src/execution.lisp --- a/src/execution.lisp +++ b/src/execution.lisp @@ -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*)) diff --git a/src/gql.lisp b/src/gql.lisp --- a/src/gql.lisp +++ b/src/gql.lisp @@ -35,5 +35,5 @@ (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.")) diff --git a/src/introspection.lisp b/src/introspection.lisp --- a/src/introspection.lisp +++ b/src/introspection.lisp @@ -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*)))))) diff --git a/src/package.lisp b/src/package.lisp --- a/src/package.lisp +++ b/src/package.lisp @@ -5,10 +5,10 @@ (:export #:gql #:build-schema + #:build-document #:generate - #:with-schema + #:with-context #:execute - #:*resolvers* #:resolve #:bool #:true diff --git a/src/specials.lisp b/src/specials.lisp --- a/src/specials.lisp +++ b/src/specials.lisp @@ -20,19 +20,21 @@ 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) diff --git a/src/utils.lisp b/src/utils.lisp --- a/src/utils.lisp +++ b/src/utils.lisp @@ -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))) diff --git a/t/execution-tests.lisp b/t/execution-tests.lisp --- a/t/execution-tests.lisp +++ b/t/execution-tests.lisp @@ -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= diff --git a/t/introspection-tests.lisp b/t/introspection-tests.lisp --- a/t/introspection-tests.lisp +++ b/t/introspection-tests.lisp @@ -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= diff --git a/t/type-system-tests.lisp b/t/type-system-tests.lisp --- a/t/type-system-tests.lisp +++ b/t/type-system-tests.lisp @@ -128,8 +128,8 @@ (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 @@ (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 @@ (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 @@ (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))))))))) diff --git a/t/utils.lisp b/t/utils.lisp --- a/t/utils.lisp +++ b/t/utils.lisp @@ -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))