awwx · March 28, 2024 10:25
diff --git a/main.cljc b/main.cljc
 (ns main
  (:require
   [missionary.core :as m]
   [hyperfiddle.electric :as e]
   [hyperfiddle.electric-dom2 :as dom])
  #?(:cljs
     (:require-macros [main])))

 ;; event emitter with only one subscriber

 (defn new-emitter []
  {:vcallback (volatile! nil)})

 (defn subscribe [emitter callback]
  (let [vcallback (:vcallback emitter)]
    (when @vcallback (throw (ex-info "already have subscriber" {})))
    (vreset! vcallback callback)
    nil))

 (defn unsubscribe [emitter]
  (let [vcallback (:vcallback emitter)]
    (when-not @vcallback (throw (ex-info "no subscriber" {})))
    (vreset! vcallback nil)))

 (defn publish [emitter v]
  (let [callback @(:vcallback emitter)]
    (when-not callback (throw (ex-info "no subscriber" {})))
    (callback v)
    nil))

 ;; observe events published to the emitter

 (defn make-observer [emitter]
  (m/observe
   (fn [callback]
     (subscribe emitter callback)
     (fn []
       (unsubscribe emitter)))))

 ;; A state is a continuous flow constructed by reducing a discrete
 ;; flow of updates.
 ;;
 ;; An update is a function of one argument, the previous state, and
 ;; the function returns the new state.

 (defn reduce-update [state f]
  (f state))

 ;; Returns a vector of two objects:
 ;;   - a continuous flow of the state value
 ;;   - an update function to call to update the state

 (defn new-state [initial-value]
  (let [update-emitter (new-emitter)
        updates> (make-observer update-emitter)]
    [(m/relieve
      (m/reductions reduce-update initial-value updates>))

     (fn [f & args]
       (publish update-emitter (fn [state] (apply f state args))))]))

 ;; Boot into Electric

 (e/defn State [initial-value]
  (let [[state< swap-state!] (new-state initial-value)]
    [(new state<) swap-state!]))

 ;; Calls `act` on each value of discete flow `f` for side effects.
 ;; Returns a flow of nil's for integration into Electric.  Is
 ;; that necessary?  I don't know.

 (defn mforeach [f act]
  (m/reductions
   (fn [_ x] (act x) nil)
   nil
   f))

 ;; Simple DOM listener.  Not reactive, just adds the event
 ;; listener on mount and removes on unmount.

 (defn mlisten> [node event]
  (m/observe
   (fn mount [emit!]
     (let [f (fn [e] (emit! e))]
       (.addEventListener node event f)
       (fn unmount []
         (.removeEventListener node event f))))))

 ;; A "snapshot function" samples the current values of reactive
 ;; expressions at the time an event occurs.
 ;;
 ;; The sfn isn't itself reactive: a new one is not generated when
 ;; reactive inputs change.  (Contrast with `fn` in an Electric
 ;; expression).
 ;;
 ;; Use like this, where `data` is a reactive value:
 ;;   (sfn [id (:id data)] [event]
 ;;     (prn "at the time of the event" event "id was" id))
 ;;
 ;; Don't put any reactive expressions in the body!  That will
 ;; break the implementation.

 (defmacro sfn [reactive-bindings fn-params & body]
  (let [pairs (partition 2 reactive-bindings)
        reactive-params (map first pairs)
        reactive-inputs (map second pairs)]
    `{:reactive-inputs (e/fn [] [~@reactive-inputs])
      :fn (fn [~@reactive-params ~@fn-params] ~@body)}))

 ;; Given a discrete flow of events, call the snapshot function for
 ;; each one.

 (defn mforeach-event [>events sf]
  (mforeach
   (m/sample vector (:reactive-inputs sf) >events)
   (fn [[snapshot event]]
     (apply (:fn sf) (concat snapshot (list event))))))

 ;; Boot into Electric.

 (e/defn foreach-event [>events sf]
  (new (mforeach-event >events sf)))

 ;; Attach an event listener to the current DOM node and
 ;; call the snapshot function on each event.

 (e/defn son! [event-type sf]
  (e/client
   (foreach-event. (mlisten> dom/node event-type) sf)))

 ;; I don't believe it's possible to use a sfn at the point
 ;; of unmount.  The problem is that responding to events using
 ;; a sfn is implemented by reducing the flow of events, and
 ;; of course at the time of unmount the flow is being shut down.
 ;;
 ;; We can however set up an observer higher up in the DOM hierarchy
 ;; which can watch the mount and unmount of a child, and
 ;; get a snapshot of reactive values at the time of the child's mount
 ;; or unmount.
 ;;
 ;; This isn't as convenient as simply being able to call
 ;; `e/on-unmount` with a function, but has well-defined semantics.
 ;; I think? Not relying on super-specific details of Electric
 ;; evaluation, just straight-forward reactive DAG. I hope :)
 ;;
 ;; Returns a callback.  Call the callback with an event.  The
 ;; snapshot function will be called for each event.

 (e/defn Observer [sf]
  (let [emitter (new-emitter)
        observer> (make-observer emitter)]
    (foreach-event. observer> sf)
    (fn [event] (publish emitter event))))

 ;; Report lifecycle events up to an observer higher in the hierarchy.

 (e/defn Lifecycle [observer]
  (observer :mount)
  (e/on-unmount (fn [] (observer :unmount))))

 (e/defn Main [ring-request]
  (e/client
   (binding [dom/node js/document.body]
     ;; `state` is a reactive value of the current state, much
     ;; like (e/watch !state).  Call swap-state! to update
     ;; the state, much like (swap! !state ...)
     (let [[state swap-state!] (State. {:show false})]
       (dom/div
        (dom/pre
         (dom/text "state: " (pr-str state))))

       (dom/div
        (dom/button
         (dom/props {:id "show-button"})
         (dom/text (if (:show state) "Hide" "Show"))

         (son!. "click"
           (sfn [state-snapshot state] [event]
             (println
              (str
               "at the time of the click event, the state was "
               (pr-str state-snapshot)
               ", shift key pressed " (.-shiftKey event)))
             (swap-state! update :show not))))

        ;; Here's where we need an observer that won't be unmounted
        ;; to report on the lifecycle of a child that will be
        ;; unmounted.

        (let [observer
              (Observer.
               (sfn [show (:show state)] [event]
                 (println
                  (str
                   "at the time of " (name event) ", show was " show))))]
          (when (:show state)
            (dom/div
             (dom/text "child content")
             (Lifecycle. observer)))))))))
	(ns main
	(:require
	[missionary.core :as m]
	[hyperfiddle.electric :as e]
	[hyperfiddle.electric-dom2 :as dom])
	#?(:cljs
	(:require-macros [main])))

	;; event emitter with only one subscriber

	(defn new-emitter []
	{:vcallback (volatile! nil)})

	(defn subscribe [emitter callback]
	(let [vcallback (:vcallback emitter)]
	(when @vcallback (throw (ex-info "already have subscriber" {})))
	(vreset! vcallback callback)
	nil))

	(defn unsubscribe [emitter]
	(let [vcallback (:vcallback emitter)]
	(when-not @vcallback (throw (ex-info "no subscriber" {})))
	(vreset! vcallback nil)))

	(defn publish [emitter v]
	(let [callback @(:vcallback emitter)]
	(when-not callback (throw (ex-info "no subscriber" {})))
	(callback v)
	nil))

	;; observe events published to the emitter

	(defn make-observer [emitter]
	(m/observe
	(fn [callback]
	(subscribe emitter callback)
	(fn []
	(unsubscribe emitter)))))

	;; A state is a continuous flow constructed by reducing a discrete
	;; flow of updates.
	;;
	;; An update is a function of one argument, the previous state, and
	;; the function returns the new state.

	(defn reduce-update [state f]
	(f state))

	;; Returns a vector of two objects:
	;; - a continuous flow of the state value
	;; - an update function to call to update the state

	(defn new-state [initial-value]
	(let [update-emitter (new-emitter)
	updates> (make-observer update-emitter)]
	[(m/relieve
	(m/reductions reduce-update initial-value updates>))

	(fn [f & args]
	(publish update-emitter (fn [state] (apply f state args))))]))

	;; Boot into Electric

	(e/defn State [initial-value]
	(let [[state< swap-state!] (new-state initial-value)]
	[(new state<) swap-state!]))

	;; Calls `act` on each value of discete flow `f` for side effects.
	;; Returns a flow of nil's for integration into Electric. Is
	;; that necessary? I don't know.

	(defn mforeach [f act]
	(m/reductions
	(fn [_ x] (act x) nil)
	nil
	f))

	;; Simple DOM listener. Not reactive, just adds the event
	;; listener on mount and removes on unmount.

	(defn mlisten> [node event]
	(m/observe
	(fn mount [emit!]
	(let [f (fn [e] (emit! e))]
	(.addEventListener node event f)
	(fn unmount []
	(.removeEventListener node event f))))))

	;; A "snapshot function" samples the current values of reactive
	;; expressions at the time an event occurs.
	;;
	;; The sfn isn't itself reactive: a new one is not generated when
	;; reactive inputs change. (Contrast with `fn` in an Electric
	;; expression).
	;;
	;; Use like this, where `data` is a reactive value:
	;; (sfn [id (:id data)] [event]
	;; (prn "at the time of the event" event "id was" id))
	;;
	;; Don't put any reactive expressions in the body! That will
	;; break the implementation.

	(defmacro sfn [reactive-bindings fn-params & body]
	(let [pairs (partition 2 reactive-bindings)
	reactive-params (map first pairs)
	reactive-inputs (map second pairs)]
	`{:reactive-inputs (e/fn [] [~@reactive-inputs])
	:fn (fn [~@reactive-params ~@fn-params] ~@body)}))

	;; Given a discrete flow of events, call the snapshot function for
	;; each one.

	(defn mforeach-event [>events sf]
	(mforeach
	(m/sample vector (:reactive-inputs sf) >events)
	(fn [[snapshot event]]
	(apply (:fn sf) (concat snapshot (list event))))))

	;; Boot into Electric.

	(e/defn foreach-event [>events sf]
	(new (mforeach-event >events sf)))

	;; Attach an event listener to the current DOM node and
	;; call the snapshot function on each event.

	(e/defn son! [event-type sf]
	(e/client
	(foreach-event. (mlisten> dom/node event-type) sf)))

	;; I don't believe it's possible to use a sfn at the point
	;; of unmount. The problem is that responding to events using
	;; a sfn is implemented by reducing the flow of events, and
	;; of course at the time of unmount the flow is being shut down.
	;;
	;; We can however set up an observer higher up in the DOM hierarchy
	;; which can watch the mount and unmount of a child, and
	;; get a snapshot of reactive values at the time of the child's mount
	;; or unmount.
	;;
	;; This isn't as convenient as simply being able to call
	;; `e/on-unmount` with a function, but has well-defined semantics.
	;; I think? Not relying on super-specific details of Electric
	;; evaluation, just straight-forward reactive DAG. I hope :)
	;;
	;; Returns a callback. Call the callback with an event. The
	;; snapshot function will be called for each event.

	(e/defn Observer [sf]
	(let [emitter (new-emitter)
	observer> (make-observer emitter)]
	(foreach-event. observer> sf)
	(fn [event] (publish emitter event))))

	;; Report lifecycle events up to an observer higher in the hierarchy.

	(e/defn Lifecycle [observer]
	(observer :mount)
	(e/on-unmount (fn [] (observer :unmount))))

	(e/defn Main [ring-request]
	(e/client
	(binding [dom/node js/document.body]
	;; `state` is a reactive value of the current state, much
	;; like (e/watch !state). Call swap-state! to update
	;; the state, much like (swap! !state ...)
	(let [[state swap-state!] (State. {:show false})]
	(dom/div
	(dom/pre
	(dom/text "state: " (pr-str state))))

	(dom/div
	(dom/button
	(dom/props {:id "show-button"})
	(dom/text (if (:show state) "Hide" "Show"))

	(son!. "click"
	(sfn [state-snapshot state] [event]
	(println
	(str
	"at the time of the click event, the state was "
	(pr-str state-snapshot)
	", shift key pressed " (.-shiftKey event)))
	(swap-state! update :show not))))

	;; Here's where we need an observer that won't be unmounted
	;; to report on the lifecycle of a child that will be
	;; unmounted.

	(let [observer
	(Observer.
	(sfn [show (:show state)] [event]
	(println
	(str
	"at the time of " (name event) ", show was " show))))]
	(when (:show state)
	(dom/div
	(dom/text "child content")
	(Lifecycle. observer)))))))))