# HG changeset patch
# User Theodor Thornhill <theo@thornhill.no>
# Date 1639122664 -3600
#      Fri Dec 10 08:51:04 2021 +0100
# Node ID 71aeaf4e451722013efa3d1159c43ac17690a850
# Parent  fa0455e16e832b477d926e071915796aa23f02be
Add first introspection functionality

We can now query for __typename

diff --git a/gql-tests.asd b/gql-tests.asd
--- a/gql-tests.asd
+++ b/gql-tests.asd
@@ -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)))
diff --git a/src/execution.lisp b/src/execution.lisp
--- a/src/execution.lisp
+++ b/src/execution.lisp
@@ -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))
 
diff --git a/src/utils.lisp b/src/utils.lisp
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -106,10 +106,14 @@
           (*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
diff --git a/t/introspection-tests.lisp b/t/introspection-tests.lisp
new file mode 100644
--- /dev/null
+++ b/t/introspection-tests.lisp
@@ -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\"}}}}"))))))