M src/debugger-utils.lisp +8 -0
@@ 12,6 12,14 @@
(print-unreadable-object (obj stream :type t :identity t)
(princ (nameof obj) stream)))
+(defmethod print-object ((obj enum-type-definition) stream)
+ (print-unreadable-object (obj stream :type t :identity t)
+ (princ (nameof obj) stream)))
+
+(defmethod print-object ((obj interface-type-definition) stream)
+ (print-unreadable-object (obj stream :type t :identity t)
+ (princ (nameof obj) stream)))
+
(defmethod print-object ((obj named-type) stream)
(print-unreadable-object (obj stream :type t :identity t)
(princ (nameof obj) stream)))
M src/execution.lisp +1 -13
@@ 2,17 2,6 @@
(declaim (optimize (debug 3)))
-(defgeneric resolve (object-type object-value field-name arg-values)
- (:documentation "A function to resolve arbitrary values."))
-
-(defmethod resolve (object-type object-value field-name arg-values)
- ;; TODO: Ok, so now we get the corresponding type in the hash table, then
- ;; funcall the function mapped to by field name.
- (let ((resolvers (gethash (nameof object-type) *resolvers*)))
- (if (> (hash-table-count arg-values) 0)
- (funcall (gethash field-name resolvers) object-value arg-values)
- (funcall (gethash field-name resolvers) object-value))))
-
(defun fragment-type-applies-p (object-type fragment-type)
;; TODO: https://spec.graphql.org/draft/#DoesFragmentTypeApply()
(let ((type-definition (gethash object-type (type-map *schema*))))
@@ 295,8 284,7 @@
(etypecase abstract-type
(interface-type-definition (gethash type-name (type-map *schema*)))
(union-type-definition
- (let ((union-member
- (find type-name (union-members abstract-type) :key #'nameof :test #'string=)))
+ (let ((union-member (gethash type-name (union-members abstract-type))))
(gethash (nameof union-member) (type-map *schema*)))))))
(defun execute-field (object-type object-value field-definition fields variable-values)
M src/schema.lisp +35 -7
@@ 51,14 51,15 @@
(dolist (type initial-types)
;; TODO: Error handling
- (type-map-reducer schema type-map type))
+ (type-map-reducer schema type-map type)
+ (mapify-type-definitions type))
(setf (type-map schema) type-map)
schema))
(defun type-map-reducer (schema type-map object-type)
;; TODO: Return errors as well?
- (when (or (null object-type) (equal (name object-type) ""))
+ (when (or (null object-type) (equal (nameof object-type) ""))
(return-from type-map-reducer type-map))
(typecase object-type
@@ 73,12 74,39 @@
;; ;; TODO: return an error here because the type already exists?
;; )
- (if (name object-type)
- (setf (gethash (nameof object-type) type-map) object-type)
- ;; TODO: Probably an idiotic check. Are we operation-definition for sure
- ;; here?
- (setf (gethash (operation-type object-type) type-map) object-type))
+ (setf (gethash (nameof object-type) type-map) object-type)
;; TODO: Lots more to do here
type-map)
+
+(defun mapify-type-definitions (object-type)
+ (let ((table (make-hash-table :test #'equal)))
+ (typecase object-type
+ ;; TODO: Do we need to map more things here?
+ (object-type-definition
+ (let ((interface-map (make-hash-table :test #'equal)))
+ (when (listp (fields object-type))
+ (dolist (field (fields object-type))
+ (setf (gethash (nameof field) table) field))
+ (setf (fields object-type) table))
+ (when (listp (interfaces object-type))
+ (dolist (interface (interfaces object-type))
+ (setf (gethash (nameof interface) interface-map) interface))
+ (setf (interfaces object-type) interface-map))))
+ (interface-type-definition
+ (when (listp (fields object-type))
+ (dolist (field (fields object-type))
+ (setf (gethash (nameof field) table) field))
+ (setf (fields object-type) table)))
+ (enum-type-definition
+ (when (listp (enum-values object-type))
+ (dolist (enum-val (enum-values object-type))
+ (setf (gethash (enum-value enum-val) table) enum-val))
+ (setf (enum-values object-type) table)))
+ (union-type-definition
+ (when (listp (union-members object-type))
+ (dolist (union-member (union-members object-type))
+ (setf (gethash (nameof union-member) table) union-member))
+ (setf (union-members object-type) table))))
+ object-type))
M src/utils.lisp +6 -5
@@ 110,9 110,8 @@
((string= "__schema" field-name) *__schema-field-definition*)
((string= "__type" field-name) *__type-field-definition*)
(t
- (find-if (lambda (obj) (string= (nameof obj) field-name))
- ;; (fields (gethash (nameof object-type) *all-types*))
- (fields (gethash (nameof object-type) (type-map *schema*))))))))
+ (let ((object (gethash (nameof object-type) (type-map *schema*))))
+ (gethash field-name (fields object)))))))
(defclass gql-object ()
((type-name
@@ 197,6 196,8 @@
(defun set-resolver (type-name field-name fn)
(declare (optimize (debug 3)))
(let ((field-definition
- (find-if (lambda (f) (string= (nameof f) field-name))
- (fields (gethash type-name (type-map *schema*))))))
+ (gethash field-name (fields (gethash type-name (type-map *schema*))))
+ ;; (find-if (lambda (f) (string= (nameof f) field-name))
+ ;; )
+ ))
(setf (resolver field-definition) fn)))
M t/execution-tests.lisp +2 -2
@@ 3,9 3,9 @@
(deftest execution
(testing "collect-fields returns the correct fields"
(let* ((definitions (gql::definitions
- (build-schema "query { a { subfield1 } ...ExampleFragment } fragment ExampleFragment on Query { a { subfield2 } b }")))
+ (build-schema "{ a { subfield1 } ...ExampleFragment } fragment ExampleFragment on Query { a { subfield2 } b }")))
(query-type (gql::object :name "Query")))
- (with-schema (gql::make-schema :query query-type :types definitions)
+ (with-schema (gql::make-schema :query query-type :types (cdr definitions))
(let* ((operation (find-if (lambda (x) (string= (gql::operation-type x) "Query")) definitions))
(operation-type (gql::operation-type operation))
(selection-set (gql::selection-set operation))
M t/type-system-tests.lisp +15 -15
@@ 130,32 130,32 @@ scalar Url
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
(with-schema (gql::make-schema :query query-type :types definitions)
(let ((dog (gethash "Dog" (gql::type-map gql::*schema*))))
- (ok (gql::input-type-p (gql::ty (car (gql::fields dog)))))
- (ok (gql::input-type-p (gql::ty (cadr (gql::fields dog)))))
- (ok (gql::output-type-p (gql::ty (car (gql::fields dog)))))
- (ok (gql::output-type-p (gql::ty (cadr (gql::fields dog)))))))))
- (testing "enum"
+ (ok (gql::input-type-p (gql::ty (gethash "name" (gql::fields dog)))))
+ (ok (gql::input-type-p (gql::ty (gethash "nickname" (gql::fields dog)))))
+ (ok (gql::output-type-p (gql::ty (gethash "barkVolume" (gql::fields dog)))))
+ (ok (gql::output-type-p (gql::ty (gethash "name" (gql::fields dog)))))))))
+ (testing "union"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
(with-schema (gql::make-schema :query query-type :types definitions)
(let ((human-or-alien (gethash "HumanOrAlien" (gql::type-map gql::*schema*))))
- (ng (gql::input-type-p (car (gql::union-members human-or-alien))))
- (ng (gql::input-type-p (cadr (gql::union-members human-or-alien))))
- (ok (gql::output-type-p (car (gql::union-members human-or-alien))))
- (ok (gql::output-type-p (cadr (gql::union-members human-or-alien))))))))
+ (ng (gql::input-type-p (gethash "Human" (gql::union-members human-or-alien))))
+ (ng (gql::input-type-p (gethash "Alien" (gql::union-members human-or-alien))))
+ (ok (gql::output-type-p (gethash "Human" (gql::union-members human-or-alien))))
+ (ok (gql::output-type-p (gethash "Alien" (gql::union-members human-or-alien))))))))
(testing "object"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
(with-schema (gql::make-schema :query query-type :types definitions)
(let ((dog-or-human (gethash "DogOrHuman" (gql::type-map gql::*schema*))))
- (ng (gql::input-type-p (car (gql::union-members dog-or-human))))
- (ng (gql::input-type-p (cadr (gql::union-members dog-or-human))))
- (ok (gql::output-type-p (car (gql::union-members dog-or-human))))
- (ok (gql::output-type-p (cadr (gql::union-members dog-or-human))))))))
+ (ng (gql::input-type-p (gethash "Dog" (gql::union-members dog-or-human))))
+ (ng (gql::input-type-p (gethash "Human" (gql::union-members dog-or-human))))
+ (ok (gql::output-type-p (gethash "Dog" (gql::union-members dog-or-human))))
+ (ok (gql::output-type-p (gethash "Human" (gql::union-members dog-or-human))))))))
(testing "interface"
(let* ((definitions (gql::definitions (build-schema (asdf:system-relative-pathname 'gql-tests #p"t/test-files/validation-schema.graphql"))))
(query-type (find-if (lambda (x) (string= (gql::nameof x) "Query")) definitions)))
(with-schema (gql::make-schema :query query-type :types definitions)
(let ((cat (gethash "Cat" (gql::type-map gql::*schema*))))
- (ng (gql::input-type-p (car (gql::interfaces cat))))
- (ok (gql::output-type-p (car (gql::interfaces cat)))))))))
+ (ng (gql::input-type-p (gethash "Pet" (gql::interfaces cat))))
+ (ok (gql::output-type-p (gethash "Pet" (gql::interfaces cat)))))))))