Merge pull request #373 from ClojureCivitas/babqua-support

Babqua support

Author: daslu

.github/workflows/render-and-publish.yml

@@ -16,6 +16,8 @@ jobs:
     steps:
       - name: Check out repository
         uses: actions/checkout@v4
+        with:
+          fetch-depth: 0  # full history so posts can mine `git log` (Babqua demos)
 
       - name: Set up Python
         uses: actions/setup-python@v5

.gitignore

@@ -47,6 +47,11 @@ _site/
 .jank-nrepl-port
 .jank-repl.log
 
+# Babqua nREPL lifecycle files (created in the Quarto rendering directory)
+.babqua-pid
+.babqua-nrepl-port
+.babqua-bb.log
+
 # Edit at https://www.toptal.com/developers/gitignore?templates=osx
 
 ### OSX ###

site/_extensions/scicloj/bb/_extension.yml

@@ -0,0 +1,6 @@
+title: Babqua
+author: scicloj
+version: 0.1.0
+contributes:
+  filters:
+    - babqua.lua

site/_extensions/scicloj/bb/babqua-lifecycle.bb

@@ -0,0 +1,227 @@
+#!/usr/bin/env bb
+;; babqua-lifecycle.bb — manage the persistent bb nREPL process used by
+;; Babqua's preview mode.
+;;
+;; Usage:
+;;   bb babqua-lifecycle.bb start    — start nREPL if not running, print port
+;;   bb babqua-lifecycle.bb stop     — stop nREPL, clean up files
+;;   bb babqua-lifecycle.bb status   — print port if running, exit 1 if not
+;;
+;; State files live at the project root (resolved by walking up from cwd
+;; looking for an existing .babqua-pid, or BABQUA_PROJECT_ROOT, else cwd):
+;;   .babqua-pid           — PID of the spawned `bb nrepl-server`
+;;   .babqua-nrepl-port    — port the nREPL is listening on
+;;   .babqua-bb.log        — combined stdout+stderr of the spawned process
+;;
+;; Defensive choices: atomic file writes, PID validation before
+;; kill, cleanup-on-death monitor, project-root sense check.
+
+(ns babqua.lifecycle
+  (:require [babashka.fs :as fs]
+            [babashka.process :as p]
+            [clojure.string :as str]))
+
+;; ----- project root resolution -----------------------------------------
+
+(defn- resolve-project-root []
+  (or (System/getenv "BABQUA_PROJECT_ROOT")
+      (loop [d (fs/cwd)]
+        (cond
+          (nil? d) (str (fs/cwd))
+          (fs/exists? (fs/path d ".babqua-pid")) (str d)
+          (= (str d) "/") (str (fs/cwd))
+          :else (recur (fs/parent d))))))
+
+(def project-root (delay (resolve-project-root)))
+
+(defn- guard-root []
+  (when (or (= @project-root "/") (str/blank? @project-root))
+    (binding [*out* *err*]
+      (println (str "[babqua-lifecycle] ERROR: refusing to operate with "
+                    "project-root=" (pr-str @project-root))))
+    (System/exit 1)))
+
+(defn- pid-file []  (str (fs/path @project-root ".babqua-pid")))
+(defn- port-file [] (str (fs/path @project-root ".babqua-nrepl-port")))
+(defn- log-file []  (str (fs/path @project-root ".babqua-bb.log")))
+
+;; ----- atomic IO -------------------------------------------------------
+
+(defn- atomic-write! [path content]
+  (let [tmp (str path ".tmp." (System/currentTimeMillis) "." (rand-int 1000000))]
+    (spit tmp content)
+    (fs/move tmp path {:replace-existing true})))
+
+(defn- read-pid []
+  (when (fs/exists? (pid-file))
+    (try (Long/parseLong (str/trim (slurp (pid-file))))
+         (catch Exception _
+           (binding [*out* *err*]
+             (println "[babqua-lifecycle] WARN: corrupt PID file, removing"))
+           (fs/delete-if-exists (pid-file))
+           (fs/delete-if-exists (port-file))
+           nil))))
+
+;; ----- process probing -------------------------------------------------
+
+(defn- pid-alive? [pid]
+  (try (zero? (:exit @(p/process ["kill" "-0" (str pid)]
+                                 {:out :discard :err :discard})))
+       (catch Exception _ false)))
+
+;; A "babqua-managed" process is one whose argv contains "nrepl-server".
+;; We don't try to fingerprint further — pidfile + project-root anchoring
+;; already prevents most cross-talk. Defends only against the recycled-PID
+;; race where the OS assigned our old PID to an unrelated user process.
+(defn- babqua-process? [pid]
+  (try (let [{:keys [exit out]}
+             @(p/process ["ps" "-o" "args=" "-p" (str pid)]
+                         {:out :string :err :discard})]
+         (and (zero? exit)
+              (str/includes? (or out "") "nrepl-server")))
+       (catch Exception _ false)))
+
+;; ----- start -----------------------------------------------------------
+
+(defn- already-running? []
+  (when-let [pid (read-pid)]
+    (and (pid-alive? pid) (babqua-process? pid))))
+
+(defn- write-loud! [lines]
+  (binding [*out* *err*]
+    (let [sep (apply str (repeat 64 "="))]
+      (println sep)
+      (doseq [l lines] (println (str "[babqua-lifecycle] " l)))
+      (println sep))))
+
+(defn cmd-start []
+  (guard-root)
+  (when (already-running?)
+    (let [port (when (fs/exists? (port-file))
+                 (str/trim (slurp (port-file))))]
+      (binding [*out* *err*]
+        (println (str "[babqua-lifecycle] Already running on port "
+                      (or port "?") " (PID " (read-pid) ")")))
+      (when port (println port))
+      (System/exit (if port 0 1))))
+
+  ;; Stale files from a dead session?
+  (when (read-pid)
+    (fs/delete-if-exists (pid-file))
+    (fs/delete-if-exists (port-file)))
+
+  (spit (log-file) "")
+  (binding [*out* *err*]
+    (println "[babqua-lifecycle] Starting bb nREPL..."))
+
+  (let [proc (p/process {:cmd ["bb" "nrepl-server" "localhost:0"]
+                         :out (java.io.File. (log-file))
+                         :err :out
+                         :dir @project-root})
+        pid (.pid (:proc proc))]
+    (atomic-write! (pid-file) (str pid))
+
+    ;; Poll log file for the "Started nREPL server at host:port" line.
+    ;; Generous deadline because cold bb under load can take a moment.
+    (let [deadline (+ (System/currentTimeMillis) 30000)
+          port (loop []
+                 (cond
+                   (not (pid-alive? pid))
+                   (do (write-loud! ["bb died during startup. Check"
+                                     (log-file)])
+                       (fs/delete-if-exists (pid-file))
+                       nil)
+
+                   (> (System/currentTimeMillis) deadline)
+                   (do (write-loud! ["Timed out (30s) waiting for nREPL."
+                                     (str "Check " (log-file))])
+                       (try (.destroy (:proc proc)) (catch Exception _))
+                       (fs/delete-if-exists (pid-file))
+                       nil)
+
+                   :else
+                   (let [content (try (slurp (log-file))
+                                      (catch Exception _ ""))]
+                     (if-let [m (re-find #"Started nREPL server at [^:]+:(\d+)"
+                                         content)]
+                       (second m)
+                       (do (Thread/sleep 100) (recur))))))]
+      (when-not port (System/exit 1))
+      (atomic-write! (port-file) port)
+      (write-loud!
+       [(str "bb nREPL on port " port " (PID " pid ")")
+        (str "Stop with: bb " (or (System/getenv "BABQUA_LIFECYCLE_PATH")
+                                  "_extensions/bb/babqua-lifecycle.bb")
+             " stop")])
+      (println port))))
+
+;; ----- stop ------------------------------------------------------------
+
+(defn- escalate-after-sigterm [pid]
+  (loop [i 0]
+    (cond
+      (not (pid-alive? pid)) :gone
+      (>= i 10)
+      (try @(p/process ["kill" "-9" (str pid)] {:out :discard :err :discard})
+           (catch Exception _ nil))
+      :else (do (Thread/sleep 100) (recur (inc i))))))
+
+(defn cmd-stop []
+  (guard-root)
+  (let [pid (read-pid)]
+    (cond
+      (nil? pid)
+      (binding [*out* *err*]
+        (println (str "[babqua-lifecycle] No PID file at " (pid-file)
+                      " — nothing to stop."))
+        (fs/delete-if-exists (port-file)))
+
+      (not (pid-alive? pid))
+      (do (binding [*out* *err*]
+            (println "[babqua-lifecycle] PID file references dead process; cleaning up."))
+          (fs/delete-if-exists (pid-file))
+          (fs/delete-if-exists (port-file)))
+
+      (not (babqua-process? pid))
+      (binding [*out* *err*]
+        (println (str "[babqua-lifecycle] WARN: PID " pid
+                      " is not an nrepl-server; refusing to kill."))
+        (fs/delete-if-exists (pid-file))
+        (fs/delete-if-exists (port-file)))
+
+      :else
+      (do (binding [*out* *err*]
+            (println (str "[babqua-lifecycle] Stopping bb nREPL (PID " pid ")")))
+          (try @(p/process ["kill" (str pid)] {:out :discard :err :discard})
+               (catch Exception _ nil))
+          (escalate-after-sigterm pid)
+          (fs/delete-if-exists (pid-file))
+          (fs/delete-if-exists (port-file))
+          (binding [*out* *err*]
+            (println "[babqua-lifecycle] Stopped."))))))
+
+;; ----- status ----------------------------------------------------------
+
+(defn cmd-status []
+  (guard-root)
+  (let [pid (read-pid)]
+    (cond
+      (and pid (pid-alive? pid) (babqua-process? pid)
+           (fs/exists? (port-file)))
+      (do (println (str "running on port " (str/trim (slurp (port-file)))
+                        " (PID " pid ")"))
+          (System/exit 0))
+
+      :else
+      (do (println "not running")
+          (System/exit 1)))))
+
+;; ----- dispatch --------------------------------------------------------
+
+(case (first *command-line-args*)
+  "start"  (cmd-start)
+  "stop"   (cmd-stop)
+  "status" (cmd-status)
+  (do (binding [*out* *err*]
+        (println "Usage: babqua-lifecycle.bb {start|stop|status}"))
+      (System/exit 2)))

