;; ========================================================================== ;; test-router.sx — Tests for client-side route matching & SX URL algebra ;; ;; Requires: test-framework.sx loaded first. ;; Modules tested: router.sx ;; ;; No additional platform functions needed — router.sx is pure. ;; ========================================================================== ;; -------------------------------------------------------------------------- ;; split-path-segments ;; -------------------------------------------------------------------------- (defsuite "split-path-segments" (deftest "root path" (assert-equal (list) (split-path-segments "/"))) (deftest "single segment" (assert-equal (list "docs") (split-path-segments "/docs"))) (deftest "multiple segments" (assert-equal (list "docs" "hello") (split-path-segments "/docs/hello"))) (deftest "trailing slash stripped" (assert-equal (list "docs") (split-path-segments "/docs/"))) (deftest "deep path" (assert-equal (list "a" "b" "c" "d") (split-path-segments "/a/b/c/d")))) ;; -------------------------------------------------------------------------- ;; parse-route-pattern ;; -------------------------------------------------------------------------- (defsuite "parse-route-pattern" (deftest "static pattern" (let ((segs (parse-route-pattern "/docs/intro"))) (assert-length 2 segs) (assert-equal "literal" (get (first segs) "type")) (assert-equal "docs" (get (first segs) "value")) (assert-equal "literal" (get (nth segs 1) "type")) (assert-equal "intro" (get (nth segs 1) "value")))) (deftest "pattern with param" (let ((segs (parse-route-pattern "/docs/"))) (assert-length 2 segs) (assert-equal "literal" (get (first segs) "type")) (assert-equal "docs" (get (first segs) "value")) (assert-equal "param" (get (nth segs 1) "type")) (assert-equal "slug" (get (nth segs 1) "value")))) (deftest "multiple params" (let ((segs (parse-route-pattern "/users//posts/"))) (assert-length 4 segs) (assert-equal "param" (get (nth segs 1) "type")) (assert-equal "uid" (get (nth segs 1) "value")) (assert-equal "param" (get (nth segs 3) "type")) (assert-equal "pid" (get (nth segs 3) "value")))) (deftest "root pattern" (assert-equal (list) (parse-route-pattern "/")))) ;; -------------------------------------------------------------------------- ;; match-route ;; -------------------------------------------------------------------------- (defsuite "match-route" (deftest "exact match returns empty params" (let ((result (match-route "/docs/intro" "/docs/intro"))) (assert-true (not (nil? result))) (assert-length 0 (keys result)))) (deftest "param match extracts value" (let ((result (match-route "/docs/hello" "/docs/"))) (assert-true (not (nil? result))) (assert-equal "hello" (get result "slug")))) (deftest "no match returns nil" (assert-nil (match-route "/docs/hello" "/essays/")) (assert-nil (match-route "/docs" "/docs/"))) (deftest "segment count mismatch returns nil" (assert-nil (match-route "/a/b/c" "/a/")) (assert-nil (match-route "/a" "/a/b"))) (deftest "root matches root" (let ((result (match-route "/" "/"))) (assert-true (not (nil? result))))) (deftest "multiple params extracted" (let ((result (match-route "/users/42/posts/99" "/users//posts/"))) (assert-true (not (nil? result))) (assert-equal "42" (get result "uid")) (assert-equal "99" (get result "pid"))))) ;; -------------------------------------------------------------------------- ;; find-matching-route ;; -------------------------------------------------------------------------- (defsuite "find-matching-route" (deftest "finds first matching route" (let ((routes (list {:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-index"} {:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-page"}))) (let ((result (find-matching-route "/docs/hello" routes))) (assert-true (not (nil? result))) (assert-equal "docs-page" (get result "name")) (assert-equal "hello" (get (get result "params") "slug"))))) (deftest "returns nil for no match" (let ((routes (list {:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-page"}))) (assert-nil (find-matching-route "/essays/hello" routes)))) (deftest "matches exact routes before param routes" (let ((routes (list {:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-index"} {:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-page"}))) (let ((result (find-matching-route "/docs/" routes))) (assert-true (not (nil? result))) (assert-equal "docs-index" (get result "name"))))) (deftest "propagates stream flag from route" (let ((routes (list {:pattern "/demo/streaming" :parsed (parse-route-pattern "/demo/streaming") :name "streaming-demo" :stream true :has-data true}))) (let ((result (find-matching-route "/demo/streaming" routes))) (assert-true (not (nil? result))) (assert-equal true (get result "stream")) (assert-equal true (get result "has-data"))))) (deftest "non-streaming route has no stream flag" (let ((routes (list {:pattern "/about" :parsed (parse-route-pattern "/about") :name "about" :has-data false}))) (let ((result (find-matching-route "/about" routes))) (assert-true (not (nil? result))) (assert-nil (get result "stream")))))) ;; -------------------------------------------------------------------------- ;; sx-url-to-path — SX expression URL → old-style path ;; -------------------------------------------------------------------------- (defsuite "sx-url-to-path" (deftest "simple two-level" (assert-equal "/language/docs/introduction" (sx-url-to-path "/(language.(doc.introduction))"))) (deftest "deep nesting" (assert-equal "/geography/hypermedia/reference/attributes" (sx-url-to-path "/(geography.(hypermedia.(reference.attributes)))"))) (deftest "section index" (assert-equal "/language" (sx-url-to-path "/(language)"))) (deftest "function name mapping — doc to docs" (assert-equal "/language/docs/getting-started" (sx-url-to-path "/(language.(doc.getting-started))"))) (deftest "function name mapping — spec to specs" (assert-equal "/language/specs/core" (sx-url-to-path "/(language.(spec.core))"))) (deftest "function name mapping — example to examples" (assert-equal "/geography/hypermedia/examples/click-to-load" (sx-url-to-path "/(geography.(hypermedia.(example.click-to-load)))"))) (deftest "function name mapping — essay to essays" (assert-equal "/etc/essays/sx-sucks" (sx-url-to-path "/(etc.(essay.sx-sucks))"))) (deftest "function name mapping — plan to plans" (assert-equal "/etc/plans/spec-explorer" (sx-url-to-path "/(etc.(plan.spec-explorer))"))) (deftest "function name mapping — test to testing" (assert-equal "/language/testing/eval" (sx-url-to-path "/(language.(test.eval))"))) (deftest "function name mapping — bootstrapper to bootstrappers" (assert-equal "/language/bootstrappers/python" (sx-url-to-path "/(language.(bootstrapper.python))"))) (deftest "function name mapping — protocol to protocols" (assert-equal "/applications/protocols/wire-format" (sx-url-to-path "/(applications.(protocol.wire-format))"))) (deftest "function name mapping — reference-detail to reference" (assert-equal "/geography/hypermedia/reference/attributes" (sx-url-to-path "/(geography.(hypermedia.(reference-detail.attributes)))"))) (deftest "non-SX URL returns nil" (assert-nil (sx-url-to-path "/language/docs/introduction")) (assert-nil (sx-url-to-path "https://example.com")))) ;; -------------------------------------------------------------------------- ;; find-matching-route with SX URLs ;; -------------------------------------------------------------------------- (defsuite "find-matching-route-sx-urls" (deftest "SX URL auto-converts for matching" (let ((routes (list {:pattern "/language/docs/" :parsed (parse-route-pattern "/language/docs/") :name "docs-page"}))) (let ((result (find-matching-route "/(language.(doc.introduction))" routes))) (assert-true (not (nil? result))) (assert-equal "docs-page" (get result "name")) (assert-equal "introduction" (get (get result "params") "slug")))))) ;; ========================================================================== ;; SX URL Resolution — Structural Navigation ;; ========================================================================== (defsuite "relative-sx-url?" (deftest "paren-form relative" (assert-true (relative-sx-url? "(.slug)")) (assert-true (relative-sx-url? "(..)")) (assert-true (relative-sx-url? "(..reactive.demo)"))) (deftest "bare-dot relative" (assert-true (relative-sx-url? ".slug")) (assert-true (relative-sx-url? "..")) (assert-true (relative-sx-url? "...")) (assert-true (relative-sx-url? ".:page.4"))) (deftest "absolute URLs are not relative" (assert-false (relative-sx-url? "/(language.(doc.intro))")) (assert-false (relative-sx-url? "/")) (assert-false (relative-sx-url? "/language/docs/intro"))) (deftest "special form URLs are not relative" (assert-false (relative-sx-url? "/(!source.(~essay))")))) ;; -------------------------------------------------------------------------- ;; Structural: append at current level (1 dot) ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: append (.slug)" (deftest "append to deep URL" (assert-equal "/(geography.(hypermedia.(example.progress-bar)))" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(.progress-bar)"))) (deftest "append to single-level URL" (assert-equal "/(language.intro)" (resolve-relative-url "/(language)" "(.intro)"))) (deftest "append with multi-token body" (assert-equal "/(geography.(hypermedia.(example.progress-bar.v2)))" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(.progress-bar.v2)"))) (deftest "bare-dot shorthand" (assert-equal "/(geography.(hypermedia.(example.progress-bar)))" (resolve-relative-url "/(geography.(hypermedia.(example)))" ".progress-bar")))) ;; -------------------------------------------------------------------------- ;; Structural: go up one level (2 dots) ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: up one (..slug)" (deftest "sibling call" (assert-equal "/(geography.(hypermedia.(reactive.demo)))" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(..reactive.demo)"))) (deftest "just go up — no new content" (assert-equal "/(geography.(hypermedia))" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(..)"))) (deftest "bare-dot shorthand for up" (assert-equal "/(geography.(hypermedia))" (resolve-relative-url "/(geography.(hypermedia.(example)))" ".."))) (deftest "up from two-level URL" (assert-equal "/(language)" (resolve-relative-url "/(language.(doc))" "(..)"))) (deftest "up from single-level pops to root" (assert-equal "/" (resolve-relative-url "/(language)" "(..)")))) ;; -------------------------------------------------------------------------- ;; Structural: go up two levels (3 dots) ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: up two (...slug)" (deftest "up two and push" (assert-equal "/(geography.(marshes))" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(...marshes)"))) (deftest "just up two — no content" (assert-equal "/(geography)" (resolve-relative-url "/(geography.(hypermedia.(example)))" "(...)"))) (deftest "bare-dot shorthand for up two" (assert-equal "/(geography)" (resolve-relative-url "/(geography.(hypermedia.(example)))" "..."))) (deftest "up two from two-level pops to root" (assert-equal "/" (resolve-relative-url "/(language.(doc))" "(...)"))) (deftest "up two and push from deep URL" ;; 4-level URL, ... = 3 dots = pop 2 levels → at hypermedia level (assert-equal "/(geography.(hypermedia.(reactive.demo)))" (resolve-relative-url "/(geography.(hypermedia.(reference.(attributes))))" "(...reactive.demo)")))) ;; -------------------------------------------------------------------------- ;; Structural: up N levels (N+1 dots) ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: up N" (deftest "up three levels (4 dots) from 4-level URL" ;; 4-level URL, .... = 4 dots = pop 3 levels → at geography level (assert-equal "/(geography)" (resolve-relative-url "/(geography.(hypermedia.(reference.(attributes))))" "(....)"))) (deftest "up three and push from 4-level URL" ;; 4 dots = pop 3 → at geography, then push new-section (assert-equal "/(geography.(new-section))" (resolve-relative-url "/(geography.(hypermedia.(reference.(attributes))))" "(....new-section)"))) (deftest "up four levels (5 dots) pops to root" (assert-equal "/" (resolve-relative-url "/(geography.(hypermedia.(reference.(attributes))))" "(.....)")))) ;; -------------------------------------------------------------------------- ;; Structural: current (1 dot, no body) = no-op ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: current level no-op" (deftest "dot with no body is identity" ;; (.): dots=1, body="" → no positional, no keywords → current unchanged (assert-equal "/(language.(doc.intro))" (resolve-relative-url "/(language.(doc.intro))" "(.)"))) (deftest "bare dot shorthand" (assert-equal "/(language.(doc.intro))" (resolve-relative-url "/(language.(doc.intro))" ".")))) ;; ========================================================================== ;; SX URL Resolution — Keyword Operations ;; ========================================================================== ;; -------------------------------------------------------------------------- ;; Keyword set: absolute value ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: keyword set" (deftest "set keyword on URL without keywords" (assert-equal "/(language.(spec.(explore.signals.:page.4)))" (resolve-relative-url "/(language.(spec.(explore.signals)))" "(.:page.4)"))) (deftest "replace existing keyword" (assert-equal "/(language.(spec.(explore.signals.:page.4)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:page.4)"))) (deftest "set keyword with bare-dot shorthand" (assert-equal "/(language.(spec.(explore.signals.:page.4)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" ".:page.4"))) (deftest "set keyword on single-level URL" (assert-equal "/(language.:page.1)" (resolve-relative-url "/(language)" "(.:page.1)"))) (deftest "set multiple keywords" (assert-equal "/(language.(spec.(explore.signals.:page.4.:section.batch)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:page.4.:section.batch)"))) (deftest "add new keyword preserving existing" (assert-equal "/(language.(spec.(explore.signals.:page.3.:section.batch)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:section.batch)")))) ;; -------------------------------------------------------------------------- ;; Keyword delta: +N / -N ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: keyword delta" (deftest "increment by 1" (assert-equal "/(language.(spec.(explore.signals.:page.4)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:page.+1)"))) (deftest "decrement by 1" (assert-equal "/(language.(spec.(explore.signals.:page.2)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:page.-1)"))) (deftest "increment by larger amount" (assert-equal "/(language.(spec.(explore.signals.:page.13)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(.:page.+10)"))) (deftest "delta with bare-dot shorthand" (assert-equal "/(language.(spec.(explore.signals.:page.4)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" ".:page.+1"))) (deftest "delta on missing keyword uses literal" ;; If :page doesn't exist, +1 is used as-is (not numeric delta) (assert-equal "/(language.(spec.(explore.signals.:page.+1)))" (resolve-relative-url "/(language.(spec.(explore.signals)))" "(.:page.+1)")))) ;; -------------------------------------------------------------------------- ;; Composed: structural + keyword ;; -------------------------------------------------------------------------- (defsuite "resolve-relative-url: composed structural + keyword" (deftest "append slug + set keyword" (assert-equal "/(language.(spec.(explore.signals.batch.:page.1)))" (resolve-relative-url "/(language.(spec.(explore.signals)))" "(.batch.:page.1)"))) (deftest "sibling + set keyword" (assert-equal "/(language.(spec.(eval.:page.1)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "(..eval.:page.1)"))) (deftest "up two + set keyword" (assert-equal "/(geography.(reactive.demo.:page.1))" (resolve-relative-url "/(geography.(hypermedia.(example.progress-bar)))" "(...reactive.demo.:page.1)"))) (deftest "bare-dot composed" (assert-equal "/(language.(spec.(eval.:page.1)))" (resolve-relative-url "/(language.(spec.(explore.signals.:page.3)))" "..eval.:page.1")))) ;; ========================================================================== ;; SX URL Parsing — parse-sx-url ;; ========================================================================== (defsuite "parse-sx-url" (deftest "home URL" (let ((parsed (parse-sx-url "/"))) (assert-equal "home" (get parsed "type")) (assert-equal "/" (get parsed "raw")))) (deftest "absolute SX URL" (let ((parsed (parse-sx-url "/(language.(doc.intro))"))) (assert-equal "absolute" (get parsed "type")))) (deftest "relative paren-form" (let ((parsed (parse-sx-url "(.slug)"))) (assert-equal "relative" (get parsed "type")))) (deftest "relative bare-dot" (let ((parsed (parse-sx-url ".slug"))) (assert-equal "relative" (get parsed "type")))) (deftest "relative double-dot" (let ((parsed (parse-sx-url ".."))) (assert-equal "relative" (get parsed "type")))) (deftest "direct component" (let ((parsed (parse-sx-url "/(~essay-sx-sucks)"))) (assert-equal "direct-component" (get parsed "type")) (assert-equal "~essay-sx-sucks" (get parsed "name")))) (deftest "old-style path" (let ((parsed (parse-sx-url "/language/docs/intro"))) (assert-equal "path" (get parsed "type"))))) ;; ========================================================================== ;; URL Special Forms (! prefix) ;; ========================================================================== (defsuite "url-special-form?" (deftest "known special forms" (assert-true (url-special-form? "!source")) (assert-true (url-special-form? "!inspect")) (assert-true (url-special-form? "!diff")) (assert-true (url-special-form? "!search")) (assert-true (url-special-form? "!raw")) (assert-true (url-special-form? "!json"))) (deftest "unknown bang-prefix is not a special form" (assert-false (url-special-form? "!unknown")) (assert-false (url-special-form? "!foo"))) (deftest "non-bang names are not special forms" (assert-false (url-special-form? "source")) (assert-false (url-special-form? "language")) (assert-false (url-special-form? "~essay")))) (defsuite "parse-sx-url: special forms" (deftest "source special form" (let ((parsed (parse-sx-url "/(!source.(~essay-sx-sucks))"))) (assert-equal "special-form" (get parsed "type")) (assert-equal "!source" (get parsed "form")) (assert-equal "(~essay-sx-sucks)" (get parsed "inner")))) (deftest "inspect special form" (let ((parsed (parse-sx-url "/(!inspect.(language.(doc.primitives)))"))) (assert-equal "special-form" (get parsed "type")) (assert-equal "!inspect" (get parsed "form")) (assert-equal "(language.(doc.primitives))" (get parsed "inner")))) (deftest "diff special form with two args" (let ((parsed (parse-sx-url "/(!diff.(language.(spec.signals)).(language.(spec.eval)))"))) (assert-equal "special-form" (get parsed "type")) (assert-equal "!diff" (get parsed "form")) (assert-equal "(language.(spec.signals)).(language.(spec.eval))" (get parsed "inner")))) (deftest "raw special form" (let ((parsed (parse-sx-url "/(!raw.(~some-component))"))) (assert-equal "special-form" (get parsed "type")) (assert-equal "!raw" (get parsed "form")) (assert-equal "(~some-component)" (get parsed "inner")))) (deftest "json special form" (let ((parsed (parse-sx-url "/(!json.(language.(doc.primitives)))"))) (assert-equal "special-form" (get parsed "type")) (assert-equal "!json" (get parsed "form")) (assert-equal "(language.(doc.primitives))" (get parsed "inner"))))) (defsuite "url-special-form-name" (deftest "extracts form name" (assert-equal "!source" (url-special-form-name "/(!source.(~essay))"))) (deftest "returns nil for non-special-form" (assert-nil (url-special-form-name "/(language.(doc.intro))")) (assert-nil (url-special-form-name "/")) (assert-nil (url-special-form-name "(.slug)")))) (defsuite "url-special-form-inner" (deftest "extracts inner expression" (assert-equal "(~essay)" (url-special-form-inner "/(!source.(~essay))"))) (deftest "extracts multi-arg inner" (assert-equal "(a).(b)" (url-special-form-inner "/(!diff.(a).(b))"))) (deftest "returns nil for non-special-form" (assert-nil (url-special-form-inner "/(language.(doc.intro))")))) ;; ========================================================================== ;; Internal helpers — additional edge cases ;; ========================================================================== (defsuite "internal: _pop-sx-url-level" (deftest "pop three-level" (assert-equal "/(a.(b))" (_pop-sx-url-level "/(a.(b.(c)))"))) (deftest "pop two-level" (assert-equal "/(a)" (_pop-sx-url-level "/(a.(b))"))) (deftest "pop single-level to root" (assert-equal "/" (_pop-sx-url-level "/(a)"))) (deftest "pop root stays root" (assert-equal "/" (_pop-sx-url-level "/")))) (defsuite "internal: _extract-innermost" (deftest "single-level URL" (let ((parts (_extract-innermost "/(language)"))) (assert-equal "/(" (get parts "before")) (assert-equal "language" (get parts "content")) (assert-equal ")" (get parts "suffix")))) (deftest "two-level URL" (let ((parts (_extract-innermost "/(language.(doc.intro))"))) (assert-equal "/(language.(" (get parts "before")) (assert-equal "doc.intro" (get parts "content")) (assert-equal "))" (get parts "suffix")))) (deftest "three-level URL with keywords" (let ((parts (_extract-innermost "/(a.(b.(c.d.:page.3)))"))) (assert-equal "/(a.(b.(" (get parts "before")) (assert-equal "c.d.:page.3" (get parts "content")) (assert-equal ")))" (get parts "suffix"))))) (defsuite "internal: _find-keyword-value" (deftest "finds keyword" (assert-equal "3" (_find-keyword-value "explore.signals.:page.3" ":page"))) (deftest "returns nil when not found" (assert-nil (_find-keyword-value "explore.signals" ":page"))) (deftest "finds among multiple keywords" (assert-equal "batch" (_find-keyword-value "explore.signals.:page.3.:section.batch" ":section")))) (defsuite "internal: _set-keyword-in-content" (deftest "replace existing" (assert-equal "a.b.:page.4" (_set-keyword-in-content "a.b.:page.3" ":page" "4"))) (deftest "append when missing" (assert-equal "a.b.:page.1" (_set-keyword-in-content "a.b" ":page" "1"))) (deftest "replace with multiple keywords present" (assert-equal "a.:page.4.:section.batch" (_set-keyword-in-content "a.:page.3.:section.batch" ":page" "4")))) (defsuite "internal: _is-delta-value?" (deftest "positive delta" (assert-true (_is-delta-value? "+1")) (assert-true (_is-delta-value? "+10"))) (deftest "negative delta" (assert-true (_is-delta-value? "-1")) (assert-true (_is-delta-value? "-10"))) (deftest "bare minus is not delta" (assert-false (_is-delta-value? "-"))) (deftest "bare plus is not delta" (assert-false (_is-delta-value? "+"))) (deftest "plain number is not delta" (assert-false (_is-delta-value? "3")) (assert-false (_is-delta-value? "0"))) (deftest "empty string is not delta" (assert-false (_is-delta-value? "")))) (defsuite "internal: _apply-delta" (deftest "increment" (assert-equal "4" (_apply-delta "3" "+1"))) (deftest "decrement" (assert-equal "2" (_apply-delta "3" "-1"))) (deftest "large increment" (assert-equal "13" (_apply-delta "3" "+10"))) (deftest "non-numeric current falls back" (assert-equal "+1" (_apply-delta "abc" "+1"))))