;; ==========================================================================
;; web-forms.sx — Web-specific definition forms
;;
;; Registers defhandler, defquery, defaction, defpage, and defrelation as
;; custom special forms via register-special-form!. These are web platform
;; constructs, not core language features — loaded as an extension module
;; rather than being hardcoded in the evaluator.
;;
;; Each form parses its domain-specific argument structure and stores
;; a definition dict in the environment with a namespaced key:
;;   handler:name, query:name, action:name, page:name, relation:name
;;
;; Platform hosts provide typed constructors (make-handler-def etc.) that
;; return host-appropriate values. If unavailable, plain dicts are used.
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Shared helpers
;; --------------------------------------------------------------------------

(define parse-key-params
  (fn (params-expr)
    ;; Parse (&key param1 param2 ...) → list of param name strings.
    ;; Skips &key marker, collects symbol names.
    (let ((params (list)))
      (for-each
        (fn (p)
          (when (= (type-of p) "symbol")
            (let ((name (symbol-name p)))
              (when (not (= name "&key"))
                (append! params name)))))
        params-expr)
      params)))

(define parse-handler-args
  (fn (args)
    ;; 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 (dict))
          (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
                (= (type-of arg) "keyword")
                  (do
                    (when (< (+ idx 1) n)
                      (let ((val (nth args (+ idx 1))))
                        (dict-set! opts (keyword-name arg)
                          (if (= (type-of val) "keyword")
                            (keyword-name val)
                            val))))
                    (set! i (+ idx 2)))
                (= (type-of arg) "list")
                  (do
                    (set! params (parse-key-params arg))
                    (when (< (+ idx 1) n)
                      (set! body (nth args (+ idx 1))))
                    (set! done true))
                :else
                  (do
                    (set! body arg)
                    (set! done true))))))
        (range 0 n))
      (dict "opts" opts "params" params "body" body))))


;; --------------------------------------------------------------------------
;; defhandler — Event handler / HTTP endpoint definition
;; --------------------------------------------------------------------------

(register-special-form! "defhandler"
  (fn (args env)
    (let ((name-sym (first args))
          (name (symbol-name (first args)))
          (parsed (parse-handler-args (rest args)))
          (opts (get parsed "opts"))
          (params (get parsed "params"))
          (body (get parsed "body")))
      (let ((hdef (dict
              "__type" "handler"
              "name" name
              "params" params
              "body" body
              "closure" env
              "path" (or (get opts "path") nil)
              "method" (or (get opts "method") "get")
              "csrf" (let ((v (get opts "csrf")))
                       (if (nil? v) true v))
              "returns" (or (get opts "returns") "element"))))
        (env-bind! env (str "handler:" name) hdef)
        hdef))))


;; --------------------------------------------------------------------------
;; defquery — Named query for data fetching
;; --------------------------------------------------------------------------

(register-special-form! "defquery"
  (fn (args env)
    (let ((name (symbol-name (first args)))
          (params-raw (nth args 1))
          (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 ((qdef (dict
              "__type" "query"
              "name" name
              "params" params
              "doc" doc
              "body" body
              "closure" env)))
        (env-bind! env (str "query:" name) qdef)
        qdef))))


;; --------------------------------------------------------------------------
;; defaction — Named action for mutations
;; --------------------------------------------------------------------------

(register-special-form! "defaction"
  (fn (args env)
    (let ((name (symbol-name (first args)))
          (params-raw (nth args 1))
          (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 (dict
              "__type" "action"
              "name" name
              "params" params
              "doc" doc
              "body" body
              "closure" env)))
        (env-bind! env (str "action:" name) adef)
        adef))))


;; --------------------------------------------------------------------------
;; defpage — Page route definition
;; --------------------------------------------------------------------------

(register-special-form! "defpage"
  (fn (args env)
    (let ((name (symbol-name (first args)))
          (slots (dict))
          (n (len args)))
      ;; Parse :key value pairs after the name
      (for-each
        (fn (idx)
          (let ((k-idx (+ 1 (* idx 2)))
                (v-idx (+ 2 (* idx 2))))
            (when (and (< k-idx n) (< v-idx n)
                       (= (type-of (nth args k-idx)) "keyword"))
              (dict-set! slots (keyword-name (nth args k-idx))
                         (nth args v-idx)))))
        (range 0 (/ (- n 1) 2)))
      (let ((pdef (dict
              "__type" "page"
              "name" name
              "path" (or (get slots "path") "")
              "auth" (or (get slots "auth") "public")
              "layout" (get slots "layout")
              "data" (get slots "data")
              "content" (get slots "content")
              "filter" (get slots "filter")
              "aside" (get slots "aside")
              "menu" (get slots "menu")
              "stream" (get slots "stream")
              "fallback" (get slots "fallback")
              "shell" (get slots "shell")
              "closure" env)))
        (env-bind! env (str "page:" name) pdef)
        pdef))))


;; --------------------------------------------------------------------------
;; defrelation — Relationship definition (cross-domain)
;; --------------------------------------------------------------------------

(register-special-form! "defrelation"
  (fn (args env)
    (let ((name (symbol-name (first args)))
          (slots (dict))
          (n (len args)))
      (for-each
        (fn (idx)
          (let ((k-idx (+ 1 (* idx 2)))
                (v-idx (+ 2 (* idx 2))))
            (when (and (< k-idx n) (< v-idx n)
                       (= (type-of (nth args k-idx)) "keyword"))
              (dict-set! slots (keyword-name (nth args k-idx))
                         (nth args v-idx)))))
        (range 0 (/ (- n 1) 2)))
      (let ((rdef (dict
              "__type" "relation"
              "name" name
              "slots" slots
              "closure" env)))
        (env-bind! env (str "relation:" name) rdef)
        rdef))))


;; --------------------------------------------------------------------------
;; Register web forms with adapters
;;
;; Appends form names to the extension lists that definition-form?,
;; render-html-form?, special-form? etc. check. No function wrapping —
;; survives spec reloads.
;; --------------------------------------------------------------------------

(define WEB_FORM_NAMES
  (list "defhandler" "defpage" "defquery" "defaction" "defrelation"))

;; Extend definition-form? via the stable extension point in render.sx
(for-each (fn (name)
  (append! *definition-form-extensions* name))
  WEB_FORM_NAMES)

;; Extend adapter form-name lists so dispatchers recognise web forms.
(for-each (fn (name)
  (append! RENDER_HTML_FORMS name)
  (append! SPECIAL_FORM_NAMES name))
  WEB_FORM_NAMES)