rose-ash/web/tests/test-aser.sx

(defsuite
  "aser-basics"
  (deftest
    "number literal passes through"
    (assert-equal "42" (render-to-sx "42")))
  (deftest
    "string literal passes through"
    (assert-equal "hello" (render-to-sx "\"hello\"")))
  (deftest
    "boolean true passes through"
    (assert-equal "true" (render-to-sx "true")))
  (deftest
    "boolean false passes through"
    (assert-equal "false" (render-to-sx "false")))
  (deftest "nil produces empty" (assert-equal "" (render-to-sx "nil"))))

(defsuite
  "aser-tags"
  (deftest
    "simple div"
    (assert-equal "(div \"hello\")" (render-to-sx "(div \"hello\")")))
  (deftest
    "nested tags"
    (assert-equal "(div (span \"hi\"))" (render-to-sx "(div (span \"hi\"))")))
  (deftest
    "multiple children"
    (assert-equal
      "(div (p \"a\") (p \"b\"))"
      (render-to-sx "(div (p \"a\") (p \"b\"))")))
  (deftest
    "attributes serialize"
    (assert-equal
      "(div :class \"foo\" \"bar\")"
      (render-to-sx "(div :class \"foo\" \"bar\")")))
  (deftest
    "multiple attributes"
    (assert-equal
      "(a :href \"/home\" :class \"link\" \"Home\")"
      (render-to-sx "(a :href \"/home\" :class \"link\" \"Home\")")))
  (deftest "void elements" (assert-equal "(br)" (render-to-sx "(br)")))
  (deftest
    "void element with attrs"
    (assert-equal
      "(img :src \"pic.jpg\")"
      (render-to-sx "(img :src \"pic.jpg\")"))))

(defsuite
  "aser-fragments"
  (deftest
    "simple fragment"
    (assert-equal
      "(<> (p \"a\") (p \"b\"))"
      (render-to-sx "(<> (p \"a\") (p \"b\"))")))
  (deftest "empty fragment" (assert-equal "" (render-to-sx "(<>)")))
  (deftest
    "single-child fragment"
    (assert-equal "(div \"x\")" (render-to-sx "(<> (div \"x\"))"))))

