giles
fc24cc704d
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>
220 lines
9.1 KiB
Plaintext
220 lines
9.1 KiB
Plaintext
|
|
;; 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)))))
|