rose-ash/web/signals.sx

;; ==========================================================================
;; signals.sx — Reactive signal runtime specification
;;
;; Defines the signal primitive: a container for a value that notifies
;; subscribers when it changes. Signals are the reactive state primitive
;; for SX islands.
;;
;; Signals are pure computation — no DOM, no IO. The reactive rendering
;; layer (adapter-dom.sx) subscribes DOM nodes to signals. The server
;; adapter (adapter-html.sx) reads signal values without subscribing.
;;
;; Signals are plain dicts with a "__signal" marker key. No platform
;; primitives needed — all signal operations are pure SX.
;;
;; Reactive tracking and island lifecycle use the general scoped effects
;; system (scope-push!/scope-pop!/context) instead of separate globals.
;; Two scope names:
;;   "sx-reactive"     — tracking context for computed/effect dep discovery
;;   "sx-island-scope" — island disposable collector
;;
;; Scope-based tracking:
;;   (scope-push! "sx-reactive" {:deps (list) :notify fn}) → void
;;   (scope-pop! "sx-reactive")                            → void
;;   (context "sx-reactive" nil)                           → dict or nil
;;
;; CEK callable dispatch:
;;   (cek-call f args)         → any  — call f with args list via CEK.
;;                                       Dispatches through cek-run for SX
;;                                       lambdas, apply for native callables.
;;                                       Defined in cek.sx.
;;
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Signal container — plain dict with marker key
;; --------------------------------------------------------------------------
;;
;; A signal is a dict: {"__signal" true, "value" v, "subscribers" [], "deps" []}
;; type-of returns "dict". Use signal? to distinguish from regular dicts.

(define make-signal (fn (value)
  (dict "__signal" true "value" value "subscribers" (list) "deps" (list))))

(define signal? (fn (x)
  (and (dict? x) (has-key? x "__signal"))))

(define signal-value (fn (s) (get s "value")))
(define signal-set-value! (fn (s v) (dict-set! s "value" v)))
(define signal-subscribers (fn (s) (get s "subscribers")))

(define signal-add-sub! (fn (s f)
  (when (not (contains? (get s "subscribers") f))
    (append! (get s "subscribers") f))))

(define signal-remove-sub! (fn (s f)
  (dict-set! s "subscribers"
    (filter (fn (sub) (not (identical? sub f)))
            (get s "subscribers")))))

(define signal-deps (fn (s) (get s "deps")))
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))


;; --------------------------------------------------------------------------
;; 1. signal — create a reactive container
;; --------------------------------------------------------------------------

(define signal :effects []
  (fn ((initial-value :as any))
    (make-signal initial-value)))


;; --------------------------------------------------------------------------
;; 2. deref — read signal value, subscribe current reactive context
;; --------------------------------------------------------------------------
;;
;; In a reactive context (inside effect or computed), deref registers the
;; signal as a dependency. Outside reactive context, deref just returns
;; the current value — no subscription, no overhead.

(define deref :effects []
  (fn ((s :as any))
    (if (not (signal? s))
      s  ;; non-signal values pass through
      (let ((ctx (context "sx-reactive" nil)))
        (when ctx
          ;; Register this signal as a dependency of the current context
          (let ((dep-list (get ctx "deps"))
                (notify-fn (get ctx "notify")))
            (when (not (contains? dep-list s))
              (append! dep-list s)
              (signal-add-sub! s notify-fn))))
        (signal-value s)))))


;; --------------------------------------------------------------------------
;; 3. reset! — write a new value, notify subscribers
;; --------------------------------------------------------------------------

(define reset! :effects [mutation]
  (fn ((s :as signal) value)
    (when (signal? s)
      (let ((old (signal-value s)))
        (when (not (identical? old value))
          (signal-set-value! s value)
          (notify-subscribers s))))))


;; --------------------------------------------------------------------------
;; 4. swap! — update signal via function
;; --------------------------------------------------------------------------

(define swap! :effects [mutation]
  (fn ((s :as signal) (f :as lambda) &rest args)
    (when (signal? s)
      (let ((old (signal-value s))
            (new-val (apply f (cons old args))))
        (when (not (identical? old new-val))
          (signal-set-value! s new-val)
          (notify-subscribers s))))))


