rose-ash/web/forms.sx

;; ==========================================================================
;; forms.sx — Web-platform definition forms
;;
;; Platform-specific special forms for declaring styles, handlers, pages,
;; queries, and actions. These are NOT part of the core evaluator — they
;; register themselves via register-special-form! at load time.
;;
;; When SX moves to isomorphic execution, these forms will have different
;; platform bindings on client vs server. The spec stays the same — only
;; the constructors (make-handler-def, make-query-def, etc.) change.
;;
;; Platform functions required:
;;   make-handler-def(name, params, body, env)  → HandlerDef
;;   make-query-def(name, params, doc, body, env) → QueryDef
;;   make-action-def(name, params, doc, body, env) → ActionDef
;;   make-page-def(name, slots, env) → PageDef
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Shared: parse (&key param1 param2 ...) → list of param name strings
;; --------------------------------------------------------------------------

(define parse-key-params
  (fn ((params-expr :as list))
    (let ((params (list))
          (in-key false))
      (for-each
        (fn (p)
          (when (= (type-of p) "symbol")
            (let ((name (symbol-name p)))
              (cond
                (= name "&key")  (set! in-key true)
                in-key           (append! params name)
                :else            (append! params name)))))
        params-expr)
      params)))


;; --------------------------------------------------------------------------
;; defhandler — (defhandler name [:path "..." :method :get :csrf false :returns "element"] (&key param...) body)
;;
;; Keyword options between name and params list:
;;   :path    — public route path (string). Without :path, handler is internal-only.
;;   :method  — HTTP method (keyword: :get :post :put :patch :delete). Default :get.
;;   :csrf    — CSRF protection (boolean). Default true; set false for POST/PUT etc.
;;   :returns — return type annotation (types.sx vocabulary). Default "element".
;; --------------------------------------------------------------------------

(define parse-handler-args
  (fn ((args :as list))
    "Parse defhandler args after the name symbol.
     Scans for :keyword value option pairs, then a list (params), then body.
     Returns dict with keys: opts, params, body."
    (let ((opts   {})
          (params (list))
          (body   nil)
          (i      0)
          (n      (len args))
          (done   false))
      (for-each
        (fn (idx)
          (when (and (not done) (= idx i))
            (let ((arg (nth args idx)))
              (cond
                ;; keyword-value pair → consume two items
                (= (type-of arg) "keyword")
                (do
                  (when (< (+ idx 1) n)
                    (let ((val (nth args (+ idx 1))))
                      ;; For :method, extract keyword name; for :csrf, keep as-is
                      (dict-set! opts (keyword-name arg)
                        (if (= (type-of val) "keyword")
                          (keyword-name val)
                          val))))
                  (set! i (+ idx 2)))
                ;; list → params, next element is body
                (= (type-of arg) "list")
                (do
                  (set! params (parse-key-params arg))
                  (when (< (+ idx 1) n)
                    (set! body (nth args (+ idx 1))))
                  (set! done true))
                ;; anything else → no explicit params, this is body
                :else
                (do
                  (set! body arg)
                  (set! done true))))))
        (range 0 n))
      (dict :opts opts :params params :body body))))

(define sf-defhandler
  (fn ((args :as list) (env :as dict))
    (let ((name-sym (first args))
          (name     (symbol-name name-sym))
          (parsed   (parse-handler-args (rest args)))
          (opts     (get parsed "opts"))
          (params   (get parsed "params"))
          (body     (get parsed "body")))
      (let ((hdef (make-handler-def name params body env opts)))
        (env-bind! env (str "handler:" name) hdef)
        hdef))))


;; --------------------------------------------------------------------------
;; defquery — (defquery name (&key param...) "docstring" body)
;; --------------------------------------------------------------------------

(define sf-defquery
  (fn ((args :as list) (env :as dict))
    (let ((name-sym   (first args))
          (params-raw (nth args 1))
          (name       (symbol-name name-sym))
          (params     (parse-key-params params-raw))
          ;; Optional docstring before body
          (has-doc    (and (>= (len args) 4) (= (type-of (nth args 2)) "string")))
          (doc        (if has-doc (nth args 2) ""))
          (body       (if has-doc (nth args 3) (nth args 2))))
      (let ((qdef (make-query-def name params doc body env)))
        (env-bind! env (str "query:" name) qdef)
        qdef))))


;; --------------------------------------------------------------------------
;; defaction — (defaction name (&key param...) "docstring" body)
;; --------------------------------------------------------------------------

(define sf-defaction
  (fn ((args :as list) (env :as dict))
    (let ((name-sym   (first args))
          (params-raw (nth args 1))
          (name       (symbol-name name-sym))
          (params     (parse-key-params params-raw))
          (has-doc    (and (>= (len args) 4) (= (type-of (nth args 2)) "string")))
          (doc        (if has-doc (nth args 2) ""))
          (body       (if has-doc (nth args 3) (nth args 2))))
      (let ((adef (make-action-def name params doc body env)))
        (env-bind! env (str "action:" name) adef)
        adef))))


;; --------------------------------------------------------------------------
;; defpage — (defpage name :path "/..." :auth :public :content expr ...)
;;
;; Keyword-slot form: all values after the name are :key value pairs.
;; Values are stored as unevaluated AST — resolved at request time.
;; --------------------------------------------------------------------------

