GraphQL: query/mutation/fragments/vars/executor + parser spec + tests
New graphql application. 676-line test-graphql.sx covers parser, executor, fetch-gql integration. lib/graphql.sx (686L) is the core parser/AST; lib/graphql-exec.sx (219L) runs resolvers. applications/graphql/spec.sx declares the application. sx/sx/applications/graphql/ provides the doc pages (parser, queries, mutation, fragments, vars, fetch-gql, executor). Includes rebuilt sx_browser.bc.js / sx_browser.bc.wasm.js bundles. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
219
lib/graphql-exec.sx
Normal file
219
lib/graphql-exec.sx
Normal file
@@ -0,0 +1,219 @@
|
||||
|
||||
;; GraphQL executor — walks parsed AST, dispatches via IO suspension
|
||||
;;
|
||||
;; Maps GraphQL operations to the defquery/defaction system:
|
||||
;; query → (perform (list 'io-gql-resolve "gql-query" field-name args))
|
||||
;; mutation → (perform (list 'io-gql-resolve "gql-mutation" field-name args))
|
||||
;;
|
||||
;; Field selection projects results to only requested fields.
|
||||
;; Fragments are resolved by name lookup in the document.
|
||||
;; Variables are substituted from a provided bindings dict.
|
||||
;;
|
||||
;; Usage:
|
||||
;; (gql-execute (gql-parse "{ posts { title } }"))
|
||||
;; (gql-execute (gql-parse "query($id: ID!) { post(id: $id) { title } }") {:id 42})
|
||||
;; (gql-execute ast variables resolver) ;; custom resolver
|
||||
|
||||
;; ── Variable substitution ─────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-substitute-vars
|
||||
(fn
|
||||
(value vars)
|
||||
"Recursively replace (gql-var name) nodes with values from vars dict."
|
||||
(cond
|
||||
((not (list? value)) value)
|
||||
((= (first value) (quote gql-var))
|
||||
(let
|
||||
((name (nth value 1)))
|
||||
(let
|
||||
((kw (make-keyword name)))
|
||||
(if
|
||||
(has-key? vars kw)
|
||||
(get vars kw)
|
||||
(error (str "GraphQL: undefined variable $" name))))))
|
||||
(true (map (fn (child) (gql-substitute-vars child vars)) value)))))
|
||||
|
||||
;; ── Fragment collection ───────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-collect-fragments
|
||||
(fn
|
||||
(doc)
|
||||
"Build a dict of fragment-name → fragment-definition from a gql-doc."
|
||||
(reduce
|
||||
(fn
|
||||
(acc def)
|
||||
(if
|
||||
(and (list? def) (= (first def) (quote gql-fragment)))
|
||||
(assoc acc (make-keyword (nth def 1)) def)
|
||||
acc))
|
||||
{}
|
||||
(rest doc))))
|
||||
|
||||
;; ── Field selection (projection) ──────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-project
|
||||
(fn
|
||||
(data selections fragments)
|
||||
"Project a result dict/list down to only the requested fields."
|
||||
(cond
|
||||
((nil? data) nil)
|
||||
((and (list? data) (not (dict? data)))
|
||||
(map (fn (item) (gql-project item selections fragments)) data))
|
||||
((dict? data)
|
||||
(if
|
||||
(= (length selections) 0)
|
||||
data
|
||||
(reduce
|
||||
(fn
|
||||
(acc sel)
|
||||
(cond
|
||||
((and (list? sel) (= (first sel) (quote gql-field)))
|
||||
(let
|
||||
((name (nth sel 1))
|
||||
(sub-sels (nth sel 4))
|
||||
(alias (if (> (length sel) 5) (nth sel 5) nil))
|
||||
(out-key (make-keyword (if alias alias name))))
|
||||
(let
|
||||
((field-val (get data (make-keyword name))))
|
||||
(if
|
||||
(> (length sub-sels) 0)
|
||||
(assoc
|
||||
acc
|
||||
out-key
|
||||
(gql-project field-val sub-sels fragments))
|
||||
(assoc acc out-key field-val)))))
|
||||
((and (list? sel) (= (first sel) (quote gql-fragment-spread)))
|
||||
(let
|
||||
((frag-name (nth sel 1))
|
||||
(frag (get fragments (make-keyword frag-name))))
|
||||
(if
|
||||
frag
|
||||
(let
|
||||
((frag-sels (nth frag 4)))
|
||||
(let
|
||||
((projected (gql-project data frag-sels fragments)))
|
||||
(reduce
|
||||
(fn (a k) (assoc a k (get projected k)))
|
||||
acc
|
||||
(keys projected))))
|
||||
acc)))
|
||||
((and (list? sel) (= (first sel) (quote gql-inline-fragment)))
|
||||
(let
|
||||
((sub-sels (nth sel 3)))
|
||||
(let
|
||||
((projected (gql-project data sub-sels fragments)))
|
||||
(reduce
|
||||
(fn (a k) (assoc a k (get projected k)))
|
||||
acc
|
||||
(keys projected)))))
|
||||
(true acc)))
|
||||
{}
|
||||
selections)))
|
||||
(true data))))
|
||||
|
||||
;; ── Default resolver ──────────────────────────────────────────────
|
||||
;; Dispatches root fields via IO suspension to the query/action registry.
|
||||
;; Platform provides io-gql-resolve handler.
|
||||
|
||||
(define
|
||||
gql-default-resolve
|
||||
(fn
|
||||
(field-name args op-type)
|
||||
"Default resolver: dispatches via perform to the platform's IO handler."
|
||||
(perform (list (quote io-gql-resolve) op-type field-name args))))
|
||||
|
||||
;; ── Execute a single operation ────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-execute-operation
|
||||
(fn
|
||||
(op vars fragments resolve-fn)
|
||||
"Execute one operation (query/mutation/subscription), return result dict."
|
||||
(let
|
||||
((op-type (first op))
|
||||
(selections (nth op 4))
|
||||
(substituted (gql-substitute-vars selections vars)))
|
||||
(let
|
||||
((result (reduce (fn (acc sel) (cond ((and (list? sel) (= (first sel) (quote gql-field))) (let ((name (nth sel 1)) (args-raw (nth sel 2)) (sub-sels (nth sel 4)) (alias (if (> (length sel) 5) (nth sel 5) nil)) (out-key (make-keyword (if alias alias name)))) (let ((args (map (fn (a) (list (first a) (gql-substitute-vars (nth a 1) vars))) args-raw))) (let ((args-dict (reduce (fn (d a) (assoc d (make-keyword (first a)) (nth a 1))) {} args))) (let ((raw (resolve-fn name args-dict op-type))) (if (> (length sub-sels) 0) (assoc acc out-key (gql-project raw sub-sels fragments)) (assoc acc out-key raw))))))) ((and (list? sel) (= (first sel) (quote gql-fragment-spread))) (let ((frag (get fragments (make-keyword (nth sel 1))))) (if frag (let ((merged (gql-execute-operation (list op-type nil (list) (list) (nth frag 4)) vars fragments resolve-fn))) (reduce (fn (a k) (assoc a k (get merged k))) acc (keys merged))) acc))) (true acc))) {} substituted)))
|
||||
result))))
|
||||
|
||||
;; ── Main entry point ──────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-execute
|
||||
(fn
|
||||
(doc &rest extra-args)
|
||||
"Execute a parsed GraphQL document.\n (gql-execute doc)\n (gql-execute doc variables)\n (gql-execute doc variables resolver-fn)\n Returns {:data result} or {:data result :errors errors}."
|
||||
(let
|
||||
((vars (if (> (length extra-args) 0) (first extra-args) {}))
|
||||
(resolve-fn
|
||||
(if
|
||||
(> (length extra-args) 1)
|
||||
(nth extra-args 1)
|
||||
gql-default-resolve))
|
||||
(fragments (gql-collect-fragments doc))
|
||||
(definitions (rest doc)))
|
||||
(let
|
||||
((ops (filter (fn (d) (and (list? d) (let ((t (first d))) (or (= t (quote gql-query)) (= t (quote gql-mutation)) (= t (quote gql-subscription)))))) definitions)))
|
||||
(if
|
||||
(= (length ops) 0)
|
||||
{:errors (list "No operation found in document") :data nil}
|
||||
(let
|
||||
((result (gql-execute-operation (first ops) vars fragments resolve-fn)))
|
||||
{:data result}))))))
|
||||
|
||||
;; ── Execute with named operation ──────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-execute-named
|
||||
(fn
|
||||
(doc operation-name vars &rest extra-args)
|
||||
"Execute a specific named operation from a multi-operation document."
|
||||
(let
|
||||
((resolve-fn (if (> (length extra-args) 0) (first extra-args) gql-default-resolve))
|
||||
(fragments (gql-collect-fragments doc))
|
||||
(definitions (rest doc)))
|
||||
(let
|
||||
((op (first (filter (fn (d) (and (list? d) (> (length d) 1) (= (nth d 1) operation-name))) definitions))))
|
||||
(if
|
||||
(nil? op)
|
||||
{:errors (list (str "Operation '" operation-name "' not found")) :data nil}
|
||||
(let
|
||||
((result (gql-execute-operation op vars fragments resolve-fn)))
|
||||
{:data result}))))))
|
||||
|
||||
;; ── Introspection helpers ─────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-operation-names
|
||||
(fn
|
||||
(doc)
|
||||
"List all operation names in a document."
|
||||
(filter
|
||||
(fn (x) (not (nil? x)))
|
||||
(map
|
||||
(fn (d) (if (and (list? d) (> (length d) 1)) (nth d 1) nil))
|
||||
(filter
|
||||
(fn
|
||||
(d)
|
||||
(and
|
||||
(list? d)
|
||||
(let
|
||||
((t (first d)))
|
||||
(or
|
||||
(= t (quote gql-query))
|
||||
(= t (quote gql-mutation))
|
||||
(= t (quote gql-subscription))))))
|
||||
(rest doc))))))
|
||||
|
||||
(define
|
||||
gql-extract-variables
|
||||
(fn
|
||||
(doc)
|
||||
"Extract variable definitions from the first operation."
|
||||
(let
|
||||
((ops (filter (fn (d) (and (list? d) (let ((t (first d))) (or (= t (quote gql-query)) (= t (quote gql-mutation)) (= t (quote gql-subscription)))))) (rest doc))))
|
||||
(if (> (length ops) 0) (nth (first ops) 2) (list)))))
|
||||
Reference in New Issue
Block a user