Add biff/use-htmx-refresh

src/com/biffweb.clj

@@ -9,6 +9,7 @@
             [com.biffweb.impl.queues :as q]
             [com.biffweb.impl.rum :as brum]
             [com.biffweb.impl.time :as time]
+            [com.biffweb.impl.htmx-refresh :as htmx-refresh]
             [com.biffweb.impl.util :as util]
             [com.biffweb.impl.util.ns :as ns]
             [com.biffweb.impl.util.reload :as reload]
@@ -249,10 +250,18 @@
   (apply util/fix-print* body))
 
 (defn eval-files!
-  "Evaluates any modified files and their dependents via clojure.tools.namespace."
-  [{:keys [biff/eval-paths]
-    :or {eval-paths ["src"]}}]
-  (swap! reload/global-tracker reload/refresh eval-paths))
+  "Evaluates any modified files and their dependents via clojure.tools.namespace.
+
+   Returns the evaluation result. If set, `on-eval` is a sequence of 2-parameter
+   callback functions which will each be called with `ctx` and the evaluation
+   result."
+  [{:keys [biff/eval-paths biff.eval/on-eval]
+    :or {eval-paths ["src"]}
+    :as ctx}]
+  (let [result (swap! reload/global-tracker reload/refresh eval-paths)]
+    (doseq [f on-eval]
+      (f ctx result))
+    result))
 
 (defn add-libs
   "Loads new dependencies in deps.edn via tools.deps.alpha.
@@ -1049,6 +1058,17 @@
     :as opts}]
   (misc/doc-schema opts))
 
+(defn use-htmx-refresh
+  "Refreshes the browser automatically when you save a file.
+
+   If `enabled` is true, wraps `handler` with middleware that will insert some
+   htmx websocket code into HTML responses. Adds a callback function to
+   (:biff.eval/on-eval ctx) that will send a refresh command via websocket (see
+   biff/eval-files!). If you have a compilation error, that will be displayed
+   instead of refreshing."
+  [{:keys [biff/handler biff.refresh/enabled] :as ctx}]
+  (htmx-refresh/use-htmx-refresh ctx))
+
 ;;;; Queues
 
 (defn use-queues

src/com/biffweb/impl/htmx_refresh.clj

@@ -0,0 +1,60 @@
+(ns com.biffweb.impl.htmx-refresh
+  (:require [com.biffweb.impl.rum :as brum]
+            [clojure.string :as str]
+            [ring.adapter.jetty9 :as jetty]
+            [ring.util.response :as ru-response]
+            [rum.core :as rum]))
+
+(defn send-message! [{:keys [biff.refresh/clients]} content]
+  (let [html (rum/render-static-markup
+              [:div#biff-refresh {:hx-swap-oob "innerHTML"}
+               content])]
+    (doseq [ws @clients]
+      (jetty/send! ws html))))
+
+(defn ws-handler [{:keys [biff.refresh/clients] :as ctx}]
+  {:status 101
+   :headers {"upgrade" "websocket"
+             "connection" "upgrade"}
+   :ws {:on-connect (fn [ws]
+                      (swap! clients conj ws))
+        :on-close (fn [ws status-code reason]
+                    (swap! clients disj ws))}})
+
+(def snippet
+  (str (rum/render-static-markup
+        [:div#biff-refresh {:hx-ext "ws"
+                            :ws-connect "/__biff/refresh"}])
+       "</body>"))
+
+(defn insert-refresh-snippet [{:keys [body] :as response}]
+  (if-let [body-str (and (str/includes? (or (ru-response/get-header response "content-type") "") "text/html")
+                         (cond
+                           (string? body) body
+                           (#{java.io.InputStream java.io.File} (type body)) (slurp body)))]
+    (-> response
+        (assoc :body (str/replace body-str "</body>" snippet))
+        (update :headers dissoc (some-> (ru-response/find-header response "content-length") key)))
+    response))
+
+(defn wrap-htmx-refresh [handler]
+  (fn [{:keys [uri] :as ctx}]
+    (if (= uri "/__biff/refresh")
+      (ws-handler ctx)
+      (insert-refresh-snippet (handler ctx)))))
+
+(defn send-refresh-command [ctx {:clojure.tools.namespace.reload/keys [error error-ns]}]
+  (send-message! ctx (if (some? error)
+                       [:script (assoc (brum/unsafe "alert(document.querySelector('[data-biff-refresh-message]').getAttribute('data-biff-refresh-message'))")
+                                       :data-biff-refresh-message
+                                       (str "Compilation error in namespace " error-ns ": "
+                                            (.getMessage (.getCause error))))]
+                       [:script (brum/unsafe "location.reload()")])))
+
+(defn use-htmx-refresh [{:keys [biff/handler biff.refresh/enabled] :as ctx}]
+  (if-not enabled
+    ctx
+    (-> ctx
+        (assoc :biff.refresh/clients (atom #{}))
+        (update :biff/handler wrap-htmx-refresh)
+        (update :biff.eval/on-eval conj #'send-refresh-command))))

starter/src/com/example.clj

@@ -90,4 +90,5 @@
   (doseq [f (:biff/stop @system)]
     (log/info "stopping:" (str f))
     (f))
-  (tn-repl/refresh :after `start))
+  (tn-repl/refresh :after `start)
+  :done)