site/_extensions/scicloj/bb/babqua-nrepl-client.bb

@@ -0,0 +1,79 @@
+#!/usr/bin/env bb
+;; babqua-nrepl-client.bb — bencode client used by the Lua filter when a
+;; persistent bb nREPL is running. Connects to the port given on argv,
+;; forwards the Clojure code on stdin as a single eval message, and
+;; relays the resulting :out chunks to its own stdout (where the filter
+;; reads them with the same JSON-extraction logic as one-shot mode).
+;;
+;; Why a separate script rather than nREPL talk in Lua: pandoc's Lua
+;; doesn't ship luasocket, so direct TCP from the filter isn't portable.
+;; Babqua already needs bb anyway, and bb has bencode.core built in, so
+;; one bb spawn per render delegates the protocol work to a context
+;; that has the libraries.
+;;
+;; Usage:
+;;   echo "(println :hi)" | bb babqua-nrepl-client.bb 12345
+
+(ns babqua.nrepl-client
+  (:require [bencode.core :as b])
+  (:import [java.io PushbackInputStream]
+           [java.net Socket SocketException]))
+
+(defn- coerce
+  "bencode.core hands back byte[] for strings and recursively-nested maps
+  / vectors. Convert to plain strings/maps so equality and lookup work."
+  [v]
+  (cond
+    (bytes? v)      (String. ^bytes v "UTF-8")
+    (map? v)        (into {} (map (fn [[k v]] [(coerce k) (coerce v)])) v)
+    (sequential? v) (mapv coerce v)
+    :else           v))
+
+(defn- exit-fatal! [msg]
+  (binding [*out* *err*] (println (str "[babqua-nrepl-client] " msg)))
+  (System/exit 1))
+
+(defn -main [& args]
+  (let [port (try (Integer/parseInt (first args))
+                  (catch Exception _ nil))
+        _    (when-not port
+               (exit-fatal! "Usage: babqua-nrepl-client.bb <port>"))
+        code (slurp *in*)
+        sock (try (Socket. "127.0.0.1" ^int port)
+                  (catch Exception e
+                    (exit-fatal! (str "Could not connect to nREPL on "
+                                      port ": " (.getMessage e)))))
+        out  (.getOutputStream sock)
+        in   (PushbackInputStream. (.getInputStream sock))]
+    (try
+      (b/write-bencode out {"op" "eval" "code" code "id" "1"})
+      (loop [chunks []]
+        (let [resp   (try (coerce (b/read-bencode in))
+                          (catch SocketException _ nil)
+                          (catch java.io.EOFException _ nil))
+              status (set (or (get resp "status") []))]
+          (cond
+            (nil? resp)
+            (exit-fatal! "nREPL connection closed unexpectedly")
+
+            (get resp "out")
+            (recur (conj chunks (get resp "out")))
+
+            (get resp "err")
+            (do (binding [*out* *err*] (print (get resp "err")) (flush))
+                (recur chunks))
+
+            ;; "ex" is set when eval threw at the top level; surface and
+            ;; let the filter's outer try/catch JSON path produce the
+            ;; babqua/fatal envelope from any captured :out.
+            (or (contains? status "done")
+                (contains? status "error"))
+            (do (doseq [s chunks] (print s))
+                (flush))
+
+            :else
+            (recur chunks))))
+      (finally
+        (try (.close sock) (catch Exception _ nil))))))
+
+(apply -main *command-line-args*)

site/_extensions/scicloj/bb/babqua.css

@@ -0,0 +1,15 @@
+/* Distinguish Babqua output blocks from input code */
+.cell-output pre code.sourceCode {
+  background-color: transparent;
+  border-left: 3px solid #e0e0e0;
+  padding-left: 0.8em;
+}
+
+/* Cap stdout-block height so a noisy `(println …)` (e.g. a debug
+   `dotimes 1000`) doesn't push everything below it off the page.
+   Display blocks (charts, return values) and error blocks stay
+   uncapped — those need to remain fully visible. */
+.cell-output-stdout pre {
+  max-height: 30em;
+  overflow-y: auto;
+}