~theo/gql

b006a3088ecfa0c96bb2f5551307588eabbadffd — Theodor Thornhill 8 months ago 60952ef
First implementation of the *resolvers* functionality

Now we can add our functions to a hash-table of names->functions.  This
simplifies adding and finding the resolvers, but adds a tedious syntax for it.
We need to fix that. Soon.  However, this looks like it works pretty well.
M example/example.lisp => example/example.lisp +10 -6
@@ 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))


M src/execution.lisp => src/execution.lisp +19 -17
@@ 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))

M src/package.lisp => src/package.lisp +1 -0
@@ 9,4 9,5 @@
   #:validate
   #:with-schema
   #:execute-request
   #:*resolvers*
   #:resolve))

M src/specials.lisp => src/specials.lisp +3 -0
@@ 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=))


M t/execution-tests.lisp => t/execution-tests.lisp +50 -28
@@ 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

M wiki/example1.md => wiki/example1.md +19 -16
@@ 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: