;; 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)))))