;; --------------------------------------------------------------------------
;; 5. computed — derived signal with automatic dependency tracking
;; --------------------------------------------------------------------------
;;
;; A computed signal wraps a zero-arg function. It re-evaluates when any
;; of its dependencies change. The dependency set is discovered automatically
;; by tracking deref calls during evaluation.

(define computed :effects [mutation]
  (fn ((compute-fn :as lambda))
    (let ((s (make-signal nil))
          (deps (list))
          (compute-ctx nil))

      ;; The notify function — called when a dependency changes
      (let ((recompute
              (fn ()
                ;; Unsubscribe from old deps
                (for-each
                  (fn ((dep :as signal)) (signal-remove-sub! dep recompute))
                  (signal-deps s))
                (signal-set-deps! s (list))

                ;; Push scope-based tracking context for this computed
                (let ((ctx (dict "deps" (list) "notify" recompute)))
                  (scope-push! "sx-reactive" ctx)
                  (let ((new-val (cek-call compute-fn nil)))
                    (scope-pop! "sx-reactive")
                    ;; Save discovered deps
                    (signal-set-deps! s (get ctx "deps"))
                    ;; Update value + notify downstream
                    (let ((old (signal-value s)))
                      (signal-set-value! s new-val)
                      (when (not (identical? old new-val))
                        (notify-subscribers s))))))))

        ;; Initial computation
        (recompute)
        ;; Auto-register disposal with island scope
        (register-in-scope (fn () (dispose-computed s)))
        s))))


;; --------------------------------------------------------------------------
;; 6. effect — side effect that runs when dependencies change
;; --------------------------------------------------------------------------
;;
;; Like computed, but doesn't produce a signal value. Returns a dispose
;; function that tears down the effect.

