rose-ash/lib/dream/json.sx

;; 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))))