giles
1a3d7b3d77
All checks were successful
Build and Deploy / build-and-deploy (push) Successful in 4m49s
Three-layer architecture:
spec/ — Core language (19 files): evaluator, parser, primitives,
CEK machine, types, continuations. Host-independent.
web/ — Web framework (20 files): signals, adapters, engine,
orchestration, boot, router, CSSX. Built on core spec.
sx/ — Application (sx-docs website). Built on web framework.
Split boundary.sx into boundary-core.sx (type-of, make-env, identical?)
and boundary-web.sx (IO primitives, signals, spreads, page helpers).
Bootstrappers search spec/ → web/ → shared/sx/ref/ for .sx files.
Original files remain in shared/sx/ref/ as fallback during transition.
All 63 tests pass.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
709 lines
26 KiB
Plaintext
709 lines
26 KiB
Plaintext
;; ==========================================================================
|
|
;; 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/<slug>")))
|
|
(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/<uid>/posts/<pid>")))
|
|
(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/<slug>")))
|
|
(assert-true (not (nil? result)))
|
|
(assert-equal "hello" (get result "slug"))))
|
|
|
|
(deftest "no match returns nil"
|
|
(assert-nil (match-route "/docs/hello" "/essays/<slug>"))
|
|
(assert-nil (match-route "/docs" "/docs/<slug>")))
|
|
|
|
(deftest "segment count mismatch returns nil"
|
|
(assert-nil (match-route "/a/b/c" "/a/<b>"))
|
|
(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/<uid>/posts/<pid>")))
|
|
(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/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :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/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :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/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :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/<slug>"
|
|
:parsed (parse-route-pattern "/language/docs/<slug>")
|
|
: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"))))
|