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:
64
applications/graphql/spec.sx
Normal file
64
applications/graphql/spec.sx
Normal file
@@ -0,0 +1,64 @@
|
||||
|
||||
;; GraphQL — SX language assimilation
|
||||
;;
|
||||
;; Pure SX implementation of the GraphQL query language.
|
||||
;; Parser, executor, and serializer — all s-expressions,
|
||||
;; compiled to bytecode by the same kernel.
|
||||
;;
|
||||
;; Files:
|
||||
;; lib/graphql.sx — Tokenizer + recursive descent parser
|
||||
;; lib/graphql-exec.sx — Executor (projection, fragments, variables)
|
||||
;; spec/tests/test-graphql.sx — 66 tests across 15 suites
|
||||
;;
|
||||
;; Hyperscript integration:
|
||||
;; fetch gql { query { ... } } — shorthand query
|
||||
;; fetch gql mutation { ... } — mutation
|
||||
;; fetch gql { ... } from "/endpoint" — custom endpoint
|
||||
;;
|
||||
;; Maps to existing SX infrastructure:
|
||||
;; Query → defquery (IO suspension)
|
||||
;; Mutation → defaction (IO suspension)
|
||||
;; Subscription → SSE + signals (reactive islands)
|
||||
;; Fragment → defcomp (component composition)
|
||||
;; Schema → spec/types.sx (gradual type system)
|
||||
;; Resolver → perform (CEK IO suspension)
|
||||
|
||||
(define graphql-version "0.1.0")
|
||||
|
||||
(define
|
||||
graphql-features
|
||||
(quote
|
||||
(queries
|
||||
mutations
|
||||
subscriptions
|
||||
fragments
|
||||
inline-fragments
|
||||
fragment-spreads
|
||||
variables
|
||||
variable-defaults
|
||||
directives
|
||||
directive-arguments
|
||||
aliases
|
||||
field-arguments
|
||||
object-values
|
||||
list-values
|
||||
enum-values
|
||||
block-strings
|
||||
comments
|
||||
field-projection
|
||||
nested-projection
|
||||
list-projection
|
||||
variable-substitution
|
||||
fragment-resolution
|
||||
custom-resolvers
|
||||
default-io-resolver
|
||||
aliased-execution
|
||||
multi-root-fields
|
||||
named-operations
|
||||
operation-introspection
|
||||
ast-to-source
|
||||
round-trip
|
||||
fetch-gql
|
||||
fetch-gql-from
|
||||
fetch-gql-mutation
|
||||
fetch-gql-query)))
|
||||
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)))))
|
||||
686
lib/graphql.sx
Normal file
686
lib/graphql.sx
Normal file
@@ -0,0 +1,686 @@
|
||||
|
||||
;; GraphQL parser — tokenizer + recursive descent → SX AST
|
||||
;;
|
||||
;; Parses the GraphQL query language (queries, mutations, subscriptions,
|
||||
;; fragments, variables, directives) into s-expression AST.
|
||||
;;
|
||||
;; Usage:
|
||||
;; (gql-parse "{ user(id: 1) { name email } }")
|
||||
;;
|
||||
;; AST node types:
|
||||
;; (gql-doc definitions...)
|
||||
;; (gql-query name vars directives selections)
|
||||
;; (gql-mutation name vars directives selections)
|
||||
;; (gql-subscription name vars directives selections)
|
||||
;; (gql-field name args directives selections [alias])
|
||||
;; (gql-fragment name on-type directives selections)
|
||||
;; (gql-fragment-spread name directives)
|
||||
;; (gql-inline-fragment on-type directives selections)
|
||||
;; (gql-var name) — $variableName reference
|
||||
;; (gql-var-def name type default) — variable definition
|
||||
;; (gql-type name) — named type
|
||||
;; (gql-list-type inner) — [Type]
|
||||
;; (gql-non-null inner) — Type!
|
||||
;; (gql-directive name args) — @directive(args)
|
||||
|
||||
;; ── Character helpers (shared) ────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-ws?
|
||||
(fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r") (= c ","))))
|
||||
(define gql-digit? (fn (c) (and c (>= c "0") (<= c "9"))))
|
||||
(define
|
||||
gql-letter?
|
||||
(fn
|
||||
(c)
|
||||
(and c (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
|
||||
(define gql-name-start? (fn (c) (or (gql-letter? c) (= c "_"))))
|
||||
(define gql-name-char? (fn (c) (or (gql-name-start? c) (gql-digit? c))))
|
||||
|
||||
;; ── Tokenizer ─────────────────────────────────────────────────────
|
||||
;; Returns {:tokens list :pos int} — state-passing style to avoid
|
||||
;; multiple define closures over the same mutable variable.
|
||||
|
||||
(define
|
||||
gql-char-at
|
||||
(fn (src len i) (if (< i len) (substring src i (+ i 1)) nil)))
|
||||
|
||||
(define
|
||||
gql-skip-ws
|
||||
(fn
|
||||
(src len pos)
|
||||
"Skip whitespace, commas, and # comments. Returns new pos."
|
||||
(if
|
||||
(>= pos len)
|
||||
pos
|
||||
(let
|
||||
((c (gql-char-at src len pos)))
|
||||
(cond
|
||||
((gql-ws? c) (gql-skip-ws src len (+ pos 1)))
|
||||
((= c "#")
|
||||
(let
|
||||
((eol-pos (gql-skip-to-eol src len (+ pos 1))))
|
||||
(gql-skip-ws src len eol-pos)))
|
||||
(true pos))))))
|
||||
|
||||
(define
|
||||
gql-skip-to-eol
|
||||
(fn
|
||||
(src len pos)
|
||||
(if
|
||||
(>= pos len)
|
||||
pos
|
||||
(if
|
||||
(= (gql-char-at src len pos) "\n")
|
||||
pos
|
||||
(gql-skip-to-eol src len (+ pos 1))))))
|
||||
|
||||
(define
|
||||
gql-read-name
|
||||
(fn
|
||||
(src len pos)
|
||||
"Read [_A-Za-z][_A-Za-z0-9]*. Returns {:value name :pos new-pos}."
|
||||
(let
|
||||
((start pos))
|
||||
(define
|
||||
loop
|
||||
(fn
|
||||
(p)
|
||||
(if
|
||||
(and (< p len) (gql-name-char? (gql-char-at src len p)))
|
||||
(loop (+ p 1))
|
||||
{:pos p :value (substring src start p)})))
|
||||
(loop pos))))
|
||||
|
||||
(define
|
||||
gql-read-number
|
||||
(fn
|
||||
(src len pos)
|
||||
"Read number. Returns {:value num :pos new-pos}."
|
||||
(let
|
||||
((start pos) (p pos))
|
||||
(when (= (gql-char-at src len p) "-") (set! p (+ p 1)))
|
||||
(define
|
||||
dloop
|
||||
(fn
|
||||
(p has-dot)
|
||||
(if
|
||||
(>= p len)
|
||||
{:pos p :value (parse-number (substring src start p))}
|
||||
(let
|
||||
((c (gql-char-at src len p)))
|
||||
(cond
|
||||
((gql-digit? c) (dloop (+ p 1) has-dot))
|
||||
((and (= c ".") (not has-dot)) (dloop (+ p 1) true))
|
||||
((or (= c "e") (= c "E"))
|
||||
(let
|
||||
((p2 (+ p 1)))
|
||||
(when
|
||||
(or
|
||||
(= (gql-char-at src len p2) "+")
|
||||
(= (gql-char-at src len p2) "-"))
|
||||
(set! p2 (+ p2 1)))
|
||||
(dloop p2 has-dot)))
|
||||
(true {:pos p :value (parse-number (substring src start p))}))))))
|
||||
(dloop p false))))
|
||||
|
||||
(define
|
||||
gql-read-string
|
||||
(fn
|
||||
(src len pos)
|
||||
"Read double-quoted string. pos is ON the opening quote. Returns {:value str :pos new-pos}."
|
||||
(let
|
||||
((p (+ pos 1)))
|
||||
(if
|
||||
(and
|
||||
(< (+ p 1) len)
|
||||
(= (gql-char-at src len p) "\"")
|
||||
(= (gql-char-at src len (+ p 1)) "\""))
|
||||
(let
|
||||
((p2 (+ p 2)))
|
||||
(define
|
||||
bloop
|
||||
(fn
|
||||
(bp)
|
||||
(if
|
||||
(and
|
||||
(< (+ bp 2) len)
|
||||
(= (gql-char-at src len bp) "\"")
|
||||
(= (gql-char-at src len (+ bp 1)) "\"")
|
||||
(= (gql-char-at src len (+ bp 2)) "\""))
|
||||
{:pos (+ bp 3) :value (substring src p2 bp)}
|
||||
(bloop (+ bp 1)))))
|
||||
(bloop p2))
|
||||
(do
|
||||
(define
|
||||
sloop
|
||||
(fn
|
||||
(sp parts)
|
||||
(if
|
||||
(>= sp len)
|
||||
{:pos sp :value (join "" parts)}
|
||||
(let
|
||||
((c (gql-char-at src len sp)))
|
||||
(cond
|
||||
((= c "\"") {:pos (+ sp 1) :value (join "" parts)})
|
||||
((= c "\\")
|
||||
(let
|
||||
((esc (gql-char-at src len (+ sp 1)))
|
||||
(sp2 (+ sp 2)))
|
||||
(sloop
|
||||
sp2
|
||||
(append
|
||||
parts
|
||||
(list
|
||||
(cond
|
||||
((= esc "n") "\n")
|
||||
((= esc "t") "\t")
|
||||
((= esc "r") "\r")
|
||||
((= esc "\\") "\\")
|
||||
((= esc "\"") "\"")
|
||||
((= esc "/") "/")
|
||||
(true (str "\\" esc))))))))
|
||||
(true (sloop (+ sp 1) (append parts (list c)))))))))
|
||||
(sloop p (list)))))))
|
||||
|
||||
(define
|
||||
gql-tokenize
|
||||
(fn
|
||||
(src)
|
||||
(let
|
||||
((len (string-length src)))
|
||||
(define
|
||||
tok-loop
|
||||
(fn
|
||||
(pos acc)
|
||||
(let
|
||||
((pos (gql-skip-ws src len pos)))
|
||||
(if
|
||||
(>= pos len)
|
||||
(append acc (list {:pos pos :value nil :type "eof"}))
|
||||
(let
|
||||
((c (gql-char-at src len pos)))
|
||||
(cond
|
||||
((= c "{")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "{" :type "brace-open"}))))
|
||||
((= c "}")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "}" :type "brace-close"}))))
|
||||
((= c "(")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "(" :type "paren-open"}))))
|
||||
((= c ")")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value ")" :type "paren-close"}))))
|
||||
((= c "[")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "[" :type "bracket-open"}))))
|
||||
((= c "]")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "]" :type "bracket-close"}))))
|
||||
((= c ":")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value ":" :type "colon"}))))
|
||||
((= c "!")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "!" :type "bang"}))))
|
||||
((= c "$")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "$" :type "dollar"}))))
|
||||
((= c "@")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "@" :type "at"}))))
|
||||
((= c "=")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "=" :type "equals"}))))
|
||||
((= c "|")
|
||||
(tok-loop (+ pos 1) (append acc (list {:pos pos :value "|" :type "pipe"}))))
|
||||
((and (= c ".") (< (+ pos 2) len) (= (gql-char-at src len (+ pos 1)) ".") (= (gql-char-at src len (+ pos 2)) "."))
|
||||
(tok-loop (+ pos 3) (append acc (list {:pos pos :value "..." :type "spread"}))))
|
||||
((= c "\"")
|
||||
(let
|
||||
((r (gql-read-string src len pos)))
|
||||
(tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "string"})))))
|
||||
((or (gql-digit? c) (and (= c "-") (< (+ pos 1) len) (gql-digit? (gql-char-at src len (+ pos 1)))))
|
||||
(let
|
||||
((r (gql-read-number src len pos)))
|
||||
(tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "number"})))))
|
||||
((gql-name-start? c)
|
||||
(let
|
||||
((r (gql-read-name src len pos)))
|
||||
(tok-loop (get r :pos) (append acc (list {:pos pos :value (get r :value) :type "name"})))))
|
||||
(true (tok-loop (+ pos 1) acc))))))))
|
||||
(tok-loop 0 (list)))))
|
||||
|
||||
;; ── Parser ────────────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
gql-parse-tokens
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((p 0) (tlen (length tokens)))
|
||||
(define cur (fn () (if (< p tlen) (nth tokens p) {:value nil :type "eof"})))
|
||||
(define cur-type (fn () (get (cur) :type)))
|
||||
(define cur-val (fn () (get (cur) :value)))
|
||||
(define adv! (fn () (set! p (+ p 1))))
|
||||
(define at-end? (fn () (= (cur-type) "eof")))
|
||||
(define
|
||||
expect!
|
||||
(fn
|
||||
(type)
|
||||
(if
|
||||
(= (cur-type) type)
|
||||
(let ((v (cur-val))) (adv!) v)
|
||||
(error
|
||||
(str "GraphQL parse error: expected " type " got " (cur-type))))))
|
||||
(define expect-name! (fn () (expect! "name")))
|
||||
(define
|
||||
parse-value
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (cur-type)) (val (cur-val)))
|
||||
(cond
|
||||
((= typ "dollar")
|
||||
(do (adv!) (list (quote gql-var) (expect-name!))))
|
||||
((= typ "number") (do (adv!) val))
|
||||
((= typ "string") (do (adv!) val))
|
||||
((and (= typ "name") (= val "true")) (do (adv!) true))
|
||||
((and (= typ "name") (= val "false")) (do (adv!) false))
|
||||
((and (= typ "name") (= val "null")) (do (adv!) nil))
|
||||
((= typ "bracket-open") (parse-list-value))
|
||||
((= typ "brace-open") (parse-object-value))
|
||||
((= typ "name") (do (adv!) val))
|
||||
(true
|
||||
(error
|
||||
(str "GraphQL parse error: unexpected " typ " in value")))))))
|
||||
(define
|
||||
parse-list-value
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(expect! "bracket-open")
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (at-end?) (= (cur-type) "bracket-close"))
|
||||
(do (expect! "bracket-close") acc)
|
||||
(collect (append acc (list (parse-value)))))))
|
||||
(collect (list)))))
|
||||
(define
|
||||
parse-object-value
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(expect! "brace-open")
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (at-end?) (= (cur-type) "brace-close"))
|
||||
(do (expect! "brace-close") acc)
|
||||
(let
|
||||
((k (expect-name!)))
|
||||
(expect! "colon")
|
||||
(let
|
||||
((v (parse-value)))
|
||||
(collect (assoc acc (make-keyword k) v)))))))
|
||||
(collect {}))))
|
||||
(define
|
||||
parse-arguments
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(not (= (cur-type) "paren-open"))
|
||||
(list)
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (at-end?) (= (cur-type) "paren-close"))
|
||||
(do (adv!) acc)
|
||||
(let
|
||||
((name (expect-name!)))
|
||||
(expect! "colon")
|
||||
(let
|
||||
((val (parse-value)))
|
||||
(collect (append acc (list (list name val)))))))))
|
||||
(collect (list))))))
|
||||
(define
|
||||
parse-directives
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(and (= (cur-type) "at") (not (at-end?)))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((name (expect-name!)) (args (parse-arguments)))
|
||||
(collect
|
||||
(append
|
||||
acc
|
||||
(list (list (quote gql-directive) name args))))))
|
||||
acc)))
|
||||
(collect (list))))
|
||||
(define
|
||||
parse-type
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((base (cond ((= (cur-type) "bracket-open") (do (adv!) (let ((inner (parse-type))) (expect! "bracket-close") (list (quote gql-list-type) inner)))) (true (list (quote gql-type) (expect-name!))))))
|
||||
(if
|
||||
(= (cur-type) "bang")
|
||||
(do (adv!) (list (quote gql-non-null) base))
|
||||
base))))
|
||||
(define
|
||||
parse-variable-defs
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(not (= (cur-type) "paren-open"))
|
||||
(list)
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (at-end?) (= (cur-type) "paren-close"))
|
||||
(do (adv!) acc)
|
||||
(do
|
||||
(expect! "dollar")
|
||||
(let
|
||||
((name (expect-name!)))
|
||||
(expect! "colon")
|
||||
(let
|
||||
((typ (parse-type))
|
||||
(default
|
||||
(if
|
||||
(= (cur-type) "equals")
|
||||
(do (adv!) (parse-value))
|
||||
nil)))
|
||||
(collect
|
||||
(append
|
||||
acc
|
||||
(list
|
||||
(list (quote gql-var-def) name typ default))))))))))
|
||||
(collect (list))))))
|
||||
(define
|
||||
parse-selection-set
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(not (= (cur-type) "brace-open"))
|
||||
(list)
|
||||
(do
|
||||
(adv!)
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(or (at-end?) (= (cur-type) "brace-close"))
|
||||
(do (adv!) acc)
|
||||
(collect (append acc (list (parse-selection)))))))
|
||||
(collect (list))))))
|
||||
(define
|
||||
parse-selection
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((= (cur-type) "spread")
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(and (= (cur-type) "name") (not (= (cur-val) "on")))
|
||||
(let
|
||||
((name (expect-name!)) (dirs (parse-directives)))
|
||||
(list (quote gql-fragment-spread) name dirs))
|
||||
(let
|
||||
((on-type (if (and (= (cur-type) "name") (= (cur-val) "on")) (do (adv!) (expect-name!)) nil))
|
||||
(dirs (parse-directives))
|
||||
(sels (parse-selection-set)))
|
||||
(list (quote gql-inline-fragment) on-type dirs sels)))))
|
||||
(true (parse-field)))))
|
||||
(define
|
||||
parse-field
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name1 (expect-name!)))
|
||||
(let
|
||||
((actual-name (if (= (cur-type) "colon") (do (adv!) (expect-name!)) nil))
|
||||
(alias (if actual-name name1 nil))
|
||||
(field-name (if actual-name actual-name name1)))
|
||||
(let
|
||||
((args (parse-arguments))
|
||||
(dirs (parse-directives))
|
||||
(sels (parse-selection-set)))
|
||||
(if
|
||||
alias
|
||||
(list (quote gql-field) field-name args dirs sels alias)
|
||||
(list (quote gql-field) field-name args dirs sels)))))))
|
||||
(define
|
||||
parse-operation
|
||||
(fn
|
||||
(op-type)
|
||||
(let
|
||||
((name (if (and (= (cur-type) "name") (not (= (cur-val) "query")) (not (= (cur-val) "mutation")) (not (= (cur-val) "subscription")) (not (= (cur-val) "fragment"))) (expect-name!) nil))
|
||||
(vars (parse-variable-defs))
|
||||
(dirs (parse-directives))
|
||||
(sels (parse-selection-set)))
|
||||
(list op-type name vars dirs sels))))
|
||||
(define
|
||||
parse-fragment-def
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (expect-name!)))
|
||||
(when (and (= (cur-type) "name") (= (cur-val) "on")) (adv!))
|
||||
(let
|
||||
((on-type (expect-name!))
|
||||
(dirs (parse-directives))
|
||||
(sels (parse-selection-set)))
|
||||
(list (quote gql-fragment) name on-type dirs sels)))))
|
||||
(define
|
||||
parse-definition
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (cur-type)) (val (cur-val)))
|
||||
(cond
|
||||
((= typ "brace-open")
|
||||
(let
|
||||
((sels (parse-selection-set)))
|
||||
(list (quote gql-query) nil (list) (list) sels)))
|
||||
((and (= typ "name") (= val "query"))
|
||||
(do (adv!) (parse-operation (quote gql-query))))
|
||||
((and (= typ "name") (= val "mutation"))
|
||||
(do (adv!) (parse-operation (quote gql-mutation))))
|
||||
((and (= typ "name") (= val "subscription"))
|
||||
(do (adv!) (parse-operation (quote gql-subscription))))
|
||||
((and (= typ "name") (= val "fragment"))
|
||||
(do (adv!) (parse-fragment-def)))
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"GraphQL parse error: unexpected "
|
||||
typ
|
||||
" "
|
||||
(if val val ""))))))))
|
||||
(define
|
||||
parse-document
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
collect
|
||||
(fn
|
||||
(acc)
|
||||
(if
|
||||
(at-end?)
|
||||
(cons (quote gql-doc) acc)
|
||||
(collect (append acc (list (parse-definition)))))))
|
||||
(collect (list))))
|
||||
(parse-document))))
|
||||
|
||||
;; ── Convenience: source → AST ─────────────────────────────────────
|
||||
|
||||
(define gql-parse (fn (source) (gql-parse-tokens (gql-tokenize source))))
|
||||
|
||||
;; ── AST accessors ─────────────────────────────────────────────────
|
||||
|
||||
(define gql-node-type (fn (node) (if (list? node) (first node) nil)))
|
||||
(define gql-doc? (fn (node) (= (gql-node-type node) (quote gql-doc))))
|
||||
(define gql-query? (fn (node) (= (gql-node-type node) (quote gql-query))))
|
||||
(define
|
||||
gql-mutation?
|
||||
(fn (node) (= (gql-node-type node) (quote gql-mutation))))
|
||||
(define
|
||||
gql-subscription?
|
||||
(fn (node) (= (gql-node-type node) (quote gql-subscription))))
|
||||
(define gql-field? (fn (node) (= (gql-node-type node) (quote gql-field))))
|
||||
(define
|
||||
gql-fragment?
|
||||
(fn (node) (= (gql-node-type node) (quote gql-fragment))))
|
||||
(define
|
||||
gql-fragment-spread?
|
||||
(fn (node) (= (gql-node-type node) (quote gql-fragment-spread))))
|
||||
(define gql-var? (fn (node) (= (gql-node-type node) (quote gql-var))))
|
||||
|
||||
;; Field accessors: (gql-field name args directives selections [alias])
|
||||
(define gql-field-name (fn (f) (nth f 1)))
|
||||
(define gql-field-args (fn (f) (nth f 2)))
|
||||
(define gql-field-directives (fn (f) (nth f 3)))
|
||||
(define gql-field-selections (fn (f) (nth f 4)))
|
||||
(define gql-field-alias (fn (f) (if (> (length f) 5) (nth f 5) nil)))
|
||||
|
||||
;; Operation accessors: (gql-query/mutation/subscription name vars directives selections)
|
||||
(define gql-op-name (fn (op) (nth op 1)))
|
||||
(define gql-op-vars (fn (op) (nth op 2)))
|
||||
(define gql-op-directives (fn (op) (nth op 3)))
|
||||
(define gql-op-selections (fn (op) (nth op 4)))
|
||||
|
||||
;; Fragment accessors: (gql-fragment name on-type directives selections)
|
||||
(define gql-frag-name (fn (f) (nth f 1)))
|
||||
(define gql-frag-type (fn (f) (nth f 2)))
|
||||
(define gql-frag-directives (fn (f) (nth f 3)))
|
||||
(define gql-frag-selections (fn (f) (nth f 4)))
|
||||
|
||||
;; Document: (gql-doc def1 def2 ...)
|
||||
(define gql-doc-definitions (fn (doc) (rest doc)))
|
||||
|
||||
;; ── Serializer: AST → GraphQL source ─────────────────────────────
|
||||
|
||||
(define
|
||||
serialize-selection-set
|
||||
(fn (sels) (str "{ " (join " " (map gql-serialize sels)) " }")))
|
||||
|
||||
(define
|
||||
serialize-args
|
||||
(fn
|
||||
(args)
|
||||
(str
|
||||
"("
|
||||
(join
|
||||
", "
|
||||
(map
|
||||
(fn (a) (str (first a) ": " (gql-serialize (nth a 1))))
|
||||
args))
|
||||
")")))
|
||||
|
||||
(define
|
||||
serialize-var-defs
|
||||
(fn
|
||||
(vars)
|
||||
(str
|
||||
"("
|
||||
(join
|
||||
", "
|
||||
(map
|
||||
(fn
|
||||
(v)
|
||||
(let
|
||||
((name (nth v 1))
|
||||
(typ (serialize-type (nth v 2)))
|
||||
(default (nth v 3)))
|
||||
(str
|
||||
"$"
|
||||
name
|
||||
": "
|
||||
typ
|
||||
(if default (str " = " (gql-serialize default)) ""))))
|
||||
vars))
|
||||
")")))
|
||||
|
||||
(define
|
||||
serialize-type
|
||||
(fn
|
||||
(t)
|
||||
(let
|
||||
((typ (first t)))
|
||||
(cond
|
||||
((= typ (quote gql-type)) (nth t 1))
|
||||
((= typ (quote gql-list-type))
|
||||
(str "[" (serialize-type (nth t 1)) "]"))
|
||||
((= typ (quote gql-non-null))
|
||||
(str (serialize-type (nth t 1)) "!"))
|
||||
(true "Unknown")))))
|
||||
|
||||
(define
|
||||
gql-serialize
|
||||
(fn
|
||||
(node)
|
||||
(cond
|
||||
((not (list? node))
|
||||
(cond
|
||||
((string? node) (str "\"" node "\""))
|
||||
((number? node) (str node))
|
||||
((= node true) "true")
|
||||
((= node false) "false")
|
||||
((nil? node) "null")
|
||||
(true (str node))))
|
||||
(true
|
||||
(let
|
||||
((typ (gql-node-type node)))
|
||||
(cond
|
||||
((= typ (quote gql-doc))
|
||||
(join "\n\n" (map gql-serialize (gql-doc-definitions node))))
|
||||
((or (= typ (quote gql-query)) (= typ (quote gql-mutation)) (= typ (quote gql-subscription)))
|
||||
(let
|
||||
((op-word (cond ((= typ (quote gql-query)) "query") ((= typ (quote gql-mutation)) "mutation") ((= typ (quote gql-subscription)) "subscription")))
|
||||
(name (gql-op-name node))
|
||||
(vars (gql-op-vars node))
|
||||
(sels (gql-op-selections node)))
|
||||
(str
|
||||
op-word
|
||||
(if name (str " " name) "")
|
||||
(if (> (length vars) 0) (serialize-var-defs vars) "")
|
||||
" "
|
||||
(serialize-selection-set sels))))
|
||||
((= typ (quote gql-field))
|
||||
(let
|
||||
((name (gql-field-name node))
|
||||
(alias (gql-field-alias node))
|
||||
(args (gql-field-args node))
|
||||
(sels (gql-field-selections node)))
|
||||
(str
|
||||
(if alias (str alias ": ") "")
|
||||
name
|
||||
(if (> (length args) 0) (serialize-args args) "")
|
||||
(if
|
||||
(> (length sels) 0)
|
||||
(str " " (serialize-selection-set sels))
|
||||
""))))
|
||||
((= typ (quote gql-fragment))
|
||||
(str
|
||||
"fragment "
|
||||
(gql-frag-name node)
|
||||
" on "
|
||||
(gql-frag-type node)
|
||||
" "
|
||||
(serialize-selection-set (gql-frag-selections node))))
|
||||
((= typ (quote gql-fragment-spread)) (str "..." (nth node 1)))
|
||||
((= typ (quote gql-var)) (str "$" (nth node 1)))
|
||||
(true "")))))))
|
||||
File diff suppressed because one or more lines are too long
@@ -1792,7 +1792,7 @@
|
||||
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||
}
|
||||
(globalThis))
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-4ecaab5d",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-b285d4f3",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-4bcf63c7",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-30cab65c",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
|
||||
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
|
||||
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
|
||||
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||
|
||||
676
spec/tests/test-graphql.sx
Normal file
676
spec/tests/test-graphql.sx
Normal file
@@ -0,0 +1,676 @@
|
||||
|
||||
;; GraphQL parser, executor, and hyperscript integration tests
|
||||
|
||||
;; ── Tokenizer ─────────────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-tokenizer"
|
||||
(deftest
|
||||
"tokenizes simple query"
|
||||
(let
|
||||
((tokens (gql-tokenize "{ user { name } }")))
|
||||
(assert= "brace-open" (get (nth tokens 0) :type))
|
||||
(assert= "name" (get (nth tokens 1) :type))
|
||||
(assert= "user" (get (nth tokens 1) :value))
|
||||
(assert= "brace-open" (get (nth tokens 2) :type))
|
||||
(assert= "name" (get (nth tokens 3) :type))
|
||||
(assert= "name" (get (nth tokens 3) :value))
|
||||
(assert= "brace-close" (get (nth tokens 4) :type))
|
||||
(assert= "brace-close" (get (nth tokens 5) :type))
|
||||
(assert= "eof" (get (nth tokens 6) :type))))
|
||||
(deftest
|
||||
"tokenizes arguments"
|
||||
(let
|
||||
((tokens (gql-tokenize "user(id: 42)")))
|
||||
(assert= "name" (get (nth tokens 0) :type))
|
||||
(assert= "paren-open" (get (nth tokens 1) :type))
|
||||
(assert= "name" (get (nth tokens 2) :type))
|
||||
(assert= "id" (get (nth tokens 2) :value))
|
||||
(assert= "colon" (get (nth tokens 3) :type))
|
||||
(assert= "number" (get (nth tokens 4) :type))
|
||||
(assert= 42 (get (nth tokens 4) :value))
|
||||
(assert= "paren-close" (get (nth tokens 5) :type))))
|
||||
(deftest
|
||||
"tokenizes string values"
|
||||
(let
|
||||
((tokens (gql-tokenize "name: \"hello world\"")))
|
||||
(assert= "string" (get (nth tokens 2) :type))
|
||||
(assert= "hello world" (get (nth tokens 2) :value))))
|
||||
(deftest
|
||||
"tokenizes dollar sign for variables"
|
||||
(let
|
||||
((tokens (gql-tokenize "$id")))
|
||||
(assert= "dollar" (get (nth tokens 0) :type))
|
||||
(assert= "name" (get (nth tokens 1) :type))
|
||||
(assert= "id" (get (nth tokens 1) :value))))
|
||||
(deftest
|
||||
"tokenizes bang for non-null"
|
||||
(let
|
||||
((tokens (gql-tokenize "String!")))
|
||||
(assert= "name" (get (nth tokens 0) :type))
|
||||
(assert= "bang" (get (nth tokens 1) :type))))
|
||||
(deftest
|
||||
"tokenizes spread operator"
|
||||
(let
|
||||
((tokens (gql-tokenize "...UserFields")))
|
||||
(assert= "spread" (get (nth tokens 0) :type))
|
||||
(assert= "name" (get (nth tokens 1) :type))
|
||||
(assert= "UserFields" (get (nth tokens 1) :value))))
|
||||
(deftest
|
||||
"tokenizes at sign for directives"
|
||||
(let
|
||||
((tokens (gql-tokenize "@skip(if: true)")))
|
||||
(assert= "at" (get (nth tokens 0) :type))
|
||||
(assert= "name" (get (nth tokens 1) :type))
|
||||
(assert= "skip" (get (nth tokens 1) :value))))
|
||||
(deftest
|
||||
"skips comments"
|
||||
(let
|
||||
((tokens (gql-tokenize "{ # this is a comment\n user }")))
|
||||
(assert= "brace-open" (get (nth tokens 0) :type))
|
||||
(assert= "name" (get (nth tokens 1) :type))
|
||||
(assert= "user" (get (nth tokens 1) :value))
|
||||
(assert= "brace-close" (get (nth tokens 2) :type))))
|
||||
(deftest
|
||||
"skips commas"
|
||||
(let
|
||||
((tokens (gql-tokenize "name, email, age")))
|
||||
(assert= 4 (length tokens))
|
||||
(assert= "name" (get (nth tokens 0) :value))
|
||||
(assert= "email" (get (nth tokens 1) :value))
|
||||
(assert= "age" (get (nth tokens 2) :value))))
|
||||
(deftest
|
||||
"tokenizes negative numbers"
|
||||
(let
|
||||
((tokens (gql-tokenize "-42")))
|
||||
(assert= "number" (get (nth tokens 0) :type))
|
||||
(assert= -42 (get (nth tokens 0) :value))))
|
||||
(deftest
|
||||
"tokenizes float numbers"
|
||||
(let
|
||||
((tokens (gql-tokenize "3.14")))
|
||||
(assert= "number" (get (nth tokens 0) :type))
|
||||
(assert= 3.14 (get (nth tokens 0) :value))))
|
||||
(deftest
|
||||
"tokenizes list brackets"
|
||||
(let
|
||||
((tokens (gql-tokenize "[1, 2, 3]")))
|
||||
(assert= "bracket-open" (get (nth tokens 0) :type))
|
||||
(assert= "number" (get (nth tokens 1) :type))
|
||||
(assert= "bracket-close" (get (nth tokens 4) :type)))))
|
||||
|
||||
;; ── Parser: shorthand queries ─────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-shorthand"
|
||||
(deftest
|
||||
"parses shorthand query"
|
||||
(let
|
||||
((doc (gql-parse "{ user { name } }")))
|
||||
(assert= (quote gql-doc) (first doc))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= (quote gql-query) (first op))
|
||||
(assert= nil (gql-op-name op))
|
||||
(assert= 1 (length (gql-op-selections op)))
|
||||
(let
|
||||
((field (first (gql-op-selections op))))
|
||||
(assert= (quote gql-field) (first field))
|
||||
(assert= "user" (gql-field-name field))
|
||||
(assert= 1 (length (gql-field-selections field)))
|
||||
(assert=
|
||||
"name"
|
||||
(gql-field-name (first (gql-field-selections field))))))))
|
||||
(deftest
|
||||
"parses multiple root fields"
|
||||
(let
|
||||
((doc (gql-parse "{ user { name } posts { title } }")))
|
||||
(let
|
||||
((sels (gql-op-selections (nth doc 1))))
|
||||
(assert= 2 (length sels))
|
||||
(assert= "user" (gql-field-name (first sels)))
|
||||
(assert= "posts" (gql-field-name (nth sels 1))))))
|
||||
(deftest
|
||||
"parses scalar field without sub-selections"
|
||||
(let
|
||||
((doc (gql-parse "{ name email }")))
|
||||
(let
|
||||
((sels (gql-op-selections (nth doc 1))))
|
||||
(assert= 2 (length sels))
|
||||
(assert= "name" (gql-field-name (first sels)))
|
||||
(assert= "email" (gql-field-name (nth sels 1)))
|
||||
(assert= 0 (length (gql-field-selections (first sels))))))))
|
||||
|
||||
;; ── Parser: named operations ──────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-operations"
|
||||
(deftest
|
||||
"parses named query"
|
||||
(let
|
||||
((doc (gql-parse "query GetUser { user { name } }")))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= (quote gql-query) (first op))
|
||||
(assert= "GetUser" (gql-op-name op)))))
|
||||
(deftest
|
||||
"parses mutation"
|
||||
(let
|
||||
((doc (gql-parse "mutation CreatePost { createPost(title: \"Hello\") { id } }")))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= (quote gql-mutation) (first op))
|
||||
(assert= "CreatePost" (gql-op-name op))
|
||||
(let
|
||||
((field (first (gql-op-selections op))))
|
||||
(assert= "createPost" (gql-field-name field))
|
||||
(assert= 1 (length (gql-field-args field)))
|
||||
(assert= "title" (first (first (gql-field-args field))))
|
||||
(assert= "Hello" (nth (first (gql-field-args field)) 1))))))
|
||||
(deftest
|
||||
"parses subscription"
|
||||
(let
|
||||
((doc (gql-parse "subscription OnMessage { messageAdded { text } }")))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= (quote gql-subscription) (first op))
|
||||
(assert= "OnMessage" (gql-op-name op)))))
|
||||
(deftest
|
||||
"parses anonymous query keyword"
|
||||
(let
|
||||
((doc (gql-parse "query { user { name } }")))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= (quote gql-query) (first op))
|
||||
(assert= nil (gql-op-name op))))))
|
||||
|
||||
;; ── Parser: arguments ─────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-arguments"
|
||||
(deftest
|
||||
"parses integer argument"
|
||||
(let
|
||||
((doc (gql-parse "{ user(id: 42) { name } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= 1 (length (gql-field-args field)))
|
||||
(assert= "id" (first (first (gql-field-args field))))
|
||||
(assert= 42 (nth (first (gql-field-args field)) 1)))))
|
||||
(deftest
|
||||
"parses string argument"
|
||||
(let
|
||||
((doc (gql-parse "{ post(slug: \"hello-world\") { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= "slug" (first (first (gql-field-args field))))
|
||||
(assert= "hello-world" (nth (first (gql-field-args field)) 1)))))
|
||||
(deftest
|
||||
"parses boolean arguments"
|
||||
(let
|
||||
((doc (gql-parse "{ posts(published: true) { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= true (nth (first (gql-field-args field)) 1)))))
|
||||
(deftest
|
||||
"parses null argument"
|
||||
(let
|
||||
((doc (gql-parse "{ posts(cursor: null) { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= nil (nth (first (gql-field-args field)) 1)))))
|
||||
(deftest
|
||||
"parses multiple arguments"
|
||||
(let
|
||||
((doc (gql-parse "{ posts(limit: 10, offset: 20) { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= 2 (length (gql-field-args field)))
|
||||
(assert= "limit" (first (first (gql-field-args field))))
|
||||
(assert= 10 (nth (first (gql-field-args field)) 1))
|
||||
(assert= "offset" (first (nth (gql-field-args field) 1)))
|
||||
(assert= 20 (nth (nth (gql-field-args field) 1) 1)))))
|
||||
(deftest
|
||||
"parses enum argument"
|
||||
(let
|
||||
((doc (gql-parse "{ posts(status: PUBLISHED) { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= "PUBLISHED" (nth (first (gql-field-args field)) 1)))))
|
||||
(deftest
|
||||
"parses list argument"
|
||||
(let
|
||||
((doc (gql-parse "{ posts(ids: [1, 2, 3]) { title } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(let
|
||||
((val (nth (first (gql-field-args field)) 1)))
|
||||
(assert= 3 (length val))
|
||||
(assert= 1 (first val))
|
||||
(assert= 3 (nth val 2))))))
|
||||
(deftest
|
||||
"parses object argument"
|
||||
(let
|
||||
((doc (gql-parse "{ createPost(input: {title: \"Hi\", draft: true}) { id } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(let
|
||||
((val (nth (first (gql-field-args field)) 1)))
|
||||
(assert= "Hi" (get val :title))
|
||||
(assert= true (get val :draft)))))))
|
||||
|
||||
;; ── Parser: variables ─────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-variables"
|
||||
(deftest
|
||||
"parses variable definitions"
|
||||
(let
|
||||
((doc (gql-parse "query GetUser($id: ID!) { user(id: $id) { name } }")))
|
||||
(let
|
||||
((op (nth doc 1)))
|
||||
(assert= 1 (length (gql-op-vars op)))
|
||||
(let
|
||||
((vdef (first (gql-op-vars op))))
|
||||
(assert= (quote gql-var-def) (first vdef))
|
||||
(assert= "id" (nth vdef 1))
|
||||
(assert= (quote gql-non-null) (first (nth vdef 2)))))))
|
||||
(deftest
|
||||
"parses variable reference in arguments"
|
||||
(let
|
||||
((doc (gql-parse "query($id: Int) { user(id: $id) { name } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(let
|
||||
((arg-val (nth (first (gql-field-args field)) 1)))
|
||||
(assert= (quote gql-var) (first arg-val))
|
||||
(assert= "id" (nth arg-val 1))))))
|
||||
(deftest
|
||||
"parses multiple variable definitions"
|
||||
(let
|
||||
((doc (gql-parse "query($limit: Int = 10, $offset: Int) { posts { title } }")))
|
||||
(let
|
||||
((vars (gql-op-vars (nth doc 1))))
|
||||
(assert= 2 (length vars))
|
||||
(assert= "limit" (nth (first vars) 1))
|
||||
(assert= 10 (nth (first vars) 3))
|
||||
(assert= "offset" (nth (nth vars 1) 1))
|
||||
(assert= nil (nth (nth vars 1) 3)))))
|
||||
(deftest
|
||||
"parses list type in variable"
|
||||
(let
|
||||
((doc (gql-parse "query($ids: [Int!]!) { posts(ids: $ids) { title } }")))
|
||||
(let
|
||||
((vdef (first (gql-op-vars (nth doc 1)))))
|
||||
(let
|
||||
((typ (nth vdef 2)))
|
||||
(assert= (quote gql-non-null) (first typ))
|
||||
(assert= (quote gql-list-type) (first (nth typ 1))))))))
|
||||
|
||||
;; ── Parser: fragments ─────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-fragments"
|
||||
(deftest
|
||||
"parses fragment definition"
|
||||
(let
|
||||
((doc (gql-parse "fragment UserFields on User { name email }")))
|
||||
(let
|
||||
((frag (nth doc 1)))
|
||||
(assert= (quote gql-fragment) (first frag))
|
||||
(assert= "UserFields" (gql-frag-name frag))
|
||||
(assert= "User" (gql-frag-type frag))
|
||||
(assert= 2 (length (gql-frag-selections frag))))))
|
||||
(deftest
|
||||
"parses fragment spread"
|
||||
(let
|
||||
((doc (gql-parse "{ user { ...UserFields } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(let
|
||||
((spread (first (gql-field-selections field))))
|
||||
(assert= (quote gql-fragment-spread) (first spread))
|
||||
(assert= "UserFields" (nth spread 1))))))
|
||||
(deftest
|
||||
"parses inline fragment"
|
||||
(let
|
||||
((doc (gql-parse "{ node { ... on User { name } ... on Post { title } } }")))
|
||||
(let
|
||||
((sels (gql-field-selections (first (gql-op-selections (nth doc 1))))))
|
||||
(assert= 2 (length sels))
|
||||
(assert= (quote gql-inline-fragment) (first (first sels)))
|
||||
(assert= "User" (nth (first sels) 1))
|
||||
(assert= "Post" (nth (nth sels 1) 1)))))
|
||||
(deftest
|
||||
"parses multi-definition document"
|
||||
(let
|
||||
((doc (gql-parse "query GetUser { user { ...UserFields } } fragment UserFields on User { name email }")))
|
||||
(assert= 3 (length doc))
|
||||
(assert= (quote gql-query) (first (nth doc 1)))
|
||||
(assert= (quote gql-fragment) (first (nth doc 2))))))
|
||||
|
||||
;; ── Parser: directives ────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-directives"
|
||||
(deftest
|
||||
"parses field directive"
|
||||
(let
|
||||
((doc (gql-parse "{ user { name @uppercase } }")))
|
||||
(let
|
||||
((field (first (gql-field-selections (first (gql-op-selections (nth doc 1)))))))
|
||||
(assert= 1 (length (gql-field-directives field)))
|
||||
(let
|
||||
((dir (first (gql-field-directives field))))
|
||||
(assert= (quote gql-directive) (first dir))
|
||||
(assert= "uppercase" (nth dir 1))))))
|
||||
(deftest
|
||||
"parses directive with arguments"
|
||||
(let
|
||||
((doc (gql-parse "{ user { avatar @resize(width: 100, height: 100) } }")))
|
||||
(let
|
||||
((field (first (gql-field-selections (first (gql-op-selections (nth doc 1)))))))
|
||||
(let
|
||||
((dir (first (gql-field-directives field))))
|
||||
(assert= "resize" (nth dir 1))
|
||||
(assert= 2 (length (nth dir 2))))))))
|
||||
|
||||
;; ── Parser: aliases ───────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-parse-aliases"
|
||||
(deftest
|
||||
"parses field alias"
|
||||
(let
|
||||
((doc (gql-parse "{ smallPic: profilePic(size: 64) { url } }")))
|
||||
(let
|
||||
((field (first (gql-op-selections (nth doc 1)))))
|
||||
(assert= "profilePic" (gql-field-name field))
|
||||
(assert= "smallPic" (gql-field-alias field)))))
|
||||
(deftest
|
||||
"parses multiple aliased fields"
|
||||
(let
|
||||
((doc (gql-parse "{ small: pic(size: 64) { url } large: pic(size: 256) { url } }")))
|
||||
(let
|
||||
((sels (gql-op-selections (nth doc 1))))
|
||||
(assert= 2 (length sels))
|
||||
(assert= "small" (gql-field-alias (first sels)))
|
||||
(assert= "large" (gql-field-alias (nth sels 1)))
|
||||
(assert= "pic" (gql-field-name (first sels)))
|
||||
(assert= "pic" (gql-field-name (nth sels 1)))))))
|
||||
|
||||
;; ── Serializer ────────────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-serialize"
|
||||
(deftest
|
||||
"round-trips shorthand query"
|
||||
(let
|
||||
((src "query { user { name email } }"))
|
||||
(let
|
||||
((doc (gql-parse src)) (out (gql-serialize doc)))
|
||||
(let
|
||||
((doc2 (gql-parse out)))
|
||||
(assert= (quote gql-query) (first (nth doc2 1)))
|
||||
(let
|
||||
((sels (gql-op-selections (nth doc2 1))))
|
||||
(assert= 1 (length sels))
|
||||
(assert= "user" (gql-field-name (first sels))))))))
|
||||
(deftest
|
||||
"serializes mutation"
|
||||
(let
|
||||
((doc (gql-parse "mutation { createPost(title: \"Hi\") { id } }")))
|
||||
(let
|
||||
((out (gql-serialize doc)))
|
||||
(assert (string-contains? out "mutation"))
|
||||
(assert (string-contains? out "createPost"))))))
|
||||
|
||||
;; ── Executor: projection ──────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-exec-projection"
|
||||
(deftest
|
||||
"projects scalar fields"
|
||||
(let
|
||||
((data {:internal-id 999 :email "alice@test.com" :age 30 :name "Alice"})
|
||||
(sels
|
||||
(list
|
||||
(list (quote gql-field) "name" (list) (list) (list))
|
||||
(list (quote gql-field) "email" (list) (list) (list)))))
|
||||
(let
|
||||
((result (gql-project data sels {})))
|
||||
(assert= "Alice" (get result :name))
|
||||
(assert= "alice@test.com" (get result :email))
|
||||
(assert= nil (get result :age))
|
||||
(assert= nil (get result :internal-id)))))
|
||||
(deftest
|
||||
"projects nested fields"
|
||||
(let
|
||||
((data {:user {:secret "hidden" :email "bob@test.com" :name "Bob"}})
|
||||
(sels
|
||||
(list
|
||||
(list
|
||||
(quote gql-field)
|
||||
"user"
|
||||
(list)
|
||||
(list)
|
||||
(list (list (quote gql-field) "name" (list) (list) (list)))))))
|
||||
(let
|
||||
((result (gql-project data sels {})))
|
||||
(assert= "Bob" (get (get result :user) :name))
|
||||
(assert= nil (get (get result :user) :email)))))
|
||||
(deftest
|
||||
"projects over list results"
|
||||
(let
|
||||
((data (list {:x 1 :name "A"} {:x 2 :name "B"}))
|
||||
(sels
|
||||
(list (list (quote gql-field) "name" (list) (list) (list)))))
|
||||
(let
|
||||
((result (gql-project data sels {})))
|
||||
(assert= 2 (length result))
|
||||
(assert= "A" (get (first result) :name))
|
||||
(assert= nil (get (first result) :x)))))
|
||||
(deftest
|
||||
"handles nil data"
|
||||
(assert= nil (gql-project nil (list) {})))
|
||||
(deftest
|
||||
"empty selections returns full data"
|
||||
(let
|
||||
((data {:age 30 :name "Alice"}))
|
||||
(assert= data (gql-project data (list) {})))))
|
||||
|
||||
;; ── Executor: full execution ──────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-exec-execute"
|
||||
(deftest
|
||||
"executes with custom resolver"
|
||||
(let
|
||||
((doc (gql-parse "{ user(id: 1) { name email } }"))
|
||||
(resolver
|
||||
(fn
|
||||
(field-name args op-type)
|
||||
(if (= field-name "user") {:email "alice@test.com" :age 30 :name "Alice"} nil))))
|
||||
(let
|
||||
((result (gql-execute doc {} resolver)))
|
||||
(assert= "Alice" (get (get (get result :data) :user) :name))
|
||||
(assert=
|
||||
"alice@test.com"
|
||||
(get (get (get result :data) :user) :email))
|
||||
(assert= nil (get (get (get result :data) :user) :age)))))
|
||||
(deftest
|
||||
"passes arguments to resolver"
|
||||
(let
|
||||
((doc (gql-parse "{ post(slug: \"hello\") { title } }"))
|
||||
(resolver
|
||||
(fn
|
||||
(field-name args op-type)
|
||||
(if
|
||||
(and (= field-name "post") (= (get args :slug) "hello"))
|
||||
{:title "Hello World"}
|
||||
{:title "Not Found"}))))
|
||||
(let
|
||||
((result (gql-execute doc {} resolver)))
|
||||
(assert= "Hello World" (get (get (get result :data) :post) :title)))))
|
||||
(deftest
|
||||
"reports operation type to resolver"
|
||||
(let
|
||||
((doc (gql-parse "mutation { deletePost(id: 1) { success } }"))
|
||||
(seen-type nil)
|
||||
(resolver
|
||||
(fn (field-name args op-type) (set! seen-type op-type) {:success true})))
|
||||
(gql-execute doc {} resolver)
|
||||
(assert= (quote gql-mutation) seen-type)))
|
||||
(deftest
|
||||
"substitutes variables"
|
||||
(let
|
||||
((doc (gql-parse "query($id: Int) { user(id: $id) { name } }"))
|
||||
(resolver (fn (field-name args op-type) {:name (str "User-" (get args :id))})))
|
||||
(let
|
||||
((result (gql-execute doc {:id 42} resolver)))
|
||||
(assert= "User-42" (get (get (get result :data) :user) :name)))))
|
||||
(deftest
|
||||
"handles multiple root fields"
|
||||
(let
|
||||
((doc (gql-parse "{ user { name } settings { theme } }"))
|
||||
(resolver
|
||||
(fn
|
||||
(field-name args op-type)
|
||||
(cond
|
||||
((= field-name "user") {:name "Alice"})
|
||||
((= field-name "settings") {:theme "dark"})
|
||||
(true nil)))))
|
||||
(let
|
||||
((result (gql-execute doc {} resolver)))
|
||||
(assert= "Alice" (get (get (get result :data) :user) :name))
|
||||
(assert= "dark" (get (get (get result :data) :settings) :theme)))))
|
||||
(deftest
|
||||
"handles aliased fields"
|
||||
(let
|
||||
((doc (gql-parse "{ me: user(id: 1) { name } them: user(id: 2) { name } }"))
|
||||
(resolver (fn (field-name args op-type) {:name (str "User-" (get args :id))})))
|
||||
(let
|
||||
((result (gql-execute doc {} resolver)))
|
||||
(assert= "User-1" (get (get (get result :data) :me) :name))
|
||||
(assert= "User-2" (get (get (get result :data) :them) :name)))))
|
||||
(deftest
|
||||
"returns error when no operation"
|
||||
(let
|
||||
((doc (gql-parse "fragment F on User { name }")))
|
||||
(let
|
||||
((result (gql-execute doc {} (fn (f a t) nil))))
|
||||
(assert (not (nil? (get result :errors))))))))
|
||||
|
||||
;; ── Executor: fragments ───────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-exec-fragments"
|
||||
(deftest
|
||||
"resolves fragment spread in projection"
|
||||
(let
|
||||
((fragments {:UserFields (list (quote gql-fragment) "UserFields" "User" (list) (list (list (quote gql-field) "name" (list) (list) (list)) (list (quote gql-field) "email" (list) (list) (list))))})
|
||||
(data {:email "a@test.com" :age 30 :name "Alice"})
|
||||
(sels
|
||||
(list (list (quote gql-fragment-spread) "UserFields" (list)))))
|
||||
(let
|
||||
((result (gql-project data sels fragments)))
|
||||
(assert= "Alice" (get result :name))
|
||||
(assert= "a@test.com" (get result :email))
|
||||
(assert= nil (get result :age)))))
|
||||
(deftest
|
||||
"collects fragments from document"
|
||||
(let
|
||||
((doc (gql-parse "query { user { ...F } } fragment F on User { name }")))
|
||||
(let
|
||||
((frags (gql-collect-fragments doc)))
|
||||
(assert (not (nil? (get frags :F))))
|
||||
(assert= "User" (gql-frag-type (get frags :F)))))))
|
||||
|
||||
;; ── Executor: introspection helpers ───────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"gql-exec-introspection"
|
||||
(deftest
|
||||
"extracts operation names"
|
||||
(let
|
||||
((doc (gql-parse "query GetUser { user { name } } mutation CreatePost { create { id } }")))
|
||||
(let
|
||||
((names (gql-operation-names doc)))
|
||||
(assert= 2 (length names))
|
||||
(assert (some (fn (n) (= n "GetUser")) names))
|
||||
(assert (some (fn (n) (= n "CreatePost")) names)))))
|
||||
(deftest
|
||||
"extracts variable definitions"
|
||||
(let
|
||||
((doc (gql-parse "query($id: ID!, $name: String) { user { name } }")))
|
||||
(let
|
||||
((vars (gql-extract-variables doc)))
|
||||
(assert= 2 (length vars))
|
||||
(assert= "id" (nth (first vars) 1))
|
||||
(assert= "name" (nth (nth vars 1) 1))))))
|
||||
|
||||
;; ── Hyperscript integration: parser ───────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"hs-fetch-gql-parse"
|
||||
(deftest
|
||||
"fetch gql with braces parses to fetch-gql AST"
|
||||
(let
|
||||
((ast (hs-compile "fetch gql { user { name } }")))
|
||||
(assert= (quote fetch-gql) (first ast))
|
||||
(assert (string-contains? (nth ast 1) "user"))
|
||||
(assert (string-contains? (nth ast 1) "name"))
|
||||
(assert= nil (nth ast 2))))
|
||||
(deftest
|
||||
"fetch gql with from URL"
|
||||
(let
|
||||
((ast (hs-compile "fetch gql { posts { title } } from \"/api/graphql\"")))
|
||||
(assert= (quote fetch-gql) (first ast))
|
||||
(assert (string-contains? (nth ast 1) "posts"))
|
||||
(assert= "/api/graphql" (nth ast 2))))
|
||||
(deftest
|
||||
"fetch gql query keyword"
|
||||
(let
|
||||
((ast (hs-compile "fetch gql query { user { name } }")))
|
||||
(assert= (quote fetch-gql) (first ast))
|
||||
(assert (string-contains? (nth ast 1) "query"))
|
||||
(assert (string-contains? (nth ast 1) "user"))))
|
||||
(deftest
|
||||
"fetch gql mutation keyword"
|
||||
(let
|
||||
((ast (hs-compile "fetch gql mutation { createPost { id } }")))
|
||||
(assert= (quote fetch-gql) (first ast))
|
||||
(assert (string-contains? (nth ast 1) "mutation"))
|
||||
(assert (string-contains? (nth ast 1) "createPost"))))
|
||||
(deftest
|
||||
"fetch gql with nested braces"
|
||||
(let
|
||||
((ast (hs-compile "fetch gql { user(id: 1) { posts { title } } }")))
|
||||
(assert= (quote fetch-gql) (first ast))
|
||||
(assert (string-contains? (nth ast 1) "posts"))
|
||||
(assert (string-contains? (nth ast 1) "title"))))
|
||||
(deftest
|
||||
"regular fetch still works"
|
||||
(let
|
||||
((ast (hs-compile "fetch \"/api/data\" as json")))
|
||||
(assert= (quote fetch) (first ast))
|
||||
(assert= "/api/data" (nth ast 1))
|
||||
(assert= "json" (nth ast 2)))))
|
||||
|
||||
;; ── Hyperscript integration: compiler ─────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"hs-fetch-gql-compile"
|
||||
(deftest
|
||||
"compiles fetch gql to hs-fetch-gql call"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "fetch gql { user { name } }")))
|
||||
(assert= (quote hs-fetch-gql) (first sx))
|
||||
(assert (string? (nth sx 1)))
|
||||
(assert= nil (nth sx 2))))
|
||||
(deftest
|
||||
"compiles fetch gql with from URL"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "fetch gql { posts { title } } from \"/api\"")))
|
||||
(assert= (quote hs-fetch-gql) (first sx))
|
||||
(assert= "/api" (nth sx 2)))))
|
||||
91
sx/sx/applications/graphql/executor/index.sx
Normal file
91
sx/sx/applications/graphql/executor/index.sx
Normal file
@@ -0,0 +1,91 @@
|
||||
;; GraphQL: executor — live execute against /api.execute-demo
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Executor"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-2")
|
||||
"The executor in "
|
||||
(code "lib/graphql-exec.sx")
|
||||
" walks the parsed AST, dispatches root fields to a resolver, "
|
||||
"and projects each result down to the selected fields.")
|
||||
(p
|
||||
(~tw :tokens "text-gray-500 mb-6")
|
||||
"The endpoint below uses a static seed dataset (users, posts, comments) "
|
||||
"and a resolver written in plain SX. The same bytecode runs the docs site test suite.")
|
||||
(~docs/section
|
||||
:title "Seed data"
|
||||
:id "seed"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Three tables, hardcoded in the handler file. No database required — "
|
||||
"every query and mutation hits this in-memory store.")
|
||||
(~docs/code
|
||||
:src "(define gql-seed-users\n (list\n {:id 1 :name \"Alice\" :email \"alice@test.com\" :role \"admin\"}\n {:id 2 :name \"Bob\" :email \"bob@test.com\" :role \"user\"}\n {:id 3 :name \"Carol\" :email \"carol@test.com\" :role \"user\"}))\n\n(define gql-seed-posts\n (list\n {:id 101 :authorId 1 :title \"Hello, world\" :body \"First post in SX GraphQL.\"}\n {:id 102 :authorId 2 :title \"GraphQL in SX\" :body \"Every op compiles to bytecode.\"}\n {:id 103 :authorId 1 :title \"Quiet night\" :body \"Just thinking about parsers.\"}))\n\n(define gql-seed-comments\n (list\n {:id 1001 :postId 101 :authorId 2 :text \"Nice one.\"}\n {:id 1002 :postId 102 :authorId 3 :text \"Compiled to bytecode?!\"}\n {:id 1003 :postId 102 :authorId 1 :text \"Yes — every op is CEK.\"}))"))
|
||||
(~docs/section
|
||||
:title "Resolver"
|
||||
:id "resolver"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"The resolver receives "
|
||||
(code "(field-name args-dict op-type)")
|
||||
" per root field. Return a scalar, a dict, or a list of dicts — "
|
||||
"the executor projects it down to the requested selection set.")
|
||||
(~docs/code
|
||||
:src "(define gql-seed-resolve\n (fn (field-name args op-type)\n (cond\n ((= field-name \"user\")\n (gql-find-by-id gql-seed-users (get args :id)))\n ((= field-name \"users\") gql-seed-users)\n ((= field-name \"post\")\n (gql-find-by-id gql-seed-posts (get args :id)))\n ((= field-name \"posts\")\n (let ((author-id (get args :authorId)))\n (if author-id\n (gql-filter-by gql-seed-posts :authorId author-id)\n gql-seed-posts)))\n ((= field-name \"comments\")\n (let ((post-id (get args :postId)))\n (if post-id\n (gql-filter-by gql-seed-comments :postId post-id)\n gql-seed-comments)))\n ((= field-name \"echo\") (get args :message))\n ((= field-name \"createPost\")\n {:id 999\n :title (get args :title)\n :body (get args :body)\n :authorId (get args :authorId)})\n ((= field-name \"likePost\")\n {:id (get args :id) :liked true})\n (true nil))))"))
|
||||
(~docs/section
|
||||
:title "Live endpoint"
|
||||
:id "endpoint"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"POST "
|
||||
(code "/sx/(applications.(graphql.(api.execute-demo)))")
|
||||
" with form fields "
|
||||
(code "query")
|
||||
" and optional "
|
||||
(code "variables")
|
||||
" (an SX dict literal like "
|
||||
(code "{:id 1}")
|
||||
").")
|
||||
(~docs/code
|
||||
:src "(defhandler\n gql-execute-demo\n :path \"/sx/(applications.(graphql.(api.execute-demo)))\"\n :method :post\n :csrf false\n :returns \"text\"\n (&key query variables)\n (let ((doc (gql-parse query))\n (vars-dict (gql-parse-vars variables)))\n (let ((result (gql-execute doc vars-dict gql-seed-resolve)))\n (str\n \"<pre>\" (escape (sx-serialize vars-dict)) \"</pre>\"\n \"<pre>\" (escape (sx-serialize result)) \"</pre>\")))))"))
|
||||
(~docs/section
|
||||
:title "Try it"
|
||||
:id "try"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"The query is sent straight to the handler; the result is projected to your selection set.")
|
||||
(form
|
||||
(~tw :tokens "space-y-3")
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#exec-out"
|
||||
:hx-swap "innerHTML"
|
||||
(label
|
||||
(~tw :tokens "block text-sm font-medium text-gray-700")
|
||||
"Query")
|
||||
(textarea
|
||||
:name "query"
|
||||
:rows "7"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"query Q($id: ID!) {\n post(id: $id) {\n title\n body\n authorId\n }\n}")
|
||||
(label
|
||||
(~tw :tokens "block text-sm font-medium text-gray-700")
|
||||
"Variables")
|
||||
(textarea
|
||||
:name "variables"
|
||||
:rows "2"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"{:id 102}")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Execute"))
|
||||
(div
|
||||
:id "exec-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Variables + result will appear here.")))))
|
||||
64
sx/sx/applications/graphql/fetch-gql/index.sx
Normal file
64
sx/sx/applications/graphql/fetch-gql/index.sx
Normal file
@@ -0,0 +1,64 @@
|
||||
;; GraphQL: hyperscript integration — fetch gql command
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · fetch gql"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-2")
|
||||
"The "
|
||||
(code "fetch gql")
|
||||
" hyperscript command embeds GraphQL queries directly in attribute syntax. "
|
||||
"The hyperscript parser collects the GraphQL body between "
|
||||
(code "{")
|
||||
" and "
|
||||
(code "}")
|
||||
" and the compiler emits a "
|
||||
(code "hs-fetch-gql")
|
||||
" call.")
|
||||
(p
|
||||
(~tw :tokens "text-gray-500 mb-6")
|
||||
"Compilation happens server-side at page boot; the runtime dispatch "
|
||||
"hits the same "
|
||||
(code "/api.execute-demo")
|
||||
" endpoint these pages use.")
|
||||
(~docs/section
|
||||
:title "Shorthand query"
|
||||
:id "shorthand"
|
||||
(~docs/code
|
||||
:src "<button _=\"on click\n fetch gql { users { name role } }\n put result.data.users into #fetch-out\">\n Fetch users\n</button>"))
|
||||
(~docs/section
|
||||
:title "Named operation"
|
||||
:id "named"
|
||||
(~docs/code
|
||||
:src "<input _=\"on input\n fetch gql query Search($q: String!) { posts(authorId: 1) { title } } with vars\n put result.data.posts into #search-out\">"))
|
||||
(~docs/section
|
||||
:title "Mutation"
|
||||
:id "mutation"
|
||||
(~docs/code
|
||||
:src "<form _=\"on submit\n fetch gql mutation { createPost(title: 'Hi', body: 'body', authorId: 1) { id } }\n put it into #create-out\">"))
|
||||
(~docs/section
|
||||
:title "Custom endpoint"
|
||||
:id "from"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Override the default "
|
||||
(code "/graphql")
|
||||
" path per-call with "
|
||||
(code "from"))
|
||||
(~docs/code
|
||||
:src "<button _=\"on click\n fetch gql { users { name } } from '/sx/(applications.(graphql.(api.execute-demo)))'\n put result into #users-out\">"))
|
||||
(~docs/section
|
||||
:title "Compilation pipeline"
|
||||
:id "pipeline"
|
||||
(~docs/note
|
||||
(p
|
||||
(strong "Same bytecode path. ")
|
||||
"The hyperscript tokenizer, parser, compiler, and bytecode runtime "
|
||||
"all live in "
|
||||
(code "lib/hyperscript/")
|
||||
". The GraphQL parser and executor "
|
||||
"live in "
|
||||
(code "lib/graphql.sx")
|
||||
" and "
|
||||
(code "lib/graphql-exec.sx")
|
||||
". Every piece compiles to the same kernel.")))))
|
||||
70
sx/sx/applications/graphql/fragments/index.sx
Normal file
70
sx/sx/applications/graphql/fragments/index.sx
Normal file
@@ -0,0 +1,70 @@
|
||||
;; GraphQL: fragments — live fragment spreads against /api.execute-demo
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Fragments"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-6")
|
||||
"Fragment definitions collect reusable field sets. Spreads inline them during projection. "
|
||||
"The executor applies them unconditionally — type checking is available in "
|
||||
(code "spec/types.sx")
|
||||
" but not required here.")
|
||||
(~docs/section
|
||||
:title "Named fragment"
|
||||
:id "named"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Define "
|
||||
(code "UserFields")
|
||||
" once, use it wherever a "
|
||||
(code "User")
|
||||
" appears.")
|
||||
(~docs/code
|
||||
:src "query {\n alice: user(id: 1) { ...UserFields }\n bob: user(id: 2) { ...UserFields }\n}\n\nfragment UserFields on User {\n name\n email\n role\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#frag-named-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "query { alice: user(id: 1) { ...UserFields } bob: user(id: 2) { ...UserFields } } fragment UserFields on User { name email role }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "frag-named-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Result will appear here.")))
|
||||
(~docs/section
|
||||
:title "Inline fragment"
|
||||
:id "inline"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Inline fragments work without a name — the executor treats them the same way "
|
||||
"and projects their selection set into the parent.")
|
||||
(~docs/code
|
||||
:src "{\n post(id: 101) {\n title\n ... on Post {\n authorId\n body\n }\n }\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#frag-inline-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "{ post(id: 101) { title ... on Post { authorId body } } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "frag-inline-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Result will appear here.")))))
|
||||
78
sx/sx/applications/graphql/mutation/index.sx
Normal file
78
sx/sx/applications/graphql/mutation/index.sx
Normal file
@@ -0,0 +1,78 @@
|
||||
;; GraphQL: mutation — live createPost, likePost
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Mutations"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-6")
|
||||
"Mutations reach the resolver with "
|
||||
(code "op-type")
|
||||
" = "
|
||||
(code "'gql-mutation")
|
||||
". The demo resolver returns a synthesized record. "
|
||||
"In production SX, mutations map to "
|
||||
(code "defaction")
|
||||
" via IO suspension.")
|
||||
(~docs/section
|
||||
:title "createPost"
|
||||
:id "create"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Typed variables let the client pass structured input without inlining strings.")
|
||||
(~docs/code
|
||||
:src "mutation NewPost($title: String!, $body: String!, $authorId: ID!) {\n createPost(title: $title, body: $body, authorId: $authorId) {\n id\n title\n authorId\n }\n}")
|
||||
(form
|
||||
(~tw :tokens "space-y-3")
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#mut-create-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "mutation NewPost($title: String!, $body: String!, $authorId: ID!) { createPost(title: $title, body: $body, authorId: $authorId) { id title authorId } }")
|
||||
(label
|
||||
(~tw :tokens "block text-sm font-medium text-gray-700")
|
||||
"Variables")
|
||||
(textarea
|
||||
:name "variables"
|
||||
:rows "3"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"{:title \"Fresh take\" :body \"Bytecode FTW\" :authorId 1}")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run mutation"))
|
||||
(div
|
||||
:id "mut-create-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Response will appear here.")))
|
||||
(~docs/section
|
||||
:title "likePost"
|
||||
:id "like"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"A minimal mutation with a single argument.")
|
||||
(~docs/code :src "mutation { likePost(id: 102) { id liked } }")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#mut-like-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "mutation { likePost(id: 102) { id liked } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "mut-like-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Response will appear here.")))))
|
||||
64
sx/sx/applications/graphql/parser/index.sx
Normal file
64
sx/sx/applications/graphql/parser/index.sx
Normal file
@@ -0,0 +1,64 @@
|
||||
;; GraphQL: parser — live parse against /api.parse-demo
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Parser"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-2")
|
||||
"The tokenizer and recursive-descent parser live in "
|
||||
(code "lib/graphql.sx")
|
||||
". Feed them any GraphQL source and get an s-expression AST.")
|
||||
(p
|
||||
(~tw :tokens "text-gray-500 mb-6")
|
||||
"The server endpoint below parses the query, pretty-prints the AST, "
|
||||
"and round-trips it back through "
|
||||
(code "gql-serialize")
|
||||
".")
|
||||
(~docs/section
|
||||
:title "Server endpoint"
|
||||
:id "endpoint"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"This is the live handler. It's the same bytecode the test suite exercises.")
|
||||
(~docs/code
|
||||
:src "(defhandler\n gql-parse-demo\n :path \"/sx/(applications.(graphql.(api.parse-demo)))\"\n :method :get\n :returns \"text\"\n (&key source)\n (if (or (nil? source) (empty? source))\n \"<p>Enter a GraphQL query and click Parse.</p>\"\n (let ((doc (gql-parse source)))\n (str\n \"<pre>\" (escape (sx-serialize doc)) \"</pre>\"\n \"<pre>\" (escape (gql-serialize doc)) \"</pre>\")))))"))
|
||||
(~docs/section
|
||||
:title "Try it"
|
||||
:id "try"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Type a query, click Parse. The form posts via HTMX to the handler above — "
|
||||
"response drops straight into "
|
||||
(code "#parse-out")
|
||||
".")
|
||||
(form
|
||||
(~tw :tokens "space-y-3")
|
||||
:hx-get "/sx/(applications.(graphql.(api.parse-demo)))"
|
||||
:hx-target "#parse-out"
|
||||
:hx-swap "innerHTML"
|
||||
:hx-trigger "submit, input from:textarea[name='source'] changed delay:400ms"
|
||||
(textarea
|
||||
:name "source"
|
||||
:rows "6"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"{\n user(id: 1) {\n name\n email\n }\n}")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Parse"))
|
||||
(div
|
||||
:id "parse-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Output will appear here.")))
|
||||
(~docs/section
|
||||
:title "AST node types"
|
||||
:id "nodes"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Every GraphQL concept becomes a named s-expression:")
|
||||
(~docs/code
|
||||
:src "(gql-doc definitions...)\n(gql-query name vars directives selections)\n(gql-mutation name vars directives selections)\n(gql-subscription name vars directives selections)\n(gql-field name args directives selections [alias])\n(gql-fragment name on-type directives selections)\n(gql-fragment-spread name directives)\n(gql-inline-fragment on-type directives selections)\n(gql-var name)\n(gql-var-def name type default)\n(gql-directive name args)"))))
|
||||
113
sx/sx/applications/graphql/queries/index.sx
Normal file
113
sx/sx/applications/graphql/queries/index.sx
Normal file
@@ -0,0 +1,113 @@
|
||||
;; GraphQL: query — three live queries against /api.execute-demo
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Queries"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-6")
|
||||
"Three live queries. Each button posts a canned query to "
|
||||
(code "/api.execute-demo")
|
||||
" and drops the raw SX result into the output below.")
|
||||
(~docs/section
|
||||
:title "Single record"
|
||||
:id "single"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Fetch one user by id. The executor projects the seed row to just the selected fields.")
|
||||
(~docs/code :src "{\n user(id: 1) {\n name\n role\n }\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#q-single-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "{ user(id: 1) { name role } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "q-single-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span (~tw :tokens "text-gray-400 text-sm") "Click Run to execute.")))
|
||||
(~docs/section
|
||||
:title "List"
|
||||
:id "list"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Fetch all posts. The resolver returns a list of dicts; "
|
||||
"the executor maps projection over each element.")
|
||||
(~docs/code :src "{\n posts {\n id\n title\n authorId\n }\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#q-list-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "{ posts { id title authorId } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "q-list-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span (~tw :tokens "text-gray-400 text-sm") "Click Run to execute.")))
|
||||
(~docs/section
|
||||
:title "Filtered list"
|
||||
:id "filter"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Arguments reach the resolver via the "
|
||||
(code "args")
|
||||
" dict. "
|
||||
"Here, "
|
||||
(code "authorId: 1")
|
||||
" narrows to posts by Alice.")
|
||||
(~docs/code :src "{\n posts(authorId: 1) {\n title\n body\n }\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#q-filter-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "{ posts(authorId: 1) { title body } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "q-filter-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span (~tw :tokens "text-gray-400 text-sm") "Click Run to execute.")))
|
||||
(~docs/section
|
||||
:title "Multiple root fields"
|
||||
:id "multi"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"A single query can dispatch many root fields. "
|
||||
"The executor resolves each independently and merges the results.")
|
||||
(~docs/code :src "{\n users { name }\n posts { title }\n}")
|
||||
(form
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#q-multi-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "{ users { name } posts { title } }")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "q-multi-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span (~tw :tokens "text-gray-400 text-sm") "Click Run to execute.")))))
|
||||
100
sx/sx/applications/graphql/vars/index.sx
Normal file
100
sx/sx/applications/graphql/vars/index.sx
Normal file
@@ -0,0 +1,100 @@
|
||||
;; GraphQL: variables — live variable substitution
|
||||
(defcomp
|
||||
()
|
||||
(~docs/page
|
||||
:title "GraphQL · Variables"
|
||||
(p
|
||||
(~tw :tokens "text-lg text-gray-600 mb-6")
|
||||
"Variable references become "
|
||||
(code "(gql-var name)")
|
||||
" nodes. "
|
||||
"At execution, the executor walks the AST and substitutes bound values. "
|
||||
"The demo accepts an SX dict literal in the "
|
||||
(code "variables")
|
||||
" form field.")
|
||||
(~docs/section
|
||||
:title "Scalar variable"
|
||||
:id "scalar"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"One typed variable, used in a field argument. "
|
||||
"Change the dict on the right and click Run — the resolver receives the new value.")
|
||||
(~docs/code
|
||||
:src "query ByAuthor($author: Int!) {\n posts(authorId: $author) {\n title\n body\n }\n}\n\n# Variables (SX dict literal):\n# {:author 2}")
|
||||
(form
|
||||
(~tw :tokens "space-y-3")
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#var-scalar-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "query ByAuthor($author: Int!) { posts(authorId: $author) { title body } }")
|
||||
(label
|
||||
(~tw :tokens "block text-sm font-medium text-gray-700")
|
||||
"Variables")
|
||||
(textarea
|
||||
:name "variables"
|
||||
:rows "2"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"{:author 2}")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "var-scalar-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Result will appear here.")))
|
||||
(~docs/section
|
||||
:title "Default value"
|
||||
:id "default"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"Leave the variables empty and the parser default kicks in — "
|
||||
"executed against the seed, "
|
||||
(code "id: 1")
|
||||
" resolves to Alice.")
|
||||
(~docs/code
|
||||
:src "query GetUser($id: ID = 1) {\n user(id: $id) { name role }\n}")
|
||||
(form
|
||||
(~tw :tokens "space-y-3")
|
||||
:hx-post "/sx/(applications.(graphql.(api.execute-demo)))"
|
||||
:hx-target "#var-default-out"
|
||||
:hx-swap "innerHTML"
|
||||
(input
|
||||
:type "hidden"
|
||||
:name "query"
|
||||
:value "query GetUser($id: ID = 1) { user(id: $id) { name role } }")
|
||||
(label
|
||||
(~tw :tokens "block text-sm font-medium text-gray-700")
|
||||
"Variables (leave blank for default)")
|
||||
(textarea
|
||||
:name "variables"
|
||||
:rows "2"
|
||||
(~tw
|
||||
:tokens "w-full font-mono text-sm p-3 border border-gray-300 rounded-lg")
|
||||
"")
|
||||
(button
|
||||
:type "submit"
|
||||
(~tw
|
||||
:tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700")
|
||||
"Run"))
|
||||
(div
|
||||
:id "var-default-out"
|
||||
(~tw :tokens "mt-4")
|
||||
(span
|
||||
(~tw :tokens "text-gray-400 text-sm")
|
||||
"Result will appear here.")))
|
||||
(~docs/section
|
||||
:title "Pure SX"
|
||||
:id "parse"
|
||||
(p
|
||||
(~tw :tokens "text-gray-600 mb-3")
|
||||
"The variables payload is parsed with the same SX reader the rest of the language uses:")
|
||||
(~docs/code
|
||||
:src "(define gql-parse-vars\n (fn (source)\n (if (or (nil? source) (empty? source))\n {}\n (let ((parsed (parse source)))\n (if (dict? parsed) parsed {})))))"))))
|
||||
Reference in New Issue
Block a user