# HG changeset patch # User Theodor Thornhill # Date 1639687813 -3600 # Thu Dec 16 21:50:13 2021 +0100 # Node ID e499aa8028e7c55568a2c599e4e31ef388e40f90 # Parent 30d9d180a2c3a1148c09b26e36fc0e4b2d03184a Clean up context and errors a little diff --git a/src/execution.lisp b/src/execution.lisp --- a/src/execution.lisp +++ b/src/execution.lisp @@ -360,13 +360,13 @@ :finally (return (nreverse selection-set)))) (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 operation-name initial-value)) - *result*)) + (unless *context* + (gql-error "No context is set. This is really bad.")) + (unless (document *context*) + (gql-error "We need a document to execute")) + ;; TODO: We can't really validate yet + ;; (validate document) + (if *errors* + (setf (gethash "errors" *result*) *errors*) + (execute-request operation-name initial-value)) + *result*) diff --git a/src/rules.lisp b/src/rules.lisp --- a/src/rules.lisp +++ b/src/rules.lisp @@ -6,7 +6,7 @@ :for definition :in definitions :unless (or (eq (kind definition) 'operation-definition) (eq (kind definition) 'fragment-definition)) - :do (make-error "Each definition must be executable." definition))) + :do (push-error "Each definition must be executable." definition))) (defun operation-name-unique-p (definitions) ;; https://spec.graphql.org/draft/#sec-Operation-Name-Uniqueness @@ -21,7 +21,7 @@ (loop :for v :being :each :hash-value :of operations :when (> (length v) 1) - :do (make-error "Each operation must have a unique name." v)))) + :do (push-error "Each operation must have a unique name." v)))) (defun single-anonymous-operation-definition-p (definitions) ;; https://spec.graphql.org/draft/#sec-Anonymous-Operation-Definitions @@ -32,7 +32,7 @@ :when (null name-node) :do (push definition anonymous) (when (and (> (length definitions) 1) anonymous) - (make-error "An anonymous definition must be alone." definition) + (push-error "An anonymous definition must be alone." definition) (return)))) (defun subscription-operation-valid-p () @@ -46,6 +46,6 @@ (make-hash-table) nil) :unless (= (hash-table-count grouped-field-set) 1) - :do (make-error "A subscription must have exactly one entry." subscription) + :do (push-error "A subscription must have exactly one entry." subscription) :when (introspection-field-p grouped-field-set) - :do (make-error "Root field must not begin with \"__\" which is reserved by GraphQL introspection." subscription))) + :do (push-error "Root field must not begin with \"__\" which is reserved by GraphQL introspection." subscription))) diff --git a/src/utils.lisp b/src/utils.lisp --- a/src/utils.lisp +++ b/src/utils.lisp @@ -51,22 +51,24 @@ line column) -(defun make-error (message nodes) - (let ((node-list (if (listp nodes) nodes (list nodes)))) - (push (make-instance - 'errors - :message message - :locations (mapcar - (lambda (node) - (with-slots (line column) (start-token (location node)) - (make-instance - 'error-location - :line line - :column column))) - node-list) - :path nil - :extensions nil) - *errors*))) +(defun location-errors (nodes) + (mapcar + (lambda (node) + (with-slots (line column) (start-token (location node)) + (make-instance + 'error-location + :line line + :column column))) + nodes)) + +(defun push-error (message nodes) + (push (make-instance + 'errors + :message message + :locations (location-errors (if (listp nodes) nodes (list nodes))) + :path nil ;; TODO: We need the path + :extensions nil) ;; TODO: Do we need extensions? + *errors*)) (defun name-or-alias (field) (with-slots (alias name) field @@ -96,6 +98,8 @@ (,d ,document) (,v (or ,variables ,(make-hash-table :test #'equal))) (,e ,execution-context) + (*result* (make-hash-table :test #'equal)) + (*errors* nil) (*context* (make-instance 'context :schema ,s :document ,d 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"))) - (gql::with-context (:schema (gql::make-schema :query query-type :types (cdr definitions))) + (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,8 +30,8 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions) - :document (build-schema "query { dog { name } dog { owner { name } } }")) + (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)) @@ -47,8 +47,8 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions) - :document (build-schema "query { dog { name owner { name: nameAlias } } }")) + (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)) @@ -64,8 +64,8 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions) - :document (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")) + (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" @@ -109,8 +109,8 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions) - :document (build-schema "query { dog { name } }")) + (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 gql::*context*))))) @@ -131,7 +131,7 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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") @@ -188,7 +188,7 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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 gql::*context*))) doggo) (gethash "Dog" (gql::type-map (gql::schema gql::*context*))))) @@ -279,8 +279,8 @@ :resolver (lambda () (nickname (gql::object-value (gql::execution-context gql::*context*))))))))) (flet ((doggo-test (query) - (gql::with-context (:schema (gql::make-schema :query query-type :types (list dog-type human-type cat-type pet-interface)) - :document (build-schema query)) + (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)))))) diff --git a/t/introspection-tests.lisp b/t/introspection-tests.lisp --- a/t/introspection-tests.lisp +++ b/t/introspection-tests.lisp @@ -66,10 +66,10 @@ :pets '()))))))) (flet ((doggo-test (query) - (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)))))) + (with-context + (:schema (gql::make-schema :query query-type :types (list dog-type human-type)) + :document (build-schema query)) + (format nil "~a" (cl-json:encode-json-to-string (gql::execute nil nil)))))) (ok (string= (doggo-test "query { dog { __typename name owner { name } } }") 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,7 +128,7 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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))))) @@ -137,7 +137,7 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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)))) @@ -146,7 +146,7 @@ (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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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)))) @@ -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))) - (gql::with-context (:schema (gql::make-schema :query query-type :types definitions)) + (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)))))))))