(defsuite
  "aser-control-flow"
  (deftest
    "if true branch"
    (assert-equal "(p \"yes\")" (render-to-sx "(if true (p \"yes\") (p \"no\"))")))
  (deftest
    "if false branch"
    (assert-equal "(p \"no\")" (render-to-sx "(if false (p \"yes\") (p \"no\"))")))
  (deftest
    "when true"
    (assert-equal "(p \"ok\")" (render-to-sx "(when true (p \"ok\"))")))
  (deftest
    "when false"
    (assert-equal "" (render-to-sx "(when false (p \"ok\"))")))
  (deftest
    "cond serializes matching branch"
    (assert-equal
      "(p \"two\")"
      (render-to-sx "(cond false (p \"one\") true (p \"two\") :else (p \"three\"))")))
  (deftest
    "cond with 2-element predicate test"
    (assert-equal
      "(p \"yes\")"
      (render-to-sx "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
    (assert-equal
      "(p \"no\")"
      (render-to-sx "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
  (deftest
    "let binds then serializes"
    (assert-equal "(p \"hello\")" (render-to-sx "(let ((x \"hello\")) (p x))")))
  (deftest
    "let preserves outer scope bindings"
    (assert-equal
      "(p \"outer\")"
      (render-to-sx "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
  (deftest
    "nested let preserves outer scope"
    (assert-equal
      "(div (span \"hello\") (span \"world\"))"
      (render-to-sx
        "(do (define a \"hello\")\n                      (define b \"world\")\n                      (div (let ((x 1)) (span a))\n                           (let ((y 2)) (span b))))")))
  (deftest
    "begin serializes last"
    (assert-equal
      "(p \"last\")"
      (render-to-sx "(begin (p \"first\") (p \"last\"))"))))

(defsuite
  "aser-list-flattening"
  (deftest
    "map inside tag flattens children"
    (assert-equal
      "(div (<> (span \"a\") (span \"b\") (span \"c\")))"
      (render-to-sx
        "(do (define items (list \"a\" \"b\" \"c\"))\n                      (div (map (fn (x) (span x)) items)))")))
  (deftest
    "map inside tag with other children"
    (assert-equal
      "(ul (li \"first\") (<> (li \"a\") (li \"b\")))"
      (render-to-sx
        "(do (define items (list \"a\" \"b\"))\n                      (ul (li \"first\") (map (fn (x) (li x)) items)))")))
  (deftest
    "filter result via let binding as children"
    (assert-equal
      "(ul (<> (li \"a\") (li \"b\")))"
      (render-to-sx
        "(do (define items (list \"a\" nil \"b\"))\n                      (define kept (filter (fn (x) (not (nil? x))) items))\n                      (ul (map (fn (x) (li x)) kept)))")))
  (deftest
    "map inside fragment flattens"
    (assert-equal
      "(<> (p \"a\") (p \"b\"))"
      (render-to-sx
        "(do (define items (list \"a\" \"b\"))\n                      (<> (map (fn (x) (p x)) items)))")))
  (deftest
    "nested map does not double-wrap"
    (assert-equal
      "(div (<> (span \"1\") (span \"2\")))"
      (render-to-sx
        "(do (define nums (list 1 2))\n                      (div (map (fn (n) (span (str n))) nums)))")))
  (deftest
    "map with component-like output flattens"
    (assert-equal
      "(div (<> (li \"x\") (li \"y\")))"
      (render-to-sx
        "(do (define items (list \"x\" \"y\"))\n                      (div (map (fn (x) (li x)) items)))"))))

(defsuite
  "aser-components"
  (deftest
    "unknown component serializes as-is"
    (assert-equal "(~foo :title \"bar\")" (render-to-sx "(~foo :title \"bar\")")))
  (deftest
    "defcomp then unexpanded component call"
    (assert-equal
      "(~card :title \"Hi\")"
      (render-to-sx
        "(do (defcomp ~card (&key title) (h1 title)) (~card :title \"Hi\"))")))
  (deftest
    "component with children serializes unexpanded"
    (assert-equal
      "(~box (p \"inside\"))"
      (render-to-sx
        "(do (defcomp ~box (&key &rest children) (div children))\n                      (~box (p \"inside\")))")))
  (deftest
    "string keyword arg starting with paren is quoted"
    (assert-equal
      "(~info :text \"(hello world)\")"
      (render-to-sx
        "(do (defcomp ~info (&key text) (code text))\n                      (~info :text \"(hello world)\"))")))
  (deftest
    "string child starting with paren is quoted"
    (assert-equal
      "(p \"(not code)\")"
      (render-to-sx "(let ((x \"(not code)\")) (p x))"))))

(defsuite
  "aser-definitions"
  (deftest
    "define evaluates for side effects, returns nil"
    (assert-equal "(p 42)" (render-to-sx "(do (define x 42) (p x))")))
  (deftest
    "defcomp evaluates and returns nil"
    (assert-equal
      "(~tag :x 1)"
      (render-to-sx "(do (defcomp ~tag (&key x) (span x)) (~tag :x 1))")))
  (deftest
    "defisland evaluates AND serializes"
    (let
      ((result (render-to-sx "(defisland ~counter (&key count) (span count))")))
      (assert-true (string-contains? result "defisland")))))

(defsuite
  "aser-function-calls"
  (deftest
    "named function call evaluates fully"
    (assert-equal
      "3"
      (render-to-sx "(do (define inc1 (fn (x) (+ x 1))) (inc1 2))")))
  (deftest
    "define + call"
    (assert-equal
      "10"
      (render-to-sx "(do (define double (fn (x) (* x 2))) (double 5))")))
  (deftest
    "native callable with multiple args"
    (assert-equal "3" (render-to-sx "(do (define my-add +) (my-add 1 2))")))
  (deftest
    "native callable with two args via alias"
    (assert-equal
      "hello world"
      (render-to-sx "(do (define my-join str) (my-join \"hello\" \" world\"))")))
  (deftest
    "higher-order: map returns list"
    (let
      ((result (render-to-sx "(map (fn (x) (+ x 1)) (list 1 2 3))")))
      (assert-true (not (nil? result))))))

(defsuite
  "aser-logic"
  (deftest
    "and short-circuits on false"
    (assert-equal "false" (render-to-sx "(and true false true)")))
  (deftest
    "and returns last truthy"
    (assert-equal "3" (render-to-sx "(and 1 2 3)")))
  (deftest
    "or short-circuits on true"
    (assert-equal "1" (render-to-sx "(or 1 2 3)")))
  (deftest
    "or returns last falsy"
    (assert-equal "false" (render-to-sx "(or false false)"))))

(defsuite
  "aser-spreads"
  (deftest
    "spread in element merges attrs"
    (assert-equal
      "(div :class \"card\" \"hello\")"
      (render-to-sx "(div (make-spread {:class \"card\"}) \"hello\")")))
  (deftest
    "multiple spreads merge into element"
    (assert-equal
      "(div :class \"card\" :style \"color:red\" \"hello\")"
      (render-to-sx
        "(div (make-spread {:class \"card\"}) (make-spread {:style \"color:red\"}) \"hello\")")))
  (deftest
    "spread in fragment is silently dropped"
    (assert-equal
      "\"hello\""
      (render-to-sx "(<> (make-spread {:class \"card\"}) \"hello\")")))
  (deftest
    "stored spread in let binding"
    (assert-equal
      "(div :class \"card\" \"hello\")"
      (render-to-sx
        "(let ((card (make-spread {:class \"card\"})))\n                    (div card \"hello\"))")))
  (deftest
    "spread in nested element"
    (assert-equal
      "(div (span :class \"inner\" \"hi\"))"
      (render-to-sx "(div (span (make-spread {:class \"inner\"}) \"hi\"))")))
  (deftest
    "spread in non-element context silently drops"
    (assert-equal
      "hello"
      (render-to-sx "(do (make-spread {:class \"card\"}) \"hello\")"))))

(defsuite
  "scope"
  (deftest
    "scope with value and context"
    (assert-equal
      "dark"
      (render-to-sx "(scope \"sc-theme\" :value \"dark\" (context \"sc-theme\"))")))
  (deftest
    "scope without value defaults to nil"
    (assert-equal
      ""
      (render-to-sx "(scope \"sc-nil\" (str (context \"sc-nil\")))")))
  (deftest
    "scope with emit!/emitted"
    (assert-equal
      "a,b"
      (render-to-sx
        "(scope \"sc-emit\" (emit! \"sc-emit\" \"a\") (emit! \"sc-emit\" \"b\") (join \",\" (emitted \"sc-emit\")))")))
  (deftest
    "provide is equivalent to scope with value"
    (assert-equal
      "42"
      (render-to-sx "(provide \"sc-prov\" 42 (str (context \"sc-prov\")))")))
  (deftest
    "collect! works via scope (lazy root scope)"
    (assert-equal
      "x,y"
      (render-to-sx
        "(do (collect! \"sc-coll\" \"x\") (collect! \"sc-coll\" \"y\") (join \",\" (collected \"sc-coll\")))")))
  (deftest
    "collect! deduplicates"
    (assert-equal
      "a"
      (render-to-sx
        "(do (collect! \"sc-dedup\" \"a\") (collect! \"sc-dedup\" \"a\") (join \",\" (collected \"sc-dedup\")))")))
  (deftest
    "clear-collected! clears scope accumulator"
    (assert-equal
      ""
      (render-to-sx
        "(do (collect! \"sc-clear\" \"x\") (clear-collected! \"sc-clear\") (join \",\" (collected \"sc-clear\")))")))
  (deftest
    "nested scope shadows outer"
    (assert-equal
      "inner"
      (render-to-sx
        "(scope \"sc-nest\" :value \"outer\" (scope \"sc-nest\" :value \"inner\" (context \"sc-nest\")))")))
  (deftest
    "scope pops correctly after body"
    (assert-equal
      "outer"
      (render-to-sx
        "(scope \"sc-pop\" :value \"outer\" (scope \"sc-pop\" :value \"inner\" \"ignore\") (context \"sc-pop\"))"))))

(defsuite
  "aser-error-propagation"
  (deftest
    "case — error in matched branch throws, not falls through"
    (assert-throws
      (fn
        ()
        (render-to-sx "(case \"x\" \"x\" undefined-symbol-xyz :else \"fallback\")"))))
  (deftest
    "case — :else body error also throws"
    (assert-throws
      (fn
        ()
        (render-to-sx "(case \"no-match\" \"x\" \"ok\" :else undefined-symbol-xyz)"))))
  (deftest
    "case — matched branch with nested error throws"
    (assert-throws
      (fn
        ()
        (render-to-sx
          "(case \"a\" \"a\" (div (p undefined-sym-abc)) :else (p \"index\"))"))))
  (deftest
    "cond — error in matched branch throws"
    (assert-throws
      (fn () (render-to-sx "(cond true undefined-cond-sym :else \"fallback\")"))))
  (deftest
    "cond — error in :else branch throws"
    (assert-throws
      (fn () (render-to-sx "(cond false \"skip\" :else undefined-cond-sym)"))))
  (deftest
    "if — error in true branch throws"
    (assert-throws
      (fn () (render-to-sx "(if true undefined-if-sym \"fallback\")"))))
  (deftest
    "when — error in body throws"
    (assert-throws (fn () (render-to-sx "(when true undefined-when-sym)"))))
  (deftest
    "let — error in binding throws"
    (assert-throws
      (fn () (render-to-sx "(let ((x undefined-let-sym)) (p x))"))))
  (deftest
    "let — error in body throws"
    (assert-throws
      (fn () (render-to-sx "(let ((x 1)) (p undefined-let-body-sym))"))))
  (deftest
    "do — error in body throws"
    (assert-throws (fn () (render-to-sx "(do \"ok\" undefined-do-sym)"))))
  (deftest
    "case — component in matched branch serializes unexpanded"
    (assert-equal
      "(~broken :title \"test\")"
      (render-to-sx
        "(do (defcomp ~broken (&key title) (div (p title) (p no-such-helper)))\n             (case \"slug\" \"slug\" (~broken :title \"test\") :else \"index\"))")))
  (deftest
    "case — unmatched falls through to :else correctly"
    (assert-equal
      "index"
      (render-to-sx
        "(do (defcomp ~page (&key x) (div x))\n             (case \"miss\" \"hit\" (~page :x \"found\") :else \"index\"))"))))

(defsuite
  "aser-dict-mutation"
  (deftest
    "lambda mutating dict arg in multi-body let"
    (assert-equal
      "99"
      (render-to-sx
        "(let ((mutate! (fn (d k v) (dict-set! d k v)))\n               (d (dict \"x\" 1)))\n           (mutate! d \"x\" 99)\n           (get d \"x\"))")))
  (deftest
    "signal reset! in multi-body let"
    (assert-equal
      "99"
      (render-to-sx
        "(let ((s (signal 42)))\n           (reset! s 99)\n           (deref s))")))
  (deftest
    "signal reset! then len of deref in multi-body let"
    (assert-equal
      "3"
      (render-to-sx
        "(let ((s (signal (list))))\n           (reset! s (list 1 2 3))\n           (len (deref s)))"))))