M 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 +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 +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 +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\"}}}}"))))))