~theo/gql

5e0bcdd2179d76afaeb5b124466f43578598ecf9 — Theodor Thornhill 8 months ago 2cfe747
Add first introspection functionality

We can now query for __typename
4 files changed, 98 insertions(+), 7 deletions(-)

M gql-tests.asd
M src/execution.lisp
M src/utils.lisp
A t/introspection-tests.lisp
M gql-tests.asd => gql-tests.asd +2 -1
@@ 15,5 15,6 @@
                 (:file "regression-tests")
                 (:file "type-extension-tests")
                 (:file "validation-tests")
                 (:file "execution-tests"))))
                 (:file "execution-tests")
                 (:file "introspection-tests"))))
  :perform (test-op (o c) (symbol-call :rove '#:run :gql-tests :style :dot)))

M src/execution.lisp => src/execution.lisp +7 -3
@@ 143,10 143,14 @@
  (let ((results (make-hash-table :test #'equal)))
    (maphash
     (lambda (response-key fields)
       (with-slots (ty) (get-field-definition (car fields) object-type)
         (when ty
       (let* ((field-definition (get-field-definition (car fields) object-type results)))
         (unless (stringp field-definition)
           (setf (gethash response-key results)
                 (execute-field object-type object-value ty fields variable-values)))))
                 (execute-field object-type
                                object-value
                                (ty field-definition)
                                fields
                                variable-values)))))
     (collect-fields object-type selection-set variable-values))
    results))


M src/utils.lisp => src/utils.lisp +7 -3
@@ 106,10 106,14 @@ documents."
          (*all-types* (all-types)))
     ,@body))

(defun get-field-definition (field object-type)
(defun get-field-definition (field object-type &optional results)
  (let ((field-name (name-or-alias field)))
    (find-if (lambda (obj) (string= (nameof obj) field-name))
             (fields (gethash (nameof object-type) *all-types*)))))
    (if (string= "__typename" field-name)
        ;; TODO: Is it enough just to set name here?  Do we get interfaces and
        ;; such things?
        (and results (setf (gethash "__typename" results) (nameof object-type)))
        (find-if (lambda (obj) (string= (nameof obj) field-name))
                 (fields (gethash (nameof object-type) *all-types*))))))

(defclass gql-object ()
  ((type-name

A t/introspection-tests.lisp => t/introspection-tests.lisp +82 -0
@@ 0,0 1,82 @@
(in-package #:gql-tests)

(deftest introspection-test
  (testing "Getting __typename"
    (defclass pet (gql-object)
      ((name :initarg :name :accessor name)))

    (defclass dog (pet)
      ((owner :initarg :owner :accessor owner)
       (nickname :initarg :nickname :accessor nickname)))

    (defclass cat (pet)
      ((nickname :initarg :nickname :accessor nickname)))

    (defclass sentient (gql-object)
      ((name :initarg :name :accessor name)))

    (defclass human (sentient)
      ((pets :initarg :pets :accessor pets)))

    (let* ((doggo
             (make-instance
              'dog
              :name "Bingo-Bongo"
              :type-name "Dog"
              :nickname "Hund!"
              :owner (make-instance
                      'human
                      :name "Wingle Wangle"
                      :type-name "Human"
                      :pets `(,(make-instance
                                'dog
                                :name "Bingo-Bongo"
                                :nickname "Hund!"
                                :type-name "Dog")
                              ,(make-instance
                                'cat
                                :name "Bango-Wango"
                                :nickname "Mjausig"
                                :type-name "Cat")))))
           (query-resolvers
             (make-resolvers
               ("dog"      . (constantly doggo))))

           (dog-resolvers
             (make-resolvers
               ("name"     . 'name)
               ("nickname" . 'nickname)
               ("owner"    . 'owner)))

           (cat-resolvers
             (make-resolvers
               ("name"     . 'name)
               ("nickname" . 'nickname)
               ("owner"    . 'owner)))

           (human-resolvers
             (make-resolvers
               ("name"     . 'name)
               ("pets"     . 'pets)))

           (*resolvers*
             (make-resolvers
               ("Query"    . query-resolvers)
               ("Dog"      . dog-resolvers)
               ("Cat"      . cat-resolvers)
               ("Human"    . human-resolvers))))

      (flet ((doggo-test (query)
               (with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
                 (let* ((res (gql::execute (build-schema query) nil (make-hash-table :test #'equal) nil)))
                   (format nil "~a" (cl-json:encode-json-to-string res))))))

        (ok (string=
             (doggo-test "query { dog { __typename name owner { name } } }")
             "{\"data\":{\"dog\":{\"__typename\":\"Dog\",\"name\":\"Bingo-Bongo\",\"owner\":{\"name\":\"Wingle Wangle\"}}}}"))
        (ok (string=
             (doggo-test "query { dog { name owner { __typename name } } }")
             "{\"data\":{\"dog\":{\"name\":\"Bingo-Bongo\",\"owner\":{\"__typename\":\"Human\",\"name\":\"Wingle Wangle\"}}}}"))
        (ok (string=
             (doggo-test "query { dog { __typename name owner { __typename name } } }")
             "{\"data\":{\"dog\":{\"__typename\":\"Dog\",\"name\":\"Bingo-Bongo\",\"owner\":{\"__typename\":\"Human\",\"name\":\"Wingle Wangle\"}}}}"))))))