(define sf-defpage
  (fn ((args :as list) (env :as dict))
    (let ((name-sym (first args))
          (name     (symbol-name name-sym))
          (slots    {}))
      ;; Parse keyword slots from remaining args
      (let ((i 1)
            (max-i (len args)))
        (for-each
          (fn ((idx :as number))
            (when (and (< idx max-i)
                       (= (type-of (nth args idx)) "keyword"))
              (when (< (+ idx 1) max-i)
                (dict-set! slots (keyword-name (nth args idx))
                           (nth args (+ idx 1))))))
          (range 1 max-i 2)))
      (let ((pdef (make-page-def name slots env)))
        (env-bind! env (str "page:" name) pdef)
        pdef))))


;; ==========================================================================
;; Page Execution Semantics
;; ==========================================================================
;;
;; A PageDef describes what to render for a route. The host evaluates slots
;; at request time.  This section specifies the data → content protocol that
;; every host must implement identically.
;;
;; Slots (all unevaluated AST):
;;   :path      — route pattern (string)
;;   :auth      — "public" | "login" | "admin"
;;   :layout    — layout reference + kwargs
;;   :stream    — boolean, opt into chunked transfer
;;   :shell     — immediate content (contains ~suspense placeholders)
;;   :fallback  — loading skeleton for single-stream mode
;;   :data      — IO expression producing bindings
;;   :content   — template expression evaluated with data bindings
;;   :filter, :aside, :menu — additional content slots
;;
;; --------------------------------------------------------------------------
;; Data Protocol
;; --------------------------------------------------------------------------
;;
;; The :data expression is evaluated at request time. It returns one of:
;;
;; 1. A dict — single-stream mode (default).
;;    Each key becomes an env binding (underscores → hyphens).
;;    Then :content is evaluated once with those bindings.
;;    Result resolves the "stream-content" suspense slot.
;;
;; 2. A sequence of dicts — multi-stream mode.
;;    The host delivers items over time (async generator, channel, etc.).
;;    Each dict:
;;      - MUST contain "stream-id" → string matching a ~suspense :id
;;      - Remaining keys become env bindings (underscores → hyphens)
;;      - :content is re-evaluated with those bindings
;;      - Result resolves the ~suspense slot matching "stream-id"
;;    If "stream-id" is absent, defaults to "stream-content".
;;
;; The host is free to choose the timing mechanism:
;;   Python  — async generator (yield dicts at intervals)
;;   Go      — channel of dicts
;;   Haskell — conduit / streaming
;;   JS      — async iterator
;;
;; The spec requires:
;;   (a) Each item's bindings are isolated (fresh env per item)
;;   (b) :content is evaluated independently for each item
;;   (c) Resolution is incremental — each item resolves as it arrives
;;   (d) "stream-id" routes to the correct ~suspense slot
;;
;; --------------------------------------------------------------------------
;; Streaming Execution Order
;; --------------------------------------------------------------------------
;;
;; When :stream is true:
;;
;; 1. Evaluate :shell (if present) → HTML for immediate content slot
;;    :shell typically contains ~suspense placeholders with :fallback
;; 2. Render HTML shell with suspense placeholders → send to client
;; 3. Start :data evaluation concurrently with header resolution
;; 4. As each data item arrives:
;;    a. Bind item keys into fresh env
;;    b. Evaluate :content with those bindings → SX wire format
;;    c. Send resolve script: __sxResolve(stream-id, sx)
;; 5. Close response when all items + headers have resolved
;;
;; Non-streaming pages evaluate :data then :content sequentially and
;; return the complete page in a single response.
;;

;; --------------------------------------------------------------------------
;; Spec helpers for multi-stream data protocol
;; --------------------------------------------------------------------------

;; Extract stream-id from a data chunk dict, defaulting to "stream-content"
(define stream-chunk-id
  (fn ((chunk :as dict))
    (if (has-key? chunk "stream-id")
      (get chunk "stream-id")
      "stream-content")))

;; Remove stream-id from chunk, returning only the bindings
(define stream-chunk-bindings
  (fn ((chunk :as dict))
    (dissoc chunk "stream-id")))

;; Normalize binding keys: underscore → hyphen
(define normalize-binding-key
  (fn ((key :as string))
    (replace key "_" "-")))

;; Bind a data chunk's keys into a fresh env (isolated per chunk)
(define bind-stream-chunk
  (fn ((chunk :as dict) (base-env :as dict))
    (let ((env (merge {} base-env))
          (bindings (stream-chunk-bindings chunk)))
      (for-each
        (fn ((key :as string))
          (env-bind! env (normalize-binding-key key)
                    (get bindings key)))
        (keys bindings))
      env)))

;; Validate a multi-stream data result: must be a list of dicts
(define validate-stream-data
  (fn (data)
    (and (= (type-of data) "list")
         (every? (fn (item) (= (type-of item) "dict")) data))))


;; --------------------------------------------------------------------------
;; defstyle — bind name to evaluated style expression
;; --------------------------------------------------------------------------

(define sf-defstyle
  (fn ((args :as list) (env :as dict))
    (let ((name-sym (first args))
          (value    (trampoline (eval-expr (nth args 1) env))))
      (env-bind! env (symbol-name name-sym) value)
      value)))


;; --------------------------------------------------------------------------
;; Registration — make these available as special forms in the evaluator
;; --------------------------------------------------------------------------

(register-special-form! "defstyle" sf-defstyle)
(register-special-form! "defhandler" sf-defhandler)
(register-special-form! "defpage" sf-defpage)
(register-special-form! "defquery" sf-defquery)
(register-special-form! "defaction" sf-defaction)