diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh new file mode 100644 index 00000000..2ab78043 --- /dev/null +++ b/lib/dream/conformance.sh @@ -0,0 +1,87 @@ +#!/usr/bin/env bash +# dream-on-sx conformance runner — loads all dream modules + test suites in one +# sx_server process and reports pass/fail per suite. +# +# Usage: +# bash lib/dream/conformance.sh # run all suites +# bash lib/dream/conformance.sh -v # verbose (list each suite) + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +VERBOSE="${1:-}" + +# Dream library modules loaded before any test suite. +MODULES=( + "lib/dream/types.sx" +) + +# Suites: NAME RUNNER-FN PATH +SUITES=( + "types dream-ty-tests-run! lib/dream/tests/types.sx" +) + +TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT +EPOCH=1 +emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); } +emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); } + +{ + for M in "${MODULES[@]}"; do emit_load "$M"; done + for SUITE in "${SUITES[@]}"; do + read -r _NAME _RUNNER FILE <<< "$SUITE" + emit_load "$FILE" + emit_eval "($_RUNNER)" + done +} > "$TMPFILE" + +OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true) + +TOTAL_PASS=0 +TOTAL_FAIL=0 +FAILED_SUITES=() +LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true) + +I=0 +while read -r LINE; do + [ -z "$LINE" ] && continue + P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}') + F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}') + [ -z "$P" ] && P=0 + [ -z "$F" ] && F=0 + SUITE_INFO="${SUITES[$I]}" + SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}') + TOTAL_PASS=$((TOTAL_PASS + P)) + TOTAL_FAIL=$((TOTAL_FAIL + F)) + if [ "$F" -gt 0 ]; then + FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))") + printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))" + echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name / fail: /' + elif [ "$VERBOSE" = "-v" ]; then + printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P" + fi + I=$((I+1)) +done <<< "$LAST_DICT_LINES" + +TOTAL=$((TOTAL_PASS + TOTAL_FAIL)) +if [ "$TOTAL" -eq 0 ]; then + echo "ERROR: no suite results parsed. Raw output:" >&2 + echo "$OUTPUT" >&2 + exit 1 +fi +if [ $TOTAL_FAIL -eq 0 ]; then + echo "ok $TOTAL_PASS/$TOTAL dream-on-sx tests passed (${#SUITES[@]} suites)" +else + echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:" + for S in "${FAILED_SUITES[@]}"; do echo " $S"; done + exit 1 +fi diff --git a/lib/dream/tests/types.sx b/lib/dream/tests/types.sx new file mode 100644 index 00000000..5b4f9893 --- /dev/null +++ b/lib/dream/tests/types.sx @@ -0,0 +1,148 @@ +;; lib/dream/tests/types.sx — request/response/route records. + +(define dream-ty-pass 0) +(define dream-ty-fail 0) +(define dream-ty-fails (list)) + +(define + dream-ty-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-ty-pass (+ dream-ty-pass 1)) + (begin + (set! dream-ty-fail (+ dream-ty-fail 1)) + (append! dream-ty-fails {:name name :actual actual :expected expected}))))) + +;; ── request construction + accessors ─────────────────────────────── +(define + dream-ty-req + (dream-request "get" "/users/42?tab=info&x=1" {:X-Token "abc" :Content-Type "text/html"} "hello")) + +(dream-ty-test "method uppercased" (dream-method dream-ty-req) "GET") +(dream-ty-test "path strips query" (dream-path dream-ty-req) "/users/42") +(dream-ty-test + "target keeps query" + (dream-target dream-ty-req) + "/users/42?tab=info&x=1") +(dream-ty-test "body" (dream-body dream-ty-req) "hello") +(dream-ty-test + "header case-insensitive" + (dream-header dream-ty-req "content-type") + "text/html") +(dream-ty-test + "header mixed case" + (dream-header dream-ty-req "X-Token") + "abc") +(dream-ty-test + "missing header is nil" + (dream-header dream-ty-req "absent") + nil) +(dream-ty-test + "query param tab" + (dream-query-param dream-ty-req "tab") + "info") +(dream-ty-test "query param x" (dream-query-param dream-ty-req "x") "1") +(dream-ty-test "params empty by default" (dream-param dream-ty-req "id") nil) +(dream-ty-test "is a request" (dream-request? dream-ty-req) true) +(dream-ty-test "string is not a request" (dream-request? "x") false) + +;; ── query edge cases ─────────────────────────────────────────────── +(dream-ty-test + "no query is empty" + (dream-query-param (dream-request "GET" "/plain" {} "") "k") + nil) +(dream-ty-test + "valueless query param" + (dream-query-param (dream-request "GET" "/p?flag" {} "") "flag") + "") + +;; ── path params ──────────────────────────────────────────────────── +(define dream-ty-req2 (dream-with-param dream-ty-req "id" "42")) +(dream-ty-test "with-param sets" (dream-param dream-ty-req2 "id") "42") +(dream-ty-test "with-param immutable" (dream-param dream-ty-req "id") nil) +(define dream-ty-req3 (dream-with-params dream-ty-req {:a "1" :b "2"})) +(dream-ty-test "with-params a" (dream-param dream-ty-req3 "a") "1") +(dream-ty-test "with-params b" (dream-param dream-ty-req3 "b") "2") + +;; ── response construction ────────────────────────────────────────── +(dream-ty-test "html status" (dream-status (dream-html "
")) 200) +(dream-ty-test "html body" (dream-resp-body (dream-html "
")) "
") +(dream-ty-test + "html content-type" + (dream-resp-header (dream-html "
") "content-type") + "text/html; charset=utf-8") +(dream-ty-test + "text content-type" + (dream-resp-header (dream-text "hi") "content-type") + "text/plain; charset=utf-8") +(dream-ty-test + "json content-type" + (dream-resp-header (dream-json "{}") "content-type") + "application/json") +(dream-ty-test + "html-status code" + (dream-status (dream-html-status 201 "ok")) + 201) +(dream-ty-test + "not-found status" + (dream-status (dream-not-found)) + 404) +(dream-ty-test + "empty status" + (dream-status (dream-empty 204)) + 204) +(dream-ty-test "empty body" (dream-resp-body (dream-empty 204)) "") +(dream-ty-test + "redirect status" + (dream-status (dream-redirect "/home")) + 303) +(dream-ty-test + "redirect location" + (dream-resp-header (dream-redirect "/home") "location") + "/home") +(dream-ty-test + "redirect-status code" + (dream-status (dream-redirect-status 301 "/x")) + 301) +(dream-ty-test "is a response" (dream-response? (dream-html "x")) true) + +;; ── response mutation ────────────────────────────────────────────── +(define dream-ty-resp (dream-add-header (dream-html "x") "X-Custom" "yes")) +(dream-ty-test + "add-header" + (dream-resp-header dream-ty-resp "x-custom") + "yes") +(dream-ty-test "add-header keeps body" (dream-resp-body dream-ty-resp) "x") +(dream-ty-test + "set-status" + (dream-status (dream-set-status (dream-html "x") 500)) + 500) + +;; ── coercion ─────────────────────────────────────────────────────── +(dream-ty-test + "coerce string" + (dream-status (dream-coerce-response "hi")) + 200) +(dream-ty-test + "coerce string body" + (dream-resp-body (dream-coerce-response "hi")) + "hi") +(dream-ty-test + "coerce response passthrough" + (dream-status (dream-coerce-response (dream-empty 204))) + 204) + +;; ── route ────────────────────────────────────────────────────────── +(define dream-ty-h (fn (req) (dream-text "ok"))) +(define dream-ty-route (dream-route "post" "/submit" dream-ty-h)) +(dream-ty-test "route method" (dream-route-method dream-ty-route) "POST") +(dream-ty-test "route path" (dream-route-path dream-ty-route) "/submit") +(dream-ty-test "route is route" (dream-route? dream-ty-route) true) +(dream-ty-test + "route handler invokes" + (dream-resp-body ((dream-route-handler dream-ty-route) dream-ty-req)) + "ok") + +(define dream-ty-tests-run! (fn () {:total (+ dream-ty-pass dream-ty-fail) :passed dream-ty-pass :failed dream-ty-fail :fails dream-ty-fails})) diff --git a/lib/dream/types.sx b/lib/dream/types.sx new file mode 100644 index 00000000..75d93aba --- /dev/null +++ b/lib/dream/types.sx @@ -0,0 +1,146 @@ +;; lib/dream/types.sx — Dream-on-SX core types. +;; The five types: request, response, route. handler = request->response and +;; middleware = handler->handler are plain SX functions (no records needed). +;; request/response/route are dicts. Headers are dicts with lowercased string +;; keys; keywords are strings in SX, so :content-type == "content-type". + +;; ── internal helpers ─────────────────────────────────────────────── +(define + dr/normalize-headers + (fn + (h) + (reduce + (fn (acc k) (assoc acc (lower k) (get h k))) + {} + (keys h)))) + +(define + dr/path-of + (fn + (target) + (let + ((i (index-of target "?"))) + (if (< i 0) target (substr target 0 i))))) + +(define + dr/query-of + (fn + (target) + (let + ((i (index-of target "?"))) + (if (< i 0) "" (substr target (+ i 1)))))) + +(define + dr/parse-pair + (fn + (acc pair) + (if + (= pair "") + acc + (let + ((j (index-of pair "="))) + (if + (< j 0) + (assoc acc pair "") + (assoc + acc + (substr pair 0 j) + (substr pair (+ j 1)))))))) + +(define + dr/parse-query + (fn + (target) + (let + ((q (dr/query-of target))) + (if + (= q "") + {} + (reduce dr/parse-pair {} (split q "&")))))) + +;; ── request ──────────────────────────────────────────────────────── +(define dream-request (fn (method target headers body) {:path (dr/path-of target) :params {} :query (dr/parse-query target) :body body :headers (dr/normalize-headers headers) :method (upper method) :target target})) + +(define + dream-request? + (fn (x) (and (dict? x) (has-key? x :method) (has-key? x :path)))) +(define dream-method (fn (req) (get req :method))) +(define dream-target (fn (req) (get req :target))) +(define dream-path (fn (req) (get req :path))) +(define dream-body (fn (req) (get req :body))) +(define + dream-header + (fn (req name) (get (get req :headers) (lower name)))) +(define dream-query-param (fn (req name) (get (get req :query) name))) +(define dream-param (fn (req name) (get (get req :params) name))) +(define dream-params (fn (req) (get req :params))) + +;; router fills path params during dispatch +(define + dream-with-param + (fn + (req name val) + (assoc req :params (assoc (get req :params) name val)))) +(define + dream-with-params + (fn + (req more) + (assoc + req + :params (reduce + (fn (acc k) (assoc acc k (get more k))) + (get req :params) + (keys more))))) +(define dream-set-body (fn (req body) (assoc req :body body))) + +;; ── response ─────────────────────────────────────────────────────── +(define dream-response (fn (status headers body) {:body body :headers (dr/normalize-headers headers) :status status})) + +(define + dream-response? + (fn (x) (and (dict? x) (has-key? x :status) (has-key? x :body)))) +(define dream-status (fn (resp) (get resp :status))) +(define + dream-resp-header + (fn (resp name) (get (get resp :headers) (lower name)))) +(define dream-resp-body (fn (resp) (get resp :body))) +(define dream-headers (fn (resp) (get resp :headers))) + +(define + dream-add-header + (fn + (resp name val) + (assoc resp :headers (assoc (get resp :headers) (lower name) val)))) +(define dream-set-status (fn (resp status) (assoc resp :status status))) + +;; smart constructors +(define dream-html (fn (body) (dream-response 200 {:content-type "text/html; charset=utf-8"} body))) +(define + dream-html-status + (fn (status body) (dream-response status {:content-type "text/html; charset=utf-8"} body))) +(define dream-text (fn (body) (dream-response 200 {:content-type "text/plain; charset=utf-8"} body))) +(define dream-json (fn (body) (dream-response 200 {:content-type "application/json"} body))) +(define dream-empty (fn (status) (dream-response status {} ""))) +(define + dream-not-found + (fn () (dream-response 404 {:content-type "text/plain; charset=utf-8"} "Not Found"))) +(define + dream-redirect + (fn (location) (dream-response 303 {:location location} ""))) +(define + dream-redirect-status + (fn (status location) (dream-response status {:location location} ""))) + +;; coerce a handler result: strings become 200 text/html responses +(define + dream-coerce-response + (fn (x) (if (dream-response? x) x (dream-html x)))) + +;; ── route ────────────────────────────────────────────────────────── +(define dream-route (fn (method path handler) {:path path :handler handler :method (upper method)})) +(define + dream-route? + (fn (x) (and (dict? x) (has-key? x :handler) (has-key? x :path)))) +(define dream-route-method (fn (r) (get r :method))) +(define dream-route-path (fn (r) (get r :path))) +(define dream-route-handler (fn (r) (get r :handler))) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index 6339ed64..3cc80f94 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -44,7 +44,7 @@ The user-facing story: rose-ash users who'd never touch s-expressions might writ The five types: `request`, `response`, `handler = request -> response`, `middleware = handler -> handler`, `route`. Everything else is a function over these. -- [ ] **Core types** in `lib/dream/types.sx`: request/response records, route record. +- [x] **Core types** in `lib/dream/types.sx`: request/response records, route record. - [ ] **Router** in `lib/dream/router.sx`: - `dream-get path handler`, `dream-post path handler`, etc. for all HTTP methods. - `dream-scope prefix middlewares routes` — prefix mount with middleware chain. @@ -104,8 +104,15 @@ Confirm scope before starting; some of these may be addable as Dream-internal he ## Progress log -_(awaiting activation conditions)_ +- **2026-06-07 — Core types** (`lib/dream/types.sx`, 41 tests). OCaml gate verified + green (scoreboard 480/480, Phases 1–5 + Phase 6 stdlib). Dream is implemented in + plain SX over the CEK — keywords are strings, so headers are dicts with lowercased + string keys (`:content-type` == `"content-type"`). request (method/target/path/ + query/headers/body/params), response (status/headers/body), route records with + constructors + accessors; smart response constructors (html/text/json/empty/ + not-found/redirect); `dream-coerce-response` wraps bare strings; query-string + parsing. Conformance runner `lib/dream/conformance.sh` modelled on flow's. ## Blockers -_(none yet — plan is cold)_ +_(none — gate green, loop active)_