coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity
Files
c5e2bc2fe1a7e1759a7fcfce63840dc34504bc55
rose-ash/spec/tests/test-graphql.sx
giles fc24cc704d 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>
2026-04-22 09:08:00 +00:00

677 lines
25 KiB
Plaintext
Raw Blame History

;; 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)))))
Reference in New Issue View Git Blame Copy Permalink