diff --git a/lib/dream/conformance.sh b/lib/dream/conformance.sh index 73c7b042..a66cfc35 100644 --- a/lib/dream/conformance.sh +++ b/lib/dream/conformance.sh @@ -32,6 +32,7 @@ MODULES=( "lib/dream/static.sx" "lib/dream/error.sx" "lib/dream/cors.sx" + "lib/dream/json.sx" "lib/dream/run.sx" "lib/dream/demos/hello.sx" "lib/dream/demos/counter.sx" @@ -51,6 +52,7 @@ SUITES=( "static dream-st-tests-run! lib/dream/tests/static.sx" "error dream-er-tests-run! lib/dream/tests/error.sx" "cors dream-co-tests-run! lib/dream/tests/cors.sx" + "json dream-js-tests-run! lib/dream/tests/json.sx" "run dream-rn-tests-run! lib/dream/tests/run.sx" "demos dream-dm-tests-run! lib/dream/tests/demos.sx" ) diff --git a/lib/dream/json.sx b/lib/dream/json.sx new file mode 100644 index 00000000..92d6cadc --- /dev/null +++ b/lib/dream/json.sx @@ -0,0 +1,183 @@ +;; lib/dream/json.sx — Dream-on-SX JSON encode/parse (pure SX). +;; The host JSON primitives live in the ocaml-on-sx runtime, not the base env, so +;; Dream ships its own. Depends on types.sx. (number? is unreliable in this env — +;; type-of "number" is used instead.) + +;; ── encoding ─────────────────────────────────────────────────────── +(define + dr/json-escape + (fn + (s) + (replace + (replace + (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") + "\r" + "\\r") + "\t" + "\\t"))) +(define dr/json-quote (fn (s) (str "\"" (dr/json-escape s) "\""))) + +(define + dream-json-encode + (fn + (v) + (cond + ((nil? v) "null") + ((boolean? v) (if v "true" "false")) + ((= (type-of v) "number") (str v)) + ((string? v) (dr/json-quote v)) + ((list? v) (str "[" (join "," (map dream-json-encode v)) "]")) + ((dict? v) + (str + "{" + (join + "," + (map + (fn + (k) + (str (dr/json-quote k) ":" (dream-json-encode (get v k)))) + (keys v))) + "}")) + (else (dr/json-quote (str v)))))) + +;; ── parsing (recursive descent; returns {:val :pos}) ─────────────── +(define + dr/json-space? + (fn (c) (or (= c " ") (= c "\n") (= c "\r") (= c "\t")))) +(define + dr/json-ws + (fn + (s i) + (if + (and (< i (string-length s)) (dr/json-space? (char-at s i))) + (dr/json-ws s (+ i 1)) + i))) + +(define + dr/json-digit? + (fn + (c) + (let ((n (char-code c))) (and (>= n 48) (<= n 57))))) +(define + dr/json-num-char? + (fn + (c) + (or + (dr/json-digit? c) + (= c "-") + (= c "+") + (= c ".") + (= c "e") + (= c "E")))) +(define + dr/json-num-end + (fn + (s i) + (if + (and (< i (string-length s)) (dr/json-num-char? (char-at s i))) + (dr/json-num-end s (+ i 1)) + i))) +(define + dr/json-to-number + (fn + (str-val) + (if + (or + (contains? str-val ".") + (contains? str-val "e") + (contains? str-val "E")) + (parse-float str-val) + (parse-int str-val)))) + +(define + dr/json-str + (fn + (s i acc) + (let + ((c (char-at s i))) + (cond + ((= c "\"") {:val acc :pos (+ i 1)}) + ((= c "\\") + (let + ((e (char-at s (+ i 1)))) + (cond + ((= e "n") (dr/json-str s (+ i 2) (str acc "\n"))) + ((= e "r") (dr/json-str s (+ i 2) (str acc "\r"))) + ((= e "t") (dr/json-str s (+ i 2) (str acc "\t"))) + (else (dr/json-str s (+ i 2) (str acc e)))))) + (else (dr/json-str s (+ i 1) (str acc c))))))) + +(define + dr/json-num + (fn (s i) (let ((j (dr/json-num-end s i))) {:val (dr/json-to-number (substr s i (- j i))) :pos j}))) + +(define + dr/json-arr + (fn + (s i acc) + (let + ((i (dr/json-ws s i))) + (if + (= (char-at s i) "]") + {:val acc :pos (+ i 1)} + (let + ((r (dr/json-val s i))) + (let + ((i2 (dr/json-ws s (get r :pos)))) + (if + (= (char-at s i2) ",") + (dr/json-arr + s + (+ i2 1) + (concat acc (list (get r :val)))) + {:val (concat acc (list (get r :val))) :pos (+ i2 1)}))))))) + +(define + dr/json-obj + (fn + (s i acc) + (let + ((i (dr/json-ws s i))) + (if + (= (char-at s i) "}") + {:val acc :pos (+ i 1)} + (let + ((kr (dr/json-str s (+ i 1) ""))) + (let + ((i2 (dr/json-ws s (get kr :pos)))) + (let + ((vr (dr/json-val s (+ i2 1)))) + (let + ((i3 (dr/json-ws s (get vr :pos)))) + (if + (= (char-at s i3) ",") + (dr/json-obj + s + (+ i3 1) + (assoc acc (get kr :val) (get vr :val))) + {:val (assoc acc (get kr :val) (get vr :val)) :pos (+ i3 1)}))))))))) + +(define + dr/json-val + (fn + (s i) + (let + ((i (dr/json-ws s i))) + (let + ((c (char-at s i))) + (cond + ((= c "{") (dr/json-obj s (+ i 1) {})) + ((= c "[") (dr/json-arr s (+ i 1) (list))) + ((= c "\"") (dr/json-str s (+ i 1) "")) + ((= c "t") {:val true :pos (+ i 4)}) + ((= c "f") {:val false :pos (+ i 5)}) + ((= c "n") {:val nil :pos (+ i 4)}) + (else (dr/json-num s i))))))) + +(define dream-json-parse (fn (s) (get (dr/json-val s 0) :val))) + +;; ── responses ────────────────────────────────────────────────────── +;; encode a value into a JSON response (dream-json takes a raw string body) +(define dream-json-value (fn (v) (dream-json (dream-json-encode v)))) +;; read + parse the request body as JSON +(define dream-json-body (fn (req) (dream-json-parse (dream-body req)))) diff --git a/lib/dream/tests/json.sx b/lib/dream/tests/json.sx new file mode 100644 index 00000000..6deca84e --- /dev/null +++ b/lib/dream/tests/json.sx @@ -0,0 +1,105 @@ +;; lib/dream/tests/json.sx — JSON encode/parse round-trips. + +(define dream-js-pass 0) +(define dream-js-fail 0) +(define dream-js-fails (list)) + +(define + dream-js-test + (fn + (name actual expected) + (if + (= actual expected) + (set! dream-js-pass (+ dream-js-pass 1)) + (begin + (set! dream-js-fail (+ dream-js-fail 1)) + (append! dream-js-fails {:name name :actual actual :expected expected}))))) + +;; ── encoding scalars ─────────────────────────────────────────────── +(dream-js-test "encode int" (dream-json-encode 42) "42") +(dream-js-test "encode float" (dream-json-encode 1.5) "1.5") +(dream-js-test "encode true" (dream-json-encode true) "true") +(dream-js-test "encode false" (dream-json-encode false) "false") +(dream-js-test "encode nil" (dream-json-encode nil) "null") +(dream-js-test "encode string" (dream-json-encode "hi") "\"hi\"") +(dream-js-test + "encode string escapes quote" + (dream-json-encode "a\"b") + "\"a\\\"b\"") +(dream-js-test + "encode list" + (dream-json-encode (list 1 2 3)) + "[1,2,3]") +(dream-js-test + "encode list of strings" + (dream-json-encode (list "a" "b")) + "[\"a\",\"b\"]") +(dream-js-test + "encode single-key dict" + (dream-json-encode {:a 1}) + "{\"a\":1}") +(dream-js-test "encode empty list" (dream-json-encode (list)) "[]") +(dream-js-test "encode empty dict" (dream-json-encode {}) "{}") + +;; ── parsing scalars ──────────────────────────────────────────────── +(dream-js-test "parse int" (dream-json-parse "5") 5) +(dream-js-test "parse negative" (dream-json-parse "-7") -7) +(dream-js-test "parse float" (dream-json-parse "1.5") 1.5) +(dream-js-test "parse true" (dream-json-parse "true") true) +(dream-js-test "parse false" (dream-json-parse "false") false) +(dream-js-test "parse null" (dream-json-parse "null") nil) +(dream-js-test "parse string" (dream-json-parse "\"hello\"") "hello") +(dream-js-test "parse string escape" (dream-json-parse "\"a\\nb\"") "a\nb") +(dream-js-test + "parse array" + (dream-json-parse "[1,2,3]") + (list 1 2 3)) +(dream-js-test "parse empty array" (dream-json-parse "[]") (list)) +(dream-js-test + "parse with whitespace" + (dream-json-parse " [ 1 , 2 ] ") + (list 1 2)) + +;; ── parsing objects ──────────────────────────────────────────────── +(define dream-js-obj (dream-json-parse "{\"x\":5,\"y\":\"hi\"}")) +(dream-js-test "parse obj number" (get dream-js-obj "x") 5) +(dream-js-test "parse obj string" (get dream-js-obj "y") "hi") +(dream-js-test "parse empty obj" (dream-json-parse "{}") {}) + +;; ── nested ───────────────────────────────────────────────────────── +(define dream-js-nested (dream-json-parse "{\"a\":[1,{\"b\":2}],\"c\":true}")) +(dream-js-test + "nested array first" + (first (get dream-js-nested "a")) + 1) +(dream-js-test + "nested object in array" + (get (nth (get dream-js-nested "a") 1) "b") + 2) +(dream-js-test "nested bool" (get dream-js-nested "c") true) + +;; ── round-trips ──────────────────────────────────────────────────── +(define dream-js-v {:name "Ada" :age 36 :tags (list "math" "engine")}) +(define dream-js-rt (dream-json-parse (dream-json-encode dream-js-v))) +(dream-js-test "roundtrip name" (get dream-js-rt "name") "Ada") +(dream-js-test "roundtrip age" (get dream-js-rt "age") 36) +(dream-js-test + "roundtrip tags" + (get dream-js-rt "tags") + (list "math" "engine")) + +;; ── response + request helpers ───────────────────────────────────── +(dream-js-test + "json-value content-type" + (dream-resp-header (dream-json-value {:ok true}) "content-type") + "application/json") +(dream-js-test + "json-value body" + (dream-resp-body (dream-json-value {:ok true})) + "{\"ok\":true}") +(dream-js-test + "json-body parses request" + (get (dream-json-body (dream-request "POST" "/" {} "{\"n\":9}")) "n") + 9) + +(define dream-js-tests-run! (fn () {:total (+ dream-js-pass dream-js-fail) :passed dream-js-pass :failed dream-js-fail :fails dream-js-fails})) diff --git a/plans/dream-on-sx.md b/plans/dream-on-sx.md index b8d54a6d..2184f11a 100644 --- a/plans/dream-on-sx.md +++ b/plans/dream-on-sx.md @@ -104,6 +104,14 @@ with extensions + hardening below. short-circuits preflight `OPTIONS` with a 204 carrying Allow-Methods/Headers/Max-Age. `dream-cors-origin` for a specific origin, `dream-cors-with opts` for full control (origin/methods/headers/credentials/max-age). Composes around a router. +- **2026-06-07 — Ext: JSON** (`lib/dream/json.sx`, 35 tests, 329 total). Host JSON + primitives live in the ocaml-on-sx runtime (not the base env), so Dream ships its own + pure-SX `dream-json-encode` (scalars/list/dict, string escaping) + `dream-json-parse` + (recursive-descent over chars, objects/arrays/strings/numbers/true/false/null, + whitespace-tolerant). `dream-json-value` (encode → application/json response) and + `dream-json-body` (parse request body). GOTCHA: `number?` is unreliable in this env — + used `(= (type-of v) "number")`; `parse-float` handles decimals. Multi-key dict + encode order follows `keys` (non-deterministic) so tests assert via parse round-trip. ## Extensions (post-roadmap) @@ -115,7 +123,7 @@ The five-types core is complete; these harden it toward a production HTTP front - [x] **CORS middleware** (`dream-cors`). - [x] **Error-handling middleware** (`dream-catch` / custom 500 templates; `guard`-based). - [ ] **Signed session cookies** (the noted hardening — sign the sid). -- [ ] **JSON helpers** (build from dict; parse to dict). +- [x] **JSON helpers** (encode + recursive-descent parse, pure SX). - [ ] **Query/header convenience** (`dream-queries`, defaults). - [ ] **`api.sx` facade + README** — single load point listing the public surface.