(define effect :effects [mutation]
  (fn ((effect-fn :as lambda))
    (let ((deps (list))
          (disposed false)
          (cleanup-fn nil))

      (let ((run-effect
              (fn ()
                (when (not disposed)
                  ;; Run previous cleanup if any
                  (when cleanup-fn (cek-call cleanup-fn nil))

                  ;; Unsubscribe from old deps
                  (for-each
                    (fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
                    deps)
                  (set! deps (list))

                  ;; Push scope-based tracking context
                  (let ((ctx (dict "deps" (list) "notify" run-effect)))
                    (scope-push! "sx-reactive" ctx)
                    (let ((result (cek-call effect-fn nil)))
                      (scope-pop! "sx-reactive")
                      (set! deps (get ctx "deps"))
                      ;; If effect returns a function, it's the cleanup
                      (when (callable? result)
                        (set! cleanup-fn result))))))))

        ;; Initial run
        (run-effect)

        ;; Return dispose function
        (let ((dispose-fn
                (fn ()
                  (set! disposed true)
                  (when cleanup-fn (cek-call cleanup-fn nil))
                  (for-each
                    (fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
                    deps)
                  (set! deps (list)))))
          ;; Auto-register with island scope so disposal happens on swap
          (register-in-scope dispose-fn)
          dispose-fn)))))


;; --------------------------------------------------------------------------
;; 7. batch — group multiple signal writes into one notification pass
;; --------------------------------------------------------------------------
;;
;; During a batch, signal writes are deferred. Subscribers are notified
;; once at the end, after all values have been updated.

(define *batch-depth* 0)
(define *batch-queue* (list))

(define batch :effects [mutation]
  (fn ((thunk :as lambda))
    (set! *batch-depth* (+ *batch-depth* 1))
    (cek-call thunk nil)
    (set! *batch-depth* (- *batch-depth* 1))
    (when (= *batch-depth* 0)
      (let ((queue *batch-queue*))
        (set! *batch-queue* (list))
        ;; Collect unique subscribers across all queued signals,
        ;; then notify each exactly once.
        (let ((seen (list))
              (pending (list)))
          (for-each
            (fn ((s :as signal))
              (for-each
                (fn ((sub :as lambda))
                  (when (not (contains? seen sub))
                    (append! seen sub)
                    (append! pending sub)))
                (signal-subscribers s)))
            queue)
          (for-each (fn ((sub :as lambda)) (sub)) pending))))))


;; --------------------------------------------------------------------------
;; 8. notify-subscribers — internal notification dispatch
;; --------------------------------------------------------------------------
;;
;; If inside a batch, queues the signal. Otherwise, notifies immediately.

(define notify-subscribers :effects [mutation]
  (fn ((s :as signal))
    (if (> *batch-depth* 0)
      (when (not (contains? *batch-queue* s))
        (append! *batch-queue* s))
      (flush-subscribers s))))

(define flush-subscribers :effects [mutation]
  (fn ((s :as signal))
    (for-each
      (fn ((sub :as lambda)) (sub))
      (signal-subscribers s))))


;; --------------------------------------------------------------------------
;; 9. Reactive tracking context
;; --------------------------------------------------------------------------
;;
;; Tracking is now scope-based. computed/effect push a dict
;; {:deps (list) :notify fn} onto the "sx-reactive" scope stack via
;; scope-push!/scope-pop!. deref reads it via (context "sx-reactive" nil).
;; No platform primitives needed — uses the existing scope infrastructure.


;; --------------------------------------------------------------------------
;; 10. dispose — tear down a computed signal
;; --------------------------------------------------------------------------
;;
;; For computed signals, unsubscribe from all dependencies.
;; For effects, the dispose function is returned by effect itself.

(define dispose-computed :effects [mutation]
  (fn ((s :as signal))
    (when (signal? s)
      (for-each
        (fn ((dep :as signal)) (signal-remove-sub! dep nil))
        (signal-deps s))
      (signal-set-deps! s (list)))))


;; --------------------------------------------------------------------------
;; 11. Island scope — automatic cleanup of signals within an island
;; --------------------------------------------------------------------------
;;
;; When an island is created, all signals, effects, and computeds created
;; within it are tracked. When the island is removed from the DOM, they
;; are all disposed.
;;
;; Uses "sx-island-scope" scope name. The scope value is a collector
;; function (fn (disposable) ...) that appends to the island's disposer list.

(define with-island-scope :effects [mutation]
  (fn ((scope-fn :as lambda) (body-fn :as lambda))
    (scope-push! "sx-island-scope" scope-fn)
    (let ((result (body-fn)))
      (scope-pop! "sx-island-scope")
      result)))

;; Hook into signal/effect/computed creation for scope tracking.

(define register-in-scope :effects [mutation]
  (fn ((disposable :as lambda))
    (let ((collector (context "sx-island-scope" nil)))
      (when collector
        (cek-call collector (list disposable))))))


;; ==========================================================================
;; 12. Marsh scopes — child scopes within islands
;; ==========================================================================
;;
;; Marshes are zones inside islands where server content is re-evaluated
;; in the island's reactive context. When a marsh is re-morphed with new
;; content, its old effects and computeds must be disposed WITHOUT disturbing
;; the island's own reactive graph.
;;
;; Scope hierarchy: island → marsh → effects/computeds
;; Disposing a marsh disposes its subscope. Disposing an island disposes
;; all its marshes. The signal graph is a tree, not a flat list.
;;
;; Platform interface required:
;;   (dom-set-data el key val) → void  — store JS value on element
;;   (dom-get-data el key)     → any   — retrieve stored value

(define with-marsh-scope :effects [mutation io]
  (fn (marsh-el (body-fn :as lambda))
    ;; Execute body-fn collecting all disposables into a marsh-local list.
    ;; Nested under the current island scope — if the island is disposed,
    ;; the marsh is disposed too (because island scope collected the marsh's
    ;; own dispose function).
    (let ((disposers (list)))
      (with-island-scope
        (fn (d) (append! disposers d))
        body-fn)
      ;; Store disposers on the marsh element for later cleanup
      (dom-set-data marsh-el "sx-marsh-disposers" disposers))))

(define dispose-marsh-scope :effects [mutation io]
  (fn (marsh-el)
    ;; Dispose all effects/computeds registered in this marsh's scope.
    ;; Parent island scope and sibling marshes are unaffected.
    (let ((disposers (dom-get-data marsh-el "sx-marsh-disposers")))
      (when disposers
        (for-each (fn ((d :as lambda)) (cek-call d nil)) disposers)
        (dom-set-data marsh-el "sx-marsh-disposers" nil)))))


;; ==========================================================================
;; 13. Named stores — page-level signal containers (L3)
;; ==========================================================================
;;
;; Stores persist across island creation/destruction. They live at page
;; scope, not island scope. When an island is swapped out and re-created,
;; it reconnects to the same store instance.
;;
;; The store registry is global page-level state. It survives island
;; disposal but is cleared on full page navigation.

(define *store-registry* (dict))

(define def-store :effects [mutation]
  (fn ((name :as string) (init-fn :as lambda))
    (let ((registry *store-registry*))
      ;; Only create the store once — subsequent calls return existing
      (when (not (has-key? registry name))
        (set! *store-registry* (assoc registry name (cek-call init-fn nil))))
      (get *store-registry* name))))

(define use-store :effects []
  (fn ((name :as string))
    (if (has-key? *store-registry* name)
      (get *store-registry* name)
      (error (str "Store not found: " name
                  ". Call (def-store ...) before (use-store ...).")))))

(define clear-stores :effects [mutation]
  (fn ()
    (set! *store-registry* (dict))))


;; ==========================================================================
;; 13. Event bridge — DOM event communication for lake→island
;; ==========================================================================
;;
;; Server-rendered content ("htmx lakes") inside reactive islands can
;; communicate with island signals via DOM custom events. The bridge
;; pattern:
;;
;;   1. Server renders a button/link with data-sx-emit="event-name"
;;   2. When clicked, the client dispatches a CustomEvent on the element
;;   3. The event bubbles up to the island container
;;   4. An island effect listens for the event and updates signals
;;
;; This keeps server content pure HTML — no signal references needed.
;; The island effect is the only reactive code.
;;
;; Platform interface required:
;;   (dom-listen el event-name handler)   → remove-fn
;;   (dom-dispatch el event-name detail)  → void
;;   (event-detail e)                     → any
;;
;; These are platform primitives because they require browser DOM APIs.

(define emit-event :effects [io]
  (fn (el (event-name :as string) detail)
    (dom-dispatch el event-name detail)))

(define on-event :effects [io]
  (fn (el (event-name :as string) (handler :as lambda))
    (dom-on el event-name handler)))

;; Convenience: create an effect that listens for a DOM event on an
;; element and writes the event detail (or a transformed value) into
;; a target signal. Returns the effect's dispose function.
;; When the effect is disposed (island teardown), the listener is
;; removed automatically via the cleanup return.

(define bridge-event :effects [mutation io]
  (fn (el (event-name :as string) (target-signal :as signal) transform-fn)
    (effect (fn ()
      (let ((remove (dom-on el event-name
              (fn (e)
                (let ((detail (event-detail e))
                      (new-val (if transform-fn
                                 (cek-call transform-fn (list detail))
                                 detail)))
                  (reset! target-signal new-val))))))
        ;; Return cleanup — removes listener on dispose/re-run
        remove)))))


;; ==========================================================================
;; 14. Resource — async signal with loading/resolved/error states
;; ==========================================================================
;;
;; A resource wraps an async operation (fetch, computation) and exposes
;; its state as a signal. The signal transitions through:
;;   {:loading true  :data nil    :error nil}  — initial/loading
;;   {:loading false :data result :error nil}  — success
;;   {:loading false :data nil    :error err}  — failure
;;
;; Usage:
;;   (let ((user (resource (fn () (fetch-json "/api/user")))))
;;     (cond
;;       (get (deref user) "loading")  (div "Loading...")
;;       (get (deref user) "error")    (div "Error: " (get (deref user) "error"))
;;       :else                         (div (get (deref user) "data"))))
;;
;; Platform interface required:
;;   (promise-then promise on-resolve on-reject) → void

(define resource :effects [mutation io]
  (fn ((fetch-fn :as lambda))
    (let ((state (signal (dict "loading" true "data" nil "error" nil))))
      ;; Kick off the async operation
      (promise-then (cek-call fetch-fn nil)
        (fn (data) (reset! state (dict "loading" false "data" data "error" nil)))
        (fn (err) (reset! state (dict "loading" false "data" nil "error" err))))
      state)))