6 files changed, 102 insertions(+), 67 deletions(-)

M example/example.lisp
M src/execution.lisp
M src/package.lisp
M src/specials.lisp
M t/execution-tests.lisp
M wiki/example1.md

@@ 6,16 6,20 @@
 
 (in-package :gql-exampleapp)
 
-(defparameter *fake-db* (make-hash-table :test #'equal))
-(setf (gethash "name" *fake-db*) "Theodor")
-(setf (gethash "age" *fake-db*) 31)
-
 (defvar *example-schema*
   (build-schema (asdf:system-relative-pathname 'gql "example/schema.graphql")))
 (defvar *variable-values* (make-hash-table :test #'equal))
 
-(defmethod resolve (object-type object-value field-name arg-values)
-  (gethash field-name *fake-db*))
+;; We make the hash table corresponding to the type in "example/schema.graphql"
+(defparameter *Query* (make-hash-table :test #'equal))
+
+;; The functions in here are to be used by the `resolve' internally in gql
+(setf (gethash "name" *Query*) (lambda () "Theodor Thornhill"))
+(setf (gethash "age" *Query*) (lambda () 31))
+
+;; Make sure that we actually set the resolver 
+(setf *resolvers* (make-hash-table :test #'equal))
+(setf (gethash "Query" *resolvers*) *Query*)
 
 (defvar *server* (make-instance 'hunchentoot:easy-acceptor :port 3000))
 

@@ 5,8 5,13 @@
 
 (defmethod resolve (object-type object-value field-name arg-values)
   (declare (ignorable object-type object-value field-name arg-values))
-  ;; TODO: This is obviously a bad idea, but something happened at least.
-  "Resolved")
+  ;; TODO: Ok, so now we get the corresponding type in the hash table, then
+  ;; funcall the function mapped to by field name.  We still need to handle
+  ;; arguments and such.  What should we use object-value for?
+  (let ((objtype (gethash (nameof object-type) *resolvers*)))
+    (if (> (hash-table-count arg-values) 0)
+        (funcall (gethash field-name objtype) arg-values)
+        (funcall (gethash field-name objtype)))))
 
 (defun sethash (item key table)
   ;; TODO: Do we need to check for present-ness if nil is just appendable?


@@ 154,7 159,6 @@
 
 (defun coerce-argument-values (object-type field variable-values)
   ;; TODO: https://spec.graphql.org/draft/#sec-Coercing-Field-Arguments
-  (declare (optimize (debug 3)))
   (loop
     :with coerced-values = (make-hash-table :test #'equal)
     :for argument-values = (arguments field)


@@ 187,21 191,21 @@
                ((eq (kind argument-value) 'var)
                 (setf (gethash argument-name coerced-values) value))
                (t
-                (let (;; TODO: Coerce the val first for the else part, find out
-                      ;; how.  Values are likely to be coerced to strings or
-                      ;; numbers.  I'm sensing nil/bool troubles here.
-                      (coerced-value value))
-                  (setf (gethash argument-name coerced-values) coerced-value)))))))
+                (setf (gethash argument-name coerced-values)
+                      (coerce-result argument-type value)))))))
     :finally (return coerced-values)))
 
 
 (defun resolve-field-value (object-type object-value field-name arg-values)
   ;; 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.
   (resolve object-type object-value field-name arg-values))
 
 (defun complete-value (field-type fields result variable-values)
   ;; TODO: https://spec.graphql.org/draft/#CompleteValue()
-  (declare (optimize (debug 3)))
   (when result
     (typecase field-type
       (non-null-type


@@ 295,23 299,21 @@
                 (cond
                   ((and (null val-p) default-value)
                    (setf (gethash var-name coerced-vars) default-value))
-                  ((and (eq (kind var-type) 'non-null-type)
+                  ((and (typep var-type 'non-null-type)
                         (or (null val-p) (null val)))
                    (gql-error "Need to raise a request error for coerce-vars"))
                   (val-p
                    (if (null val)
                        (setf (gethash var-name coerced-vars) nil)
-                       (let (;; TODO: Coerce the val first for the else part,
-                             ;; find out how.  Values are likely to be coerced
-                             ;; to strings or numbers.  I'm sensing nil/bool
-                             ;; troubles here.
-                             (coerced-value (format nil "~a" val)))
-                         (setf (gethash var-name coerced-vars) coerced-value)))))))
+                       ;; TODO: Handle the errors that can percolate up
+                       (setf (gethash var-name coerced-vars)
+                             (coerce-result var-type val)))))))
       :finally (return coerced-vars))))
 
 (defun execute-request (document operation-name variable-values initial-value)
   ;; https://spec.graphql.org/draft/#sec-Executing-Requests
-  (let* ((operation (get-operation document operation-name))
+  (let* ((*errors* nil)
+         (operation (get-operation document operation-name))
          (coerced-vars (coerce-vars operation variable-values)))
     (string-case (operation-type operation)
       ("Query"        (execute-query operation coerced-vars initial-value))

@@ 9,4 9,5 @@
    #:validate
    #:with-schema
    #:execute-request
+   #:*resolvers*
    #:resolve))

@@ 30,6 30,9 @@ Should be bound together with *schema* when needed.")
 (defvar *errors* nil
   "Errors to be returned to client after validation and execution.")
 
+(defvar *resolvers* nil
+  "Hash table to store the resolvers corresponding to the schema")
+
 (defun built-in-scalar-p (scalar)
   (member scalar '("Int" "Float" "String" "Boolean" "ID") :test #'string=))
 

@@ 27,38 27,60 @@
       (ok (gql::get-operation gql::*schema* "Mutation"))))
   (testing "merge-selection-sets should merge multiple fields"
     (with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
-      (let* ((res (gql::execute-request (build-schema "query { dog { name } dog { owner { name } } }") nil (make-hash-table) nil))
-             (data (gethash "data" res))
-             (dog-res (gethash "dog" data)))
-        (ok (typep res 'hash-table))
-        (ok (= (hash-table-count res) 2))
-        (ok (= (hash-table-count dog-res) 2))
-        (ok (gethash "name" dog-res))
-        (ok (gethash "owner" dog-res)))))
-  (testing "A query should handle alias"
-    (with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
-      (let* ((res (gql::execute-request (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
-             (data (gethash "data" res))
-             (dog-res (gethash "dog" data)))
-        (ok (typep res 'hash-table))
-        (ok (= (hash-table-count res) 2))
-        (ok (= (hash-table-count dog-res) 2))
-        (ok (gethash "name" dog-res))
-        (ok (gethash "owner" dog-res)))))
+      (let ((*resolvers* (make-hash-table :test #'equal))
+            (query-resolver (make-hash-table :test #'equal))
+            (dog-resolver (make-hash-table :test #'equal))
+            (human-resolver (make-hash-table :test #'equal)))
+        (setf (gethash "Query" *resolvers*) query-resolver)
+        (setf (gethash "Human" *resolvers*) human-resolver)
+        (setf (gethash "name" human-resolver) (lambda () "Bingo-bongo-pappa"))
+        (setf (gethash "Dog" *resolvers*) dog-resolver)
+        (setf (gethash "dog" query-resolver) (lambda () t))
+        (setf (gethash "name" dog-resolver) (lambda () "Bingo-bongo"))
+        (setf (gethash "owner" dog-resolver) (lambda () t))
+        (let* ((res (gql::execute-request (build-schema "query { dog { name } dog { owner { name } } }") nil (make-hash-table) nil))
+               (data (gethash "data" res))
+               (dog-res (gethash "dog" data)))
+          (ok (typep res 'hash-table))
+          (ok (= (hash-table-count res) 2))
+          (ok (= (hash-table-count dog-res) 2))
+          (ok (gethash "name" dog-res))
+          (ok (gethash "owner" dog-res))))))
   (testing "A query should handle alias"
     (with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
-      (let* ((res (gql::execute-request (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
-             (data (gethash "data" res))
-             (dog-res (gethash "dog" data)))
-        (ok (typep res 'hash-table))
-        (ok (= (hash-table-count res) 2))
-        (ok (= (hash-table-count dog-res) 2))
-        (ok (gethash "name" dog-res))
-        (ok (gethash "owner" dog-res)))))
+      (let* ((*resolvers* (make-hash-table :test #'equal))
+             (query-resolver (make-hash-table :test #'equal))
+             (dog-resolver (make-hash-table :test #'equal))
+             (human-resolver (make-hash-table :test #'equal)))
+        (setf (gethash "Query" *resolvers*) query-resolver)
+        (setf (gethash "Human" *resolvers*) human-resolver)
+        (setf (gethash "name" human-resolver) (lambda () "Bingo-bongo-pappa"))
+        (setf (gethash "Dog" *resolvers*) dog-resolver)
+        (setf (gethash "dog" query-resolver) (lambda () t))
+        (setf (gethash "name" dog-resolver) (lambda () "Bingo-bongo"))
+        (setf (gethash "owner" dog-resolver) (lambda () t))
+        (let* ((res (gql::execute-request (build-schema "query { dog { name owner { name: nameAlias } } }") nil (make-hash-table) nil))
+               (data (gethash "data" res))
+               (dog-res (gethash "dog" data)))
+          (ok (typep res 'hash-table))
+          (ok (= (hash-table-count res) 2))
+          (ok (= (hash-table-count dog-res) 2))
+          (ok (gethash "name" dog-res))
+          (ok (gethash "owner" dog-res))))))
   (testing "A query should handle variables and arguments"
     (with-schema (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))
-      (let ((variable-values (make-hash-table :test #'equal)))
+      (let ((variable-values (make-hash-table :test #'equal))
+            (query-resolver (make-hash-table :test #'equal))
+            (dog-resolver (make-hash-table :test #'equal))
+            (*resolvers* (make-hash-table :test #'equal)))
         (setf (gethash "sit" variable-values) "SIT")
+        (setf (gethash "Query" *resolvers*) query-resolver)
+        (setf (gethash "Dog" *resolvers*) dog-resolver)
+        (setf (gethash "dog" query-resolver)
+              (lambda () t))
+        (setf (gethash "doesKnowCommand" dog-resolver)
+              (lambda (args)
+                (string= (gethash "dogCommand" args) "SIT")))
         (let* ((res (gql::execute-request
                      (build-schema "query x($sit: String) { dog { doesKnowCommand(dogCommand: $sit) } }")
                      nil


@@ 67,7 89,7 @@
                (data (gethash "data" res))
                (dog (gethash "dog" data))
                (command (gethash "doesKnowCommand" dog)))
-          (ok (string= command "Field error for string"))))))
+          (ok (= command 1))))))
   (testing "Result coercing"
     (flet ((named-type (name)
              (make-instance 'gql::named-type

@@ 17,15 17,6 @@ Then, we need to define our package and go inside of it.
 (in-package :gql-exampleapp)
 ```
 
-Because this is merely a simple demonstration to show the proof of concept, we
-don't need a full database.  In a typical web app this is not how we should
-persist data, but it is good enough for our purposes.
-
-```lisp
-(defparameter *fake-db* (make-hash-table :test #'equal))
-(setf (gethash "name" *fake-db*) "Theodor")
-(setf (gethash "age" *fake-db*) 31)
-```
 
 We create our database and add in a couple of mappings.  Now for the more
 interesting part.  There are a couple of things needed in order to make queries


@@ 48,14 39,26 @@ We define it, along with our variable-values like so:
 ```
 
 Great, this is a good start!  The last item on our agenda is resolving
-information from our database.  `gql` provides a generic function, `resolve`,
-which sole purpose is to deal with this.  We need only a simple one here:
+information.  `gql` provides a dynamic variable, `*resolvers*`, which sole
+purpose is to deal with this.  We need only a simple one here:
 
 ```lisp
-(defmethod resolve (object-type object-value field-name arg-values)
-  (gethash field-name *fake-db*))
+(setf (gethash "name" *Query*) (lambda () "Bongodor"))
+(setf (gethash "age" *Query*) (lambda () 22))
+
+(setf *resolvers* (make-hash-table :test #'equal))
+(setf (gethash "Query" *resolvers*) *Query*)
 ```
 
+The main point here is that we want to mimick the structure from the schema, but
+return functions adhering to the contract defined in the schema.  In this case
+it is easy, we just supply a lambda that returns a value.  These functions are
+then called internally by `gql`.  We could supply arguments and variables here,
+and that would make our functions take an argument, a hash-table of
+param->value.  We don't need that here, so we just supply the functions without
+any arguments.  Later we will use convenience macros for this, because it is
+tedious work...
+
 The last few things is running a server and defining an easy handler:
 
 ```lisp


@@ 83,9 86,9 @@ Now, proceed to [localhost:3000/home](http://localhost:3000/home), then start ty
 queries in the url like so:
 
 ```
-localhost:3000/home?item=age
-localhost:3000/home?item=name
-localhost:3000/home?item=name age
+http://localhost:3000/home?item=age
+http://localhost:3000/home?item=name
+http://localhost:3000/home?item=name age
 ```
 
 And off we go!  The full file can be found here: