refactor: doerg는 publisher와 결합

src/net/deertopia/doerg/cached_file.clj

@@ -0,0 +1,25 @@
+(ns net.deertopia.doerg.cached-file
+  (:require [babashka.fs :as fs]))
+
+(defn newer-than?
+  "Return `true` if fs `file₁` was last modified sooner or at the same
+  time as `file₂`, or if `file₂` does not exist."
+  [file₁ file₂]
+  (or (not (fs/exists? file₂))
+      (<= 0 (compare (fs/last-modified-time file₁)
+                     (fs/last-modified-time file₂)))))
+
+(def ^:dynamic *use-cache?*
+  "Bind to `false` to disable caching for debugging purposes."
+  true)
+
+(defn cached-file
+  "Return a file path after potentially regenerating the file by
+  calling `compute` with no arguments only if stale? is logical true."
+  [& {:keys [file stale? compute]}]
+  (when (or (not *use-cache?*) stale?)
+    (let [r (compute)]
+      (assert (string? r))
+      (fs/create-dirs (fs/parent file))
+      (spit file r)))
+  file)

src/net/deertopia/doerg/common.clj

@@ -0,0 +1,125 @@
+(ns net.deertopia.doerg.common
+  (:require [babashka.process :as p]
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [clojure.java.io :as io])
+  (:import (java.io FilterInputStream StringWriter InputStream
+                    OutputStream PrintStream ByteArrayOutputStream
+                    ByteArrayInputStream FilterOutputStream)
+           (java.nio.charset StandardCharsets)))
+
+(defn deref-with-timeout [process ms]
+  (let [p (promise)
+        process-future (future (deliver p @process))
+        timeout-future (future (Thread/sleep ms)
+                               (future-cancel process-future)
+                               (p/destroy-tree process)
+                               (deliver p ::timed-out))]
+    (if (= @p ::timed-out)
+      (throw (ex-info (format "external command `%s' timed out after %.2fs."
+                              (str/join " " (:cmd process))
+                              (/ (double ms) 1000))
+                      {:process process
+                       :timed-out-after-milliseconds ms}))
+      @p)))
+
+(defn tee-input-stream
+  "Return a wrapped `InputStream` that writes all bytes read from
+  input-stream to sink, à la the UNIX command tee(1)."
+  [input-stream sink]
+  (proxy [FilterInputStream] [input-stream]
+    (read
+      ([]
+       (let [c (proxy-super read)]
+         (when (not= c -1)
+           (.write sink c))
+         c))
+      ([^bytes bs]
+       (let [n (proxy-super read bs)]
+         (when (not= n -1)
+           (.write sink bs 0 n))
+         n))
+      ([^bytes bs off len]
+       (let [n (proxy-super read bs off len)]
+         (when (not= n -1)
+           (.write sink bs off n))
+         n)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+(defn tee-output-stream
+  "Return a wrapped `OutputStream` that writes all bytes written to
+  output-stream to sink, à la the UNIX command tee(1)."
+  [output-stream sink]
+  (proxy [FilterOutputStream] [output-stream]
+    (write
+      ([bs-or-b]
+       (proxy-super write bs-or-b)
+       (.write sink bs-or-b))
+      ([^bytes bs off len]
+       (proxy-super write bs off len)
+       (.write sink bs off len)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+#_
+(defn hook-input-stream [input-stream hook]
+  (proxy [FilterInputStream] [input-stream]
+    (read
+      ([]
+       (let [c (proxy-super read)]
+         (when (not= c -1)
+           (hook (byte-array [c])))
+         c))
+      ([^bytes bs]
+       (let [n (proxy-super read bs)]
+         (when (not= n -1)
+           (let [bs* (byte-array n 0)]
+             (System/arraycopy bs 0 bs* 0 n)
+             (hook bs*)))
+         n))
+      ([^bytes bs off len]
+       (let [n (proxy-super read bs off len)]
+         (when (not= n -1)
+           (.write sink bs off n))
+         n)))
+    (close []
+      (try (proxy-super close)
+           (finally (.close sink))))))
+
+(comment
+  (with-open [sink (ByteArrayOutputStream.)
+              out (ByteArrayOutputStream.)
+              in (ByteArrayInputStream. (.getBytes "hello worms"))]
+    (io/copy (tee-input-stream in sink) out)
+    (def the-out out)
+    (def the-sink sink)
+    {:out out
+     :sink sink})
+  (with-open [sink (l/log-stream :info "blah")
+              out (ByteArrayOutputStream.)
+              in (ByteArrayInputStream. (.getBytes "hello worms"))]
+    (io/copy (tee-input-stream in sink) out)
+    (def the-out out)
+    (def the-sink sink)
+    {:out out
+     :sink sink}))
+
+(comment
+  (let [out (ByteArrayOutputStream.)]
+    (p/shell {:out (tee-output-stream
+                    out (l/log-stream :info "blah"))}
+             "echo" "hello\n" "worms")
+    (.toString out)))
+
+(defn invoke [opts & cmd]
+  (l/info (str/join " " (cons "$" cmd)))
+  (let [r (apply p/shell
+                 (merge {:continue true
+                         :in nil :out :string :err :string}
+                        opts)
+                 cmd)
+        bin (first cmd)]
+    r))

src/net/deertopia/doerg/config.clj

@@ -0,0 +1,82 @@
+(ns net.deertopia.doerg.config
+  (:require [clojure.spec.alpha :as s]
+            [babashka.fs :as fs]
+            [aero.core :as aero]
+            [clojure.java.io :as io]))
+
+(s/def ::config
+  (s/keys :req [::ibm-plex-web
+                ::latex
+                ::dvisvgm
+                ::doerg-temml-worker
+                ::doerg-parser
+                ::state-directory
+                ::org-roam-db-path]))
+
+(s/def ::directory
+  (s/conformer #(fs/file %)))
+
+(s/def ::file
+  (s/conformer #(-> % fs/expand-home fs/file)))
+
+(s/def ::executable
+  (s/conformer
+   ;; I'd love to use `fs/which` here, but it's fairly problematic to
+   ;; check `fs/executable?` at… build time (which `fs/which` does)?
+   ;; Wait… what?  Do I know how Clojure compilation works?
+   #(or #_(some-> % fs/expand-home fs/which fs/file)
+        (some-> % fs/expand-home fs/file)
+        ::s/invalid)))
+
+(s/def ::ibm-plex-web ::directory)
+
+(s/def ::latex ::executable)
+
+(s/def ::dvisvgm ::executable)
+
+(s/def ::doerg-temml-worker ::executable)
+
+(s/def ::doerg-parser ::executable)
+
+(s/def ::state-directory ::file)
+(s/def ::org-roam-db-path ::file)
+
+(defmethod aero/reader 'xdg-data-dir
+  [_opts tag value]
+  "Aero tag to search for a directory on $XDG_DATA_DIRS."
+  (some #(let [x (fs/path % value)]
+           (and (fs/exists? x) x))
+        (fs/split-paths (System/getenv "XDG_DATA_DIRS"))))
+
+(defmethod aero/reader 'file
+  [{:keys [source]} tag value]
+  "Aero tag to reference a `java.io.File` relative to the config
+  file."
+  (-> (aero/relative-resolver source value)
+      fs/file))
+
+(defn read-config [files & {:as opts}]
+  (let [r (->> files
+               (filter identity)
+               (map #(aero/read-config % opts))
+               (apply merge))
+        conformed (s/conform ::config r)]
+    (if-not (s/invalid? conformed)
+      conformed
+      (throw (ex-info "Failed to conform config"
+                      (s/explain-data ::config r))))))
+
+(defn load-config! [var spec files & {:as opts}]
+  (alter-var-root var (constantly (read-config files opts))))
+
+(def sources
+  [;; Default config.
+   (io/resource "net/deertopia/doerg/default-config.edn")
+   ;; Defaults set at build time, if any.
+   (io/resource "net/deertopia/doerg/extra-config.edn")
+   ;; Config set at runtime.
+   (System/getenv "DOERG_CONFIG")])
+
+(def default (read-config sources))
+
+(def ^:dynamic *cfg* default)

src/net/deertopia/doerg/element.clj

@@ -0,0 +1,303 @@
+(ns net.deertopia.doerg.element
+  (:refer-clojure :exclude [read-string type])
+  (:require [babashka.fs :as fs]
+            [babashka.process :as p]
+            [cheshire.core :as json]
+            [clojure.core.match :refer [match]]
+            [net.deertopia.doerg :as-alias doerg]
+            [clojure.java.io :as io]
+            [clojure.set :as set]
+            [clojure.string :as str]
+            [clojure.test.check.generators :as gen]
+            [clojure.tools.logging.readable :as lr]
+            [clojure.zip :as z]
+            [com.rpl.specter :as sp]
+            [com.rpl.specter.zipper :as sz]
+            [net.deertopia.doerg.common :as common]
+            [net.deertopia.doerg.config :as cfg]
+            [clojure.tools.logging :as l])
+  (:import
+   (java.util UUID)))
+
+
+
+(def ^:dynamic *uniorg-timeout-duration*
+  "Number of milliseconds to wait before killing the external Uniorg
+  process."
+  (* 10 1000))
+
+(defn- camel->kebab [s]
+  (->> (str/split s #"(?<=[a-z])(?=[A-Z])")
+       (map str/lower-case)
+       (str/join "-")))
+
+(defn uniorg [& {:keys [in]
+                 :or {in *in*}}]
+  (let [r (-> (p/process
+               {:in in :out :string}
+               (-> cfg/*cfg* ::doerg/doerg-parser str))
+              (common/deref-with-timeout *uniorg-timeout-duration*))]
+    (when (zero? (:exit r))
+      (-> r :out (json/parse-string (comp keyword camel->kebab))))))
+
+(declare gather-first-section gather-latex-paragraphs element-types)
+
+(defn read-string
+  [s & {:keys [post-processors]
+        :or {post-processors [gather-first-section
+                              gather-latex-paragraphs]}}]
+  (let [apply-post-processors (apply comp (reverse post-processors))]
+    (with-in-str s
+      (-> (uniorg :in *in*)
+          apply-post-processors))))
+
+
+
+(defn greater-element?
+  "Return truthy if `e` is a greater org-element; i.e. one that can
+  have children."
+  [e]
+  ;; Not 100% sure if this is a valid definition.  It seems that
+  ;; Uniorg sets `:children` to an empty vector when a great element
+  ;; lacks children.
+  (and (map? e) (contains? e :children)))
+
+(defn org-element? [element]
+  (and (map? element)
+       (contains? element :type)))
+
+(defn type [element]
+  (:type element))
+
+(defn of-type?
+  "Return truthy if the Org node `element` is of type `type`. In the
+  vararg case, return truthy if `element` is of any of the types
+  listed."
+  ([element type]
+   (= (:type element) type))
+  ([element type & types]
+   (contains? (into #{} (cons type types))
+              (:type element))))
+
+(defn of-keyword-type? [element key]
+  (and (of-type? element "keyword")
+       (= (:key element) key)))
+
+(defn footnotes-section? [element]
+  (and (of-type? element "section")
+       (when-some [footnotes-headline (first (:children element))]
+         (= "Footnotes" (:raw-value footnotes-headline)))))
+
+(defn display-math?
+  "Return truthy if `element` should be considered display math."
+  [element]
+  (or (of-type? element "latex-environment")
+      (and (of-type? element "latex-fragment")
+           (-> element :contents (str/starts-with? "\\[")))))
+
+
+;;; Zipper
+
+(defn doerg-zip [document]
+  (clojure.zip/zipper greater-element?
+                      :children
+                      #(assoc %1 :children %2)
+                      document))
+
+(def children-walker
+  "Walk each child of an Org element."
+  [:children sp/ALL])
+
+(def postorder-walker
+  "Recursively walk each node of an Org element in post-order."
+  (sp/recursive-path
+   [] p
+   (sp/if-path greater-element?
+               (sp/continue-then-stay children-walker p)
+               sp/STAY)))
+
+(def postorder-walker*
+  (sp/recursive-path
+   [] p
+   (sp/if-path greater-element?
+               (sp/continue-then-stay :children p)
+               sp/STAY)))
+
+
+;;; Post-processing
+
+(def property-handlers
+  "A map of node-property keys to functions. The functions will be
+  called with two arguments: the pre-existing top-level document data
+  (a map), and the node-property value. The function is expected to
+  return the document data map with the new property merged in."
+  {"ID" (fn [data id]
+          (let [new-id (UUID/fromString id)]
+            (when (contains? data :id)
+              (lr/warnf (str "Found multiple :ID: definitions."
+                             " Replacing %s with %s.")
+                        (:id data) new-id))
+            (assoc data :id new-id)))
+   "DeertopiaVisibility"
+   (fn [data visibility]
+     (let [v (case visibility
+               "public" :public
+               "private" :private
+               "graphonly" :graph-only
+               (do (lr/warn "Unknown visibility: %s" visibility)
+                   :private))]
+       (assoc data :net.deertopia/visibility v)))})
+
+(def keyword-handlers
+  "Like `property-handlers`, but for top-level keywords."
+  {"TITLE" #(assoc %1 :title %2)})
+
+(defn- apply-handlers [handlers values]
+  (reduce (fn [data {:keys [key value]}]
+            (let [f (get handlers key)]
+              (f data value)))
+          {}
+          values))
+
+(defn handle-properties [doc]
+  (let [props (some-> doc :children first)]
+    (when (of-type? props "property-drawer")
+      (->> props
+           (sp/select [children-walker
+                       #(contains? property-handlers (:key %))])
+           (apply-handlers property-handlers)))))
+
+(defn handle-keywords [doc]
+  (->> doc
+       (sp/select [children-walker
+                   #(and (of-type? % "keyword")
+                         (contains? keyword-handlers (:key %)))])
+       (apply-handlers keyword-handlers)))
+
+(defn gather-doerg-data [doc]
+  (assoc doc :net.deertopia.doerg/data
+         (merge (handle-properties doc)
+                (handle-keywords doc))))
+
+(defn- split-sections
+  "Given a list of top-level nodes as spat out by the `uniorg`
+  parser, return a map with the following keys
+  • :top-level-nodes      The nodes that /should/ be at the top-level.
+  • :first-section-nodes  The nodes that should be wrapped in a new
+                          section node.
+  • :rest                 Everything else."
+  [nodes]
+  (let [[of-top-level remaining-nodes]
+        (->> nodes (split-with #(of-type? % "property-drawer" "keyword")))
+        [of-first-section remaining-nodes*]
+        (->> remaining-nodes (split-with #(not (of-type? % "section"))))]
+    {:top-level-nodes of-top-level
+     :first-section-nodes of-first-section
+     :rest remaining-nodes*}))
+
+(defn- element-bounds [& nodes]
+  (reduce (fn [acc {:keys [contents-begin contents-end]}]
+            (if (and (nat-int? contents-begin)
+                     (nat-int? contents-end))
+              (-> acc
+                  (update
+                   :contents-begin
+                   #(min (or % Integer/MAX_VALUE) contents-begin))
+                  (update
+                   :contents-end
+                   #(max (or % Integer/MIN_VALUE) contents-end)))
+              acc))
+          {:contents-begin nil
+           :contents-end nil}
+          nodes))
+
+(defn gather-first-section [node]
+  (assert (of-type? node "org-data")
+          "`gather-doerg-data` should be applied to the document root.")
+  (let [{:keys [top-level-nodes first-section-nodes rest]}
+        (split-sections (:children node))
+        ;; TODO: Construct `:contents-begin` and `:contents-end` data
+        ;; by spanning the children.
+        first-section (merge {:type "section"
+                              :children (vec first-section-nodes)}
+                             (apply element-bounds first-section-nodes))
+        new-children (vec (concat top-level-nodes
+                                  (list first-section)
+                                  rest))]
+    (assoc node :children new-children)))
+
+(defn- newline-final-paragraph?
+  "Is `e` a paragraph, and does it end with a newline?"
+  [e]
+  (and (of-type? e "paragraph")
+       (some-> (-> e :position :end :column)
+               (= 1))))
+
+(defn consequtive-elements?
+  "Returh truthy if each successive pair of elements is NOT separated
+  by at least one explicit paragraph break; i.e. a blank line."
+  [& elements]
+  (match elements
+    ([(e₁ :guard newline-final-paragraph?) e₂ & es] :seq)
+    (and (= (-> e₁ :position :end :line)
+            (-> e₂ :position :start :line))
+         (recur es))
+    ([e₁ e₂ & es] :seq)
+    (and (= (-> e₁ :position :end :line inc)
+            (-> e₂ :position :start :line))
+         (recur es))
+    ([_] :seq) true
+    ([] :seq) true))
+
+(defn swallow
+  ([predator prey]
+   (assert (greater-element? predator))
+   (-> predator
+       (update :children #(conj % prey))
+       (assoc-in [:position :end] (-> prey :position :end))))
+  ([predator prey & more-prey]
+   (reduce swallow predator (cons prey more-prey))))
+
+(defn- paragraph-followed-by-tex? [children]
+  (match children
+    [(para :guard #(of-type? % "paragraph"))
+     (tex :guard #(of-type? % "latex-environment"))
+     & _]
+    (consequtive-elements? para tex)
+    :else false))
+
+(defn- paragraph-followed-by-paragraph? [children]
+  (match children
+    [(para₁ :guard #(of-type? % "paragraph"))
+     (para₂ :guard #(of-type? % "paragraph"))
+     & _]
+    (consequtive-elements? para₁ para₂)
+    :else false))
+
+(defn gather-latex-paragraphs [node]
+  (->> node
+       (sp/transform
+        [postorder-walker (sp/must :children)]
+        (fn [children]
+          (loop [acc []
+                 cs (vec children)]
+            (match cs
+              ;; CASE: A paragraph followed by a LaTeX environment.
+              ;; If there are no blank lines separating the paragraph
+              ;; from the LaTeX environment, the LaTeX environment
+              ;; shall become a child of the paragraph.
+              ([para tex & rest] :guard paragraph-followed-by-tex?)
+              (recur acc (vec (cons (swallow para tex) rest)))
+              ;; CASE: Similar to the paragraph-followed-by-tex case,
+              ;; but instead of swallowing the entire second element,
+              ;; we swallow the /children/ of the second element,
+              ;; since paragraphs cannot be nested.
+              ([para₁ para₂ & rest]
+               :guard paragraph-followed-by-paragraph?)
+              (recur acc (vec (cons (apply swallow para₁ (:children para₂))
+                                    rest)))
+              ;; CASE: Irrelevant or empty!
+              [c & rest]
+              (recur (conj acc c) rest)
+              [] acc))))))
+

src/net/deertopia/doerg/elisp.clj

@@ -0,0 +1,119 @@
+(ns net.deertopia.doerg.elisp
+  (:require [clojure.core.match :refer [match]]
+            [clojure.java.io :as io]
+            [clojure.spec.alpha :as s]
+            [instaparse.core :as ip])
+  (:refer-clojure :exclude [print read read-string]))
+
+(ip/defparser read*
+  (io/resource "net/deertopia/doerg/elisp/grammar"))
+
+(defn- transform-string [s]
+  (let [s* (loop [s (seq s)
+                  acc ""]
+             (match s
+               ([\\ c & cs] :seq)
+               (recur
+                cs
+                (str acc
+                     (condp = c
+                       \n \newline
+                       \f \formfeed
+                       \\ \\
+                       \" \"
+                       \newline nil
+                       (throw (ex-info "IDK!" {:char c})))))
+               ([c & cs] :seq) (recur cs (str acc c))
+               ([] :seq) acc))]
+    [:string (apply str s*)]))
+
+(defn- transform-integer [s]
+  [:integer (parse-long s)])
+
+(defn- transform-property-string
+  ([[_ text]]
+   [:string text])
+  ([[_ text] & props]
+   [:string text (->> (for [[_ [_ beg] [_ end] prop] props]
+                        {[beg end] prop})
+                      (apply merge))]))
+
+(defn- transform-list [& xs]
+  (match (last xs)
+    [:dot-cdr x] [:cons* (butlast xs) x]
+    _ [:cons* xs]))
+
+(def transforms {:string transform-string
+                 :list transform-list
+                 :integer transform-integer
+                 :property-string transform-property-string})
+
+(defn read [s & args]
+  (->> (apply read* s args)
+       (ip/transform transforms)))
+
+(defn read-string [s]
+  (read s :start :text))
+
+(defn cons? [x]
+  (= (first x) :cons*))
+
+(s/def ::alist
+  (s/tuple #{:list}
+           (s/and ::list
+                  cons?)))
+
+(defn car [x]
+  (match x
+    [:cons* xs y] (first xs)
+    [:cons* xs] (first xs)
+    [:symbol "nil"] nil
+    _ nil))
+
+(defn cdr [x]
+  (match x
+    [:cons* xs y] (if (<= (count xs) 1)
+                    y
+                    [:cons* (rest xs) y])
+    [:cons* xs] [:cons* (rest xs)]
+    [:symbol "nil"] nil
+    _ nil))
+
+(defn emacs-list? [x]
+  (match x
+    [:cons* xs] true
+    _ false))
+
+(defn read-alist [s]
+  (let [r (->> s read*
+               (ip/transform
+                (merge transforms
+                       {:symbol (fn [s] (symbol s))
+                        :string (fn [s] s)}))
+               first)]
+    (match r
+      [:cons* pairs] (->> (for [pair pairs]
+                            (let [x (car pair)
+                                  y (cdr pair)]
+                              {x y}))
+                          (apply merge))
+      _ nil)))
+
+(defn read-string [s]
+  (match (-> s read first)
+    [:string x & props] x
+    :else nil))
+
+(defn print [x]
+  ;; TODO: this is really not how it should be done lol. at the
+  ;; moment, `print` is only used in `net.deertopia.doerg.roam`
+  ;; and only to serialise uuids, so it's not a /massive/ priority.
+  (cond (or (string? x) (uuid? x)) (str \" x \")
+        :else (throw (ex-info "`print` is unimplemented lol"
+                              {:x x}))))
+
+(comment
+  (do (ip/defparser parse* (io/resource "elisp-grammar"))
+      (read "#(\"blah\" 0 1 (doge))")
+      (read "\"bla\\nh\"")
+      (read-alist "((x . y))")))

src/net/deertopia/doerg/html.clj

@@ -0,0 +1,46 @@
+(ns net.deertopia.doerg.html
+  "Common HTML elements and utilities"
+  (:require [clojure.java.io :as io]
+            [babashka.fs :as fs]))
+
+#_
+(def navbar
+  "Hiccup element for Deertopia.net's navbar."
+  [:nav.navbar
+   [:ol.navbar-list
+    [:li
+     [:a.home-link {:href "/"}
+      "🦌 deertopia.net"]]
+    [:li
+     [:a.home-link {:href "/graph"}
+      "graph"]]
+    #_
+    [:li
+     [:a.home-link {:onclick "alert('unimplemented }:(')"}
+      "search"]]]])
+
+(def viewport
+  [:meta {:name "viewport"
+          :content "width=device-width, initial-scale=1.0"}])
+
+(def charset
+  [:meta {:charset "utf-8"}])
+
+(defn external-stylesheet [href]
+  [:link {:rel "stylesheet" :type "text/css" :href (str "/resource/" href)}])
+
+(def ibm-plex
+  (concat
+   (for [family ["serif" "sans-kr" "math"]]
+     (external-stylesheet
+      (format "ibm-plex-web/css/ibm-plex-%s-all.min.css" family)))
+   [(external-stylesheet "Temml-Plex.css")]))
+
+(def deerstar
+  (external-stylesheet "deerstar.css"))
+
+(def tuftesque
+  (external-stylesheet "tuftesque.css"))
+
+(def head
+  (list viewport charset ibm-plex deerstar tuftesque))

src/net/deertopia/doerg/main.clj

@@ -0,0 +1,5 @@
+(ns net.deertopia.doerg.main
+  (:gen-class))
+
+(defn -main []
+  (println "hello from doerg"))

src/net/deertopia/doerg/render.clj

@@ -0,0 +1,407 @@
+(ns net.deertopia.doerg.render
+  (:require [net.deertopia.doerg.element :as element]
+            [clojure.stacktrace]
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [clojure.core.match :refer [match]]
+            [clojure.tools.logging.readable :as lr]
+            [com.rpl.specter :as sp]
+            [net.deertopia.doerg.html :as doerg-html]
+            [hiccup2.core :as hiccup]
+            [clojure.pprint]
+            [net.deertopia.doerg.tex :as tex]
+            [net.deertopia.doerg.tex.temml :as tex-temml]
+            [clojure.zip :as z]
+            [babashka.fs :as fs]
+            [clojure.edn :as edn]))
+
+;;; Top-level API
+
+(defmulti org-element
+  "Render an Org element to Hiccup."
+  #(do (assert (element/org-element? %)
+               "Not an org-node!")
+       (:type %)))
+
+(defmulti org-link
+  "Render an Org-mode link element to Hiccup.  Dispatches on link
+  type/protocol."
+  #(do (assert (element/of-type? % "link"))
+       (:link-type %)))
+
+(defmulti org-special-block
+  "Render an Org-mode special block to Hiccup.  Dispatches on special
+  block type (as in #+begin_«type» … #+end_«type»)."
+  #(do (assert (element/of-type? % "special-block"))
+       (:block-type %)))
+
+(defmulti org-keyword
+  "Render an Org-mode keyword."
+  #(do (assert (element/of-type? % "keyword"))
+       (:key %)))
+
+(def ^:dynamic ^:private *opts*)
+
+(declare ^:private gather-footnotes render-renderer-error
+         view-children-as-seq render-tex-snippets)
+
+(defn org-element-recursive
+  "Recursively render an Org-mode element to Hiccup."
+  [e]
+  (->> e
+       (sp/transform
+        [element/postorder-walker view-children-as-seq]
+        (fn [node]
+          (try (org-element node)
+               (catch Throwable e
+                 (lr/error e "Error in renderer" {:node node})
+                 (render-renderer-error e)))))))
+
+(def default-language
+  "Default language, used in the lang attribute of the body tag."
+  "en")
+
+(defn org-document
+  "Recursively render an Org-mode document to Hiccup."
+  [doc & {:as opts :keys [postamble]}]
+  (binding [*opts* opts]
+    (tex-temml/binding-worker
+      (let [rendered (-> doc gather-footnotes render-tex-snippets
+                         org-element-recursive)]
+        [:html
+         [:head
+          [:title "org document"]
+          doerg-html/head]
+         [:body {:lang default-language}
+          [:article
+           rendered
+           (when postamble
+             [:footer
+              [:hr]
+              postamble])]]]))))
+
+(defn to-html
+  "Read `f` with `slurp` as an Org document and return a string of
+  rendered HTML.  See `org-document` for opts."
+  [f & {:as opts}]
+  (str (hiccup/html {} (-> f slurp element/read-string (org-document opts)))))
+
+
+;;; Further dispatching on `org-element`
+
+(defmethod org-element "keyword" [e]
+  (org-keyword e))
+
+(defmethod org-element "link" [e]
+  (org-link e))
+
+(defmethod org-element "special-block" [e]
+  (org-special-block e))
+
+
+
+(def view-children-as-seq
+  "Specter path that converts any vectors of :children to lists so
+  Hiccup correctly interprets children as lists of elements rather
+  than a single malformed element."
+  (sp/if-path element/greater-element?
+              (sp/view #(update % :children seq))
+              sp/STAY))
+
+(defn center [& es]
+  [:div.center es])
+
+(defn doerg-attrs [e]
+  (->> e :affiliated :attr_doerg (str/join " ")
+       (format "{%s}") edn/read-string))
+
+(defn em [x]
+  (format "%.4fem" x))
+
+(defn wrap-if [x c f]
+  (if c (f x) x))
+
+(defn- contains-footnote-refs? [node]
+  (some #(element/of-type? % "footnote-reference")
+        (:children node)))
+
+(defn- gather-footnotes
+  "Traverse document and reposition footnote-definitions to
+  immediately follow their first references. Removes the footnotes
+  section from the document."
+  [doc]
+  (let [fn-defs (->> doc
+                     (sp/select
+                      [element/children-walker element/footnotes-section?
+                       element/children-walker
+                       #(element/of-type? % "footnote-definition")
+                       (sp/view (fn [d]
+                                  {(:label d) d}))])
+                     (apply merge))
+        encountered (atom #{})]
+    (->> doc
+         (sp/transform
+          [element/postorder-walker
+           contains-footnote-refs?]
+          (fn [node]
+            (assoc node :children
+                   (->> (for [n (:children node)]
+                          (let [label (:label n)]
+                            (if (and (element/of-type? n "footnote-reference")
+                                     (not (@encountered label)))
+                              (do (swap! encountered #(conj % label))
+                                  (list n (get fn-defs label)))
+                              (list n))))
+                        (apply concat)))))
+         (sp/setval [element/children-walker
+                     element/footnotes-section?]
+                    sp/NONE))))
+
+(defn- collect-latex-headers [doc]
+  (->> doc
+       (sp/select
+        [element/postorder-walker
+         #(element/of-keyword-type? % "LATEX_HEADER")
+         (sp/view :value)])))
+
+(defn- timeout-snippet-promises [snippet-promises fut]
+  ;; Time out after twenty seconds. With all the LaTeX and IPC, there
+  ;; are so many opportunities for things to go wrong </3.
+  (let [ms (* 20 1000)
+        fut-res (deref fut ms ::timed-out)]
+    (if (= fut-res ::timed-out)
+      (do (l/warnf "Giving up on rendering TeX snippets after %.3f seconds."
+                   (/ ms 1000))
+          (future-cancel fut)
+          (doseq [[_snippet p] snippet-promises]
+            (deliver p ::timed-out)))
+      fut-res)))
+
+(defn render-tex-snippets
+  "Traverse doc, adorning each LaTeX node with a promise resolving to,
+  optimistically, Hiccup-rendered SVG or MathML code."
+  [doc]
+  (let [snippet-promises (atom [])
+        r (->> doc (sp/transform
+                    [element/postorder-walker
+                     #(element/of-type?
+                       % "latex-fragment" "latex-environment")]
+                    (fn [node]
+                      (let [p (promise)]
+                        (swap! snippet-promises #(conj % [(:value node) p]))
+                        (assoc node ::rendered p)))))
+        sp @snippet-promises
+        fut (-> #(tex/render-snippets sp)
+                bound-fn* future-call)]
+    (timeout-snippet-promises sp fut)
+    r))
+
+
+
+(defn render-pprint
+  "Render the argument inline as `clojure.pprint/pprint` output."
+  [x & {:keys [text]
+        :or {text "debug!"}}]
+  [:details
+   [:summary {:style {:font-family "IBM Plex Sans"}}
+    (if (:type x)
+      (list text " (" [:code (:type x)] ")")
+      text)]
+   [:samp {:style {:overflow "scroll"
+                   :display "block"
+                   :white-space "pre"}}
+    (with-out-str
+      (clojure.pprint/pprint x))]])
+
+(defn- level->tag
+  "Convert a number 1–5 to a hiccup :h1, :h2, :h3, … tag."
+  [level]
+  (cond (<= 1 level 5) (keyword (str \h (+ level 1)))
+        :else :h5))
+
+(defn- descriptive-list-item-components
+  "If `e` is an Org-mode descriptive list item, return a map {:dt x
+  :dd y} with the corresponding dt and dd tags. Otherwise, return
+  nil."
+  [e]
+  (match (:children e)
+    ([[:dt & dts] & dds] :seq) {:dt (apply vector :dt dts)
+                                :dd (apply vector :dd dds)}
+    _ nil))
+
+(defn- same-tag? [x y]
+  (let [x* (-> x name (str/replace #"^([^\.#]).*" "$1") keyword)]
+    (= x* y)))
+
+;; In HTML5, </p> tags cannot be nested for… reasons.  In fact, no
+;; block-level elements are allowed within paragraphs.  This stupid
+;; hack works around that restriction by stripping </p> tags }:).
+(defn- strip-paragraphs [elements]
+  (apply concat
+         (for [x elements]
+           (match x
+             [(_ :guard #(same-tag? % :p)) (_ :guard map?) & xs]
+             (seq xs)
+             [(_ :guard #(same-tag? % :p)) & xs]
+             (seq xs)
+             _ x))))
+
+
+
+(defn- render-renderer-error
+  "Render a `Throwable` to display within the document."
+  [e]
+  [:details
+   [:summary {:style {:font-family "IBM Plex Sans"}}
+    "Renderer error!"]
+   [:samp {:style {:overflow "scroll"
+                   :display "block"
+                   :white-space "pre"}}
+    (with-out-str
+      (clojure.stacktrace/print-stack-trace e))]])
+
+(defmethod org-element "org-data"
+  [{:keys [children]}]
+  children)
+
+(defmethod org-element "paragraph" [{:keys [children]}]
+  [:p children])
+
+(defmethod org-element "text" [{:keys [value]}]
+  value)
+
+(defmethod org-element "bold" [{:keys [children]}]
+  [:b children])
+
+(defmethod org-element "subscript" [{:keys [children]}]
+  [:sub children])
+
+(defmethod org-element "superscript" [{:keys [children]}]
+  [:super children])
+
+(defmethod org-element "italic" [{:keys [children]}]
+  [:em children])
+
+(defmethod org-element "verbatim" [{:keys [value]}]
+  value)
+
+(defmethod org-element "code" [{:keys [value]}]
+  [:code value])
+
+(defmethod org-element "section" [{:keys [children]
+                                   :as section}]
+  (when-not (element/footnotes-section? section)
+    [:section
+     (or (seq children)
+         [:div.empty-section-message "This section is empty…"])]))
+
+(defmethod org-element "headline" [{:keys [children level]}]
+  [(level->tag level) children])
+
+(defmethod org-element "footnote-reference"
+  [{:keys [label]}]
+  ;; FIXME: This will break if there are multiple references to a
+  ;; single footnote, since `label` is assumed to be unique.
+  (list [:label.margin-toggle.sidenote-number {:for label}]
+        [:input.margin-toggle {:type "checkbox"
+                               :id label}]))
+
+(defmethod org-element "footnote-definition" [{:keys [children]}]
+  [:span.sidenote (strip-paragraphs children)])
+
+(defmethod org-element "plain-list" [{:keys [list-type children]}]
+  (let [tag (case list-type
+              "descriptive" :dl
+              "unordered" :ul
+              "ordered" :ol)]
+    [tag children]))
+
+(defmethod org-element "list-item" [{:keys [children] :as e}]
+  (if-some [{:keys [dt dd]} (descriptive-list-item-components e)]
+    (list dt dd)
+    [:li children]))
+
+(defmethod org-element "list-item-tag" [{:keys [children]}]
+  [:dt children])
+
+(defmethod org-element "property-drawer" [{:keys [children]}]
+  [:table.property-drawer {:hidden true}
+   [:tbody children]])
+
+(defmethod org-element "node-property" [{:keys [key value]}]
+  [:tr [:th key] [:td value]])
+
+(defmethod org-element "citation" [{:keys [prefix suffix children] :as e}]
+  ;; TODO: Real citations.
+  [:span "[cite:" prefix children suffix "]"])
+
+(defmethod org-element "citation-reference" [{:keys [key]}]
+  (str "@" key))
+
+(defmethod org-element "latex-fragment" [{:keys [contents value] :as e}]
+  [:span {:class (if (element/display-math? e)
+                   "latex-fragment display-math"
+                   "latex-fragment")}
+   (-> e ::rendered deref)])
+
+(defmethod org-element "latex-environment" [{:keys [value] :as e}]
+  [:span.latex-fragment.display-math
+   (-> e ::rendered deref)])
+
+(defmethod org-element "example-block" [{:keys [value] :as e}]
+  (let [{:keys [center? alt scale img?]} (doerg-attrs e)]
+    (-> [:pre (merge (and img? {:role "img"
+                                :aria-label alt
+                                :title alt})
+                     (and scale {:style {:font-size (em scale)}}))
+         value]
+        (wrap-if center? center))))
+
+(defmethod org-element "src-block" [{:keys [value]}]
+  [:pre [:code value]])
+
+(defn- split-quote-block-children [children]
+  (match (split-with #(not= % [:hr]) children)
+    [x ([[:hr] & ys] :seq)] [x (strip-paragraphs ys)]
+    x x))
+
+(defmethod org-element "quote-block" [{:keys [children] :as e}]
+  (let [{:keys [epigraph?]} (doerg-attrs e)
+        [content footer] (split-quote-block-children children)]
+    (-> [:blockquote
+         content
+         (when footer
+           [:footer footer])]
+        (wrap-if epigraph? (fn [c] [:div.epigraph c])))))
+
+(defmethod org-element "horizontal-rule" [_]
+  [:hr])
+
+(defmethod org-element "comment" [_] nil)
+
+(defmethod org-keyword "TITLE" [{:keys [value]}]
+  [:h1 value])
+
+(defmethod org-keyword "LATEX_COMPILER" [_] nil)
+(defmethod org-keyword "LATEX_HEADER" [_] nil)
+
+;; Not sure how to deal with this one yet.
+(defmethod org-keyword "AUTHOR" [_] nil)
+
+(defmethod org-element :default [x]
+  (render-pprint x :text "unimplemented!"))
+
+(defmethod org-keyword :default [x]
+  (render-pprint x :text "unimplemented!"))
+
+(defmethod org-special-block "margin-note" [{:keys [children]}]
+  [:p [:span.marginnote (strip-paragraphs children)]])
+
+#_
+(defmethod org-special-block :default [x]
+  (render-pprint x :text "unimplemented!"))
+
+(defmethod org-link :default [{:keys [raw-link children]}]
+  [:span.org-link.external
+   [:a {:href raw-link}
+    (or (seq children) raw-link)]])

src/net/deertopia/doerg/repl.clj

@@ -0,0 +1,52 @@
+(ns net.deertopia.doerg.repl
+  (:require [net.deertopia.doerg.element :as element]
+            [net.deertopia.doerg.render :as render]
+            [net.deertopia.doerg.config :as cfg]
+            [clojure.java.io :as io]
+            [hiccup2.core :as h]
+            [clojure.pprint]
+            [babashka.fs :as fs]
+            [net.deertopia.doerg :as-alias doerg]))
+
+(def some-org-file
+  #_
+  "/home/msyds/org/20251228003307-prerequisite_context_in_korean.org"
+  #_
+  "/home/msyds/org/20250919114912-homepage.org"
+  #_
+  "/home/msyds/org/20251111182118-path_induction.org"
+  ;; #_
+  "/home/msyds/org/20250512144715-natural_transformation_category_theory.org"
+  #_
+  "/home/msyds/org/20251021155921-path_action.org"
+  #_
+  "test/net/deertopia/doerg/render_test/fallbacks.org"
+  #_
+  "/home/msyds/org/20250910115311-men_who_would_make_stunning_dykes.org")
+
+(defn- force-create-sym-link [path target]
+  (fs/delete-if-exists path)
+  (fs/create-sym-link path target))
+
+(defn render-html [& {:keys [src dest]
+                      :or {src some-org-file
+                           dest "/tmp/doerg-test"}}]
+  (let [resource-dir (fs/file dest "resource")]
+    (fs/create-dirs dest)
+    (fs/create-dirs resource-dir)
+    (force-create-sym-link (fs/file resource-dir "ibm-plex-web")
+                           (-> cfg/*cfg* ::doerg/ibm-plex-web))
+    (doseq [x #{"Temml-Plex.css" "tuftesque.css" "deerstar.css"}]
+      (force-create-sym-link
+       (fs/file resource-dir x)
+       (io/resource (str "net/deertopia/doerg/" x))))
+    (fs/delete-if-exists (fs/file dest "index.html"))
+    (->> src render/to-html str (spit (fs/file dest "index.html")))))
+
+(defn render-edn [& {:keys [src dest]
+                     :or {src some-org-file
+                          dest "/tmp/doerg-test/index.edn"}}]
+  (fs/create-dirs (fs/parent dest))
+  (with-open [f (io/writer dest)]
+    (binding [*out* f]
+      (-> src slurp element/read-string clojure.pprint/pprint))))

src/net/deertopia/doerg/roam.clj

@@ -0,0 +1,183 @@
+(ns net.deertopia.doerg.roam
+  (:require [babashka.fs :as fs]
+            [net.deertopia.doerg.config :as cfg]
+            [net.deertopia.doerg.elisp :as elisp]
+            [net.deertopia.doerg.slug :as slug]
+            [next.jdbc :as sql])
+  (:import (java.util UUID)))
+
+
+;;; Global database
+
+(defonce ^:dynamic *use-db-cache?* true)
+
+(defn ds []
+  (sql/get-datasource
+   {:dbtype "sqlite"
+    :dbname (-> cfg/*cfg* ::cfg/org-roam-db-path str)}))
+
+
+;;; Elisp sexp (de)serialisation
+
+(defn id [node]
+  (-> node :id))
+
+(defn slug [node]
+  (-> node :id slug/from-uuid))
+
+(defn- print-id [node]
+  (-> node id elisp/print))
+
+
+;;; Node
+
+(defrecord Node [id cache])
+
+(defn uuid-exists? [uuid]
+  (sql/execute-one! (ds)
+                    ["select 1 from nodes where id = ? limit 1"
+                     (-> uuid str elisp/print)]))
+
+(defn make-node
+  ([uuid] (make-node uuid {}))
+  ([uuid props]
+   (and (uuid-exists? uuid)
+        (->Node uuid (atom props)))))
+
+(defn- fetch-with-cache [node field fetch]
+  (if *use-db-cache?*
+    (-> (:cache node)
+        (swap! (fn [cache]
+                 (update cache field #(or % (fetch node)))))
+        (get field))
+    (fetch node)))
+
+(defn org-file [node]
+  (fetch-with-cache
+   node :org-file
+   (fn [node]
+     (when-some [r (sql/execute-one!
+                    (ds)
+                    ["select file from nodes where id = ?"
+                     (-> node :id str elisp/print)])]
+       (-> r :nodes/file elisp/read-string)))))
+
+(defn title [node]
+  (fetch-with-cache
+   node :title
+   #(when-some [r (sql/execute-one!
+                   (ds)
+                   ["select title from nodes where id = ?"
+                    (print-id %)])]
+      (-> r :nodes/title elisp/read-string))))
+
+(defprotocol GetNode
+  (get-node [this]
+    "Return the node associated with `this` or nil."))
+
+(extend-protocol GetNode
+  String
+  (get-node [this]
+    (or (some-> this slug/from-string get-node)
+        (some-> this parse-uuid get-node)
+        (throw (IllegalArgumentException.
+                "Give `get-node` a UUID or slug string plz. }:)"))))
+  java.util.UUID
+  (get-node [this]
+    (make-node this))
+  net.deertopia.doerg.slug.Slug
+  (get-node [this]
+    (-> this slug/to-uuid make-node))
+  Node
+  (get-node [this]
+    this))
+
+(comment
+  (def node (get-node "68XqhHerTWCbE--RYLEdHw"))
+  (fetch-with-cache
+   node :title
+   #(do (println "fetch")
+        (sql/execute-one! (ds) ["select title from nodes where id = ?"
+                              (elisp/print (:id %))]))))
+
+
+;;; Node operations
+
+(defn level [node]
+  (fetch-with-cache
+   node :level
+   #(-> (sql/execute-one!
+         (ds) ["select level from nodes where id = ?"
+             (print-id %)])
+        :nodes/level)))
+
+(defn top-level? [node]
+  (zero? (level node)))
+
+(defn file [node]
+  (fetch-with-cache
+   node :file
+   #(-> (sql/execute-one!
+         (ds) ["select file from nodes where id = ?"
+             (print-id %)])
+        :nodes/file
+        elisp/read-string)))
+
+(defn properties [node]
+  (fetch-with-cache
+   node :properties
+   #(-> (sql/execute-one!
+         (ds) ["select properties from nodes where id = ?"
+             (print-id %)])
+        :nodes/properties
+        elisp/read-alist)))
+
+(defn public? [node]
+  (-> node properties (get "DEERTOPIAVISIBILITY") (= "public")))
+
+(defn graph-visible? [node]
+  (#{"public" "graphonly"}
+   (-> node properties (get "DEERTOPIAVISIBILITY"))))
+
+(defn backlinks
+  "Returns a collection of nodes linking to `node`."
+  [node]
+  (for [{id :nodes/id title :nodes/title}
+        (sql/execute! (ds) ["select distinct nodes.id, nodes.title from links
+                             inner join nodes
+                             on nodes.id = links.source
+                             where links.dest = ?"
+                            (elisp/print (str (:id node)))])
+        :let [id' (elisp/read-string id)]
+        :when (-> id' parse-uuid get-node public?)]
+    (make-node id' {:title (elisp/read-string title)})))
+
+
+;;; Graph support
+
+(defn- read-string-field [n field]
+  (-> n (get field) elisp/read-string))
+
+(defn- uuid-graph-visible? [uuid]
+  (-> uuid parse-uuid get-node graph-visible?))
+
+(defn get-graph []
+  (let [nodes (sql/execute! (ds) ["select id, title from nodes"])
+        links (sql/execute!
+               (ds)
+               ["select n1.id as source, nodes.id as target from
+                   ((nodes as n1) join links on n1.id = links.source)
+                 join (nodes as n2) on links.dest = nodes.id
+                 where links.type = '\"id\"'"])]
+    {:nodes (for [n nodes
+                  :let [id (read-string-field n :nodes/id)]
+                  :when (uuid-graph-visible? id)]
+              {:id id
+               :title (read-string-field n :nodes/title)})
+     :links (for [l links
+                  :let [source (read-string-field l :nodes/source)
+                        target (read-string-field l :nodes/target)]
+                  :when (and (uuid-graph-visible? source)
+                             (uuid-graph-visible? target))]
+              {:source source
+               :target target})}))

src/net/deertopia/doerg/server.clj

@@ -0,0 +1,188 @@
+(ns net.deertopia.doerg.server
+  (:require [clojure.pprint :refer [pprint]]
+            [clojure.tools.logging :as l]
+            [hiccup2.core :as hiccup]
+            [net.deertopia.doerg.html :as doerg-html]
+            [net.deertopia.doerg.config :as-alias cfg]
+            [net.deertopia.doerg.slug :as slug]
+            [net.deertopia.doerg.config :as cfg]
+            [net.deertopia.doerg.roam :as roam]
+            [org.httpkit.server :as http]
+            [reitit.coercion]
+            [reitit.coercion.spec]
+            [reitit.ring.coercion]
+            [reitit.core :as r]
+            [reitit.ring]
+            [reitit.ring.middleware.exception :as reitit-exception]
+            [ring.util.response :as response]
+            [spec-tools.spell]
+            [reitit.spec]
+            [reitit.dev.pretty]
+            [clojure.spec.alpha :as s]
+            [net.deertopia.doerg.render :as doerg-render]
+            [net.deertopia.doerg.cached-file :as cached-file]
+            [babashka.fs :as fs]
+            [aero.core :as aero]
+            [clojure.string :as str]
+            [net.deertopia.doerg :as-alias doerg]
+            [net.deertopia.doerg.config :as doerg-config]))
+
+
+;;; Routes
+
+(def homepage-slug "68XqhHerTWCbE--RYLEdHw")
+(def not-found-slug "PGDHTvUzQ62Js1Y5db-A8g")
+
+(defn hello [req]
+  (-> (hiccup/html {}
+        [:html
+         [:head
+          [:title "hello"]
+          doerg-html/charset
+          doerg-html/viewport]
+         [:body
+          [:pre
+           (with-out-str
+             (pprint req))]]])
+      str
+      response/response
+      (response/content-type "text/html")))
+
+(defn html-dir []
+  (-> cfg/*cfg* ::cfg/state-directory (fs/file "html")))
+
+(defn not-found [req]
+  (response/not-found "not found"))
+
+(defn org-file->html-file [org-file]
+  (fs/file (html-dir)
+           (-> org-file
+               fs/file-name
+               (fs/strip-ext {:ext "org"})
+               (str ".html"))))
+
+(defn slug-link [slug & contents]
+  [:a {:href (str "/n/" slug)}
+   contents])
+
+(defmethod doerg-render/org-link "id"
+  [{:keys [path raw-link children]}]
+  [:span.org-link
+   (slug-link (slug/from-uuid path)
+              (or (seq children) raw-link))
+   #_[:a {:href (str "/n/" (slug/from-uuid path))}
+    (or (seq children) raw-link)]])
+
+(defn backlinks-postamble [node]
+  [:section#backlinks
+   [:h2 "Backlinks"]
+   [:ul
+    (for [n (->> (roam/backlinks node)
+                 (sort-by (comp str/lower-case roam/title)))]
+      [:li (slug-link (roam/slug n)
+                      (roam/title n))])]])
+
+(defn node-by-slug [{{:keys [slug]} :path-params :as req}]
+  (if-some [node (some-> slug slug/from-string roam/get-node)]
+    (let [org-file (roam/org-file node)
+          html-file (org-file->html-file org-file)]
+      (cached-file/cached-file
+       :file html-file
+       :stale? (cached-file/newer-than? org-file html-file)
+       :compute #(doerg-render/to-html
+                  org-file
+                  :postamble (backlinks-postamble node)))
+      (-> (str html-file)
+          response/file-response
+          (response/content-type "text/html")))
+    (not-found req)))
+
+(defn node-by-id [req]
+  (hello req))
+
+(def exception-middleware
+  (reitit-exception/create-exception-middleware
+   (merge
+    reitit-exception/default-handlers
+    {::reitit-exception/wrap
+     (fn [handler e request]
+       (l/error e "error in fucking somwhere dude")
+       (handler e request))})))
+
+(defn handle-homepage [req]
+  (-> req
+      (assoc-in [:path-params :slug] homepage-slug)
+      node-by-slug))
+
+(defn handle-resource [{:keys [uri]}]
+  (if-some [[_ resource] (re-matches #"^/resource/ibm-plex-web/(.*)" uri)]
+    (-> resource
+        (response/file-response
+         {:root (-> doerg-config/*cfg* ::doerg/ibm-plex-web str)}))
+    (-> uri
+        (str/replace-first #"^/resource/" "")
+        (response/resource-response
+         {:root "net/deertopia/doerg/public"
+          :allow-symlinks? true}))))
+
+(defn handle-favicon [_]
+  (response/resource-response "net/deertopia/doerg/favicon.ico"))
+
+(def router
+  (reitit.ring/router
+   #{["/" #'handle-homepage]
+     ["/n/:slug" #'node-by-slug]
+     ["/id/:id" #'node-by-id]
+     ["/resource/*" #'handle-resource]
+     ["/myreq" #'hello]
+     ["/favicon.ico" #'handle-favicon]}
+   {:validate reitit.spec/validate
+    :exception reitit.dev.pretty/exception
+    :spec :reitit.spec/default-data
+    :data
+    {:coercion reitit.coercion.spec/coercion
+     :middleware [exception-middleware
+                  reitit.ring.coercion/coerce-request-middleware
+                  reitit.ring.coercion/coerce-response-middleware
+                  #_reitit.ring.coercion/coerce-exceptions-middleware]}}))
+
+
+;;; Server API
+
+(def app (reitit.ring/ring-handler router))
+
+(defonce server (atom nil))
+
+(defn stop! []
+  (when @server
+    (http/server-stop! @server {:timeout 100})
+    (reset! server nil)
+    (l/info "Stopped server")))
+
+;; For some reason, the log messages from `stop!` are not flushed
+;; before the JVM shuts dowm.  Nevertheless, the server /does/ come to
+;; a graceful halt.
+(def ^:private shutdown-hook (Thread. stop!))
+
+(defn start! []
+  (if @server
+    (throw (IllegalStateException. "Server already started"))
+    (do (reset! server
+                (http/run-server (bound-fn* #'app)
+                                 {:port (-> cfg/*cfg* ::cfg/port)
+                                  :legacy-return-value? false}))
+        ;; For some reason, the log messages are not flushed before
+        ;; the JVM shuts dowm.  Nevertheless, the server /does/ come
+        ;; to a graceful halt.
+        (try (.addShutdownHook (Runtime/getRuntime) shutdown-hook)
+             (catch IllegalArgumentException e
+               (when (not= "Hook previously registered"
+                           (ex-message e))
+                 (throw e))))
+        (l/infof "Server started on port %d"
+                 (-> cfg/*cfg* ::cfg/port)))))
+
+(defn status []
+  (if @server
+    (http/server-status @server)
+    :stopped))

src/net/deertopia/doerg/slug.clj

@@ -0,0 +1,64 @@
+(ns net.deertopia.doerg.slug
+  (:require [clojure.spec.alpha :as s]
+            [spec-tools.core :as st])
+  (:import (java.nio ByteBuffer)
+           (java.util Base64 UUID)))
+
+(defrecord Slug [slug-string]
+  Object
+  (toString [this]
+    (:slug-string this)))
+
+(defn from-string [s]
+  (try (let [decoder (Base64/getUrlDecoder)]
+         (when (= 16 (count (.decode decoder s)))
+           (Slug. s)))
+       ;; really stupid
+       (catch IllegalArgumentException _
+         nil)))
+
+(defn to-string [s]
+  (str s))
+
+(defn- coerce-to-uuid [string-or-uuid]
+  (cond (string? string-or-uuid) (UUID/fromString string-or-uuid)
+        (uuid? string-or-uuid) string-or-uuid))
+
+(defn- uuid->bytes [string-or-uuid]
+  (let [uuid (coerce-to-uuid string-or-uuid)]
+    (.array (doto (ByteBuffer/wrap (byte-array 16))
+              (.putLong (.getMostSignificantBits uuid))
+              (.putLong (.getLeastSignificantBits uuid))))))
+
+(defn- bytes->uuid [bytes]
+  (when (= (count bytes) 16)
+    (let [bb (ByteBuffer/wrap bytes)
+          high (.getLong bb)
+          low (.getLong bb)]
+      (UUID. high low))))
+
+(defn from-uuid [string-or-uuid]
+  (let [uuid (coerce-to-uuid string-or-uuid)
+        encoder (.withoutPadding (Base64/getUrlEncoder))]
+    (Slug. (.encodeToString encoder (uuid->bytes uuid)))))
+
+(defn to-uuid [slug]
+  (let [decoder (Base64/getUrlDecoder)]
+    (bytes->uuid (.decode decoder (str slug)))))
+
+(comment
+  (let [uuid #uuid "f9eab66e-7773-4b87-b854-0bfc8f563809"
+        slug (from-uuid uuid)
+        round-tripped (to-uuid slug)]
+    {:uuid uuid, :slug slug, :round-tripped round-tripped}))
+
+(defn make-slug [string]
+  (assert (try (to-uuid string)
+               (catch Throwable _
+                 nil))
+          "invalid slug")
+  (->Slug string))
+
+(s/def ::slug
+  (s/conformer #(or (some-> % from-string)
+                    ::s/invalid)))

src/net/deertopia/doerg/tex.clj

@@ -0,0 +1,62 @@
+(ns net.deertopia.doerg.tex
+  (:require [net.deertopia.doerg.tex.native :as native]
+            [net.deertopia.doerg.tex.temml :as temml]
+            [babashka.fs :as fs]
+            [clojure.string :as str]
+            [hiccup2.core :as hiccup]
+            [clojure.tools.logging :as l]
+            [clojure.tools.logging.readable :as lr]))
+
+(defn- read-and-patch-generated-svg [{:keys [file height depth]}]
+  ;; dvisvgm writes standalone SVG files, to which we need to make a
+  ;; few changes to use them inline within our HTML.
+  ;;   • XML header: Bad syntax when embedded in an HTML doc. Remove
+  ;;     it.
+  ;;   • Width and height: We override these with our own values
+  ;;     computed by `net.deertopia.doerg.tex` to ensure correct
+  ;;     positioning relative to the surrounding text. More
+  ;;     accurately, we remove the height and width attributes from
+  ;;     the SVG tag, and set the new values for height and
+  ;;     vertical-align in the style attribute
+  ;;   • Viewbox: Must be removed entirely for correct positioning.
+  (-> (slurp file)
+      (str/replace-first #"<\?xml version='1.0' encoding='UTF-8'\?>\n?" "")
+      (str/replace-first #" height=['\"][^\"']+[\"']" "")
+      (str/replace-first #" width=['\"][^\"']+[\"']" "")
+      (str/replace-first
+       #"viewBox=['\"][^\"']+[\"']"
+       (fn [s]
+         (format "%s style=\"%s\""
+                 s
+                 (format "height:%.4fem;vertical-align:%.4fem;display:inline-block"
+                         height (- depth)))))
+      ;; Stupid hack. --currentcolor on dvisvgm should be enough, but
+      ;; it doesn't get e.g. TikZ arrows.
+      (str/replace #"stroke=['\"]#000['\"]" "stroke=\"currentColor\"")))
+
+(defn render-snippets [snippet-promises]
+  (fs/with-temp-dir [svg-dir {:prefix "doerg-svg-"}]
+    (let [rendered-snippets
+          (delay (->> snippet-promises
+                      (map first)
+                      (apply native/render svg-dir)))]
+      (doseq [[snippet p] snippet-promises]
+        (try (let [temml (temml/render snippet)]
+               (->> (if (temml/erroneous-output? temml)
+                      (let [tex (get @rendered-snippets snippet)]
+                        (if (:errors tex)
+                          temml
+                          (read-and-patch-generated-svg tex)))
+                      temml)
+                    hiccup/raw (deliver p)))
+             (catch Exception e
+               (l/error e "Error in TeX thread")
+               (throw e)))))))
+
+(comment
+  (let [snippets (for [x ["\\(\\ifxetex blah \\fi\\)"
+                          "\\(\\sqrt{x^2 + y^2}\\)"]]
+                   [x (promise)])]
+    (temml/binding-worker
+      (render-snippets snippets)
+      (map #(-> % second deref) snippets))))

src/net/deertopia/doerg/tex/native.clj

@@ -0,0 +1,165 @@
+(ns net.deertopia.doerg.tex.native
+  "Shelling out to (Xe)LaTeX and dvisvgm. Much magic borrowed from
+  the org-latex-preview package for Emacs."
+  (:require [babashka.process :as p]
+            [net.deertopia.doerg.common :as common]
+            [clojure.java.io :as io]
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [babashka.fs :as fs]
+            [net.deertopia.doerg.config :as cfg]
+            [net.deertopia.doerg :as-alias doerg])
+  (:import (java.io ByteArrayOutputStream)))
+
+(def ^:private scale-divisor 66873.46948423679)
+
+(def ^:private font-size 10)
+
+(def ^:private tightpage-regexp
+  #"Preview: Tightpage (-?\d+) *(-?\d+) *(-?\d+) *(-?\d+)")
+
+(def ^:private preview-start-regexp
+  #"! Preview: Snippet (\d+) started.")
+
+(def ^:private preview-end-regexp
+  #"(?:^Preview: Tightpage.*$)?\n! Preview: Snippet (\d+) ended.\((\d+)\+(\d+)x(\d+)\)")
+
+(defn- invoke [extra-opts & args]
+  (let [namespace (or (::ns extra-opts) (first args))
+        out-bytes (ByteArrayOutputStream.)
+        out-stream (common/tee-output-stream
+                    out-bytes
+                    (l/log-stream :info (str namespace "/out")))
+        err-stream (l/log-stream :info (str namespace "/err"))
+        opts (merge extra-opts
+                    {:out out-stream :err err-stream :continue true
+                     :shutdown p/destroy-tree
+                     :pre-start-fn (fn [{:keys [cmd]}]
+                                     (l/infof "$ %s"
+                                              (str/join " " cmd)))
+                     :exit-fn (fn [{:keys [cmd exit]}]
+                                (l/infof "%s exited w/ status %d"
+                                         (first cmd) exit))})
+        r (apply p/shell opts args)
+        out (.toString out-bytes)]
+    (-> r
+        (assoc ::out out))))
+
+(defn- parse-tightpage [latex-out]
+  (->> (re-find tightpage-regexp latex-out)
+       (drop 1)
+       (map parse-long)))
+
+(defn- compute-geometry [[tp1 tp2 tp3 tp4] [d1 d2 d3]]
+  (let [depth (/ (- d2 tp2) scale-divisor font-size)]
+    {:depth depth
+     :height (+ depth
+                (/ (+ d1 tp4)
+                   scale-divisor
+                   font-size))
+     :width (/ (+ d3 tp3 (- tp2))
+               scale-divisor
+               font-size)}))
+
+(defn- parse-latex-output [out]
+  (let [tightpage-info (parse-tightpage out)
+        m-start (re-matcher preview-start-regexp out)
+        m-end (re-matcher preview-end-regexp out)]
+    (loop [acc []]
+      (if-some [[_ snippet-ix] (re-find m-start)]
+        (let [r (re-find m-end)
+              [_ snippet-ix* _ _ _] r
+              dimensional-info (->> r (drop 2) (map parse-long))
+              errors (-> out
+                         (subs (.end m-start) (.start m-end))
+                         (str/replace-first #"[^!]*" "")
+                         str/trim)]
+          (assert (= snippet-ix snippet-ix*))
+          (recur (conj acc (-> (compute-geometry
+                                tightpage-info dimensional-info)
+                               (assoc :errors (if (empty? errors)
+                                                nil
+                                                errors))))))
+        acc))))
+
+(defn- invoke-latex [& {:keys [file output-dir]}]
+  (let [latex (-> cfg/*cfg* ::doerg/latex)]
+    (invoke
+     {:dir output-dir}
+     latex "-no-pdf" "-interaction" "nonstopmode"
+     "-output-directory" output-dir file)))
+
+(defn- invoke-dvisvgm [& {:keys [file output-dir]}]
+  (let [dvisvgm (-> cfg/*cfg* ::doerg/dvisvgm)]
+    (invoke
+     {:dir output-dir}
+     dvisvgm "--page=1-" "--optimize" "--clipjoin"
+     "--relative" "--no-fonts" "-v3" "--currentcolor"
+     "--message=processing page {?pageno}: output written to {?svgpath}"
+     "--bbox=preview" "-o" "%9p.svg" file)))
+
+(defn- snippet-file-names
+  "Return a map of TeX snippets (as strings, including the math
+  delimiters) to file names as would be output by
+  `invoke-dvisvgm`. The returned file names are relative to dvisvgm's
+  output directory."
+  [snippets]
+  (let [svgs (for [i (range)]
+               (format "%09d.svg" i))]
+    (zipmap (reverse snippets) svgs)))
+
+(defn- read-prelude []
+  (str (-> "net/deertopia/doerg/prelude.tex" io/resource slurp)
+       \newline
+       (-> "net/deertopia/doerg/native-prelude.tex" io/resource slurp)))
+
+(defn- instantiate-preview-template [snippets]
+  (let [contents (->> (for [s snippets]
+                        (format "\\begin{preview}\n%s\n\\end{preview}" s))
+                      (str/join "\n"))]
+    (-> (io/resource "net/deertopia/doerg/preview-template.tex")
+        slurp
+        (str/replace #"% \{\{(contents|preamble)}}"
+                     #(case (second %)
+                        "contents" contents
+                        "preamble" (read-prelude))))))
+
+(defn render
+  "Render a collection of `snippets` to SVGs in `output-dir` using a
+  LaTeX engine (XeLaTeX at the moment) and dvisvgm. Returns a map
+  whose keys are `snippets` and whose values are maps containing
+  geometry info, a string of errors output by LaTeX, and the path to
+  the generated SVG file. Math delimiters are *not* implicitly added
+  to each snippet."
+  [output-dir & snippets]
+  (fs/with-temp-dir [dir {:prefix "doerg-latex"}]
+    (let [preview-tex (fs/file dir "preview.tex")
+          preview-xdv (fs/file dir "preview.xdv")
+          distinct-snippets (distinct snippets)]
+      (fs/create-dirs output-dir)
+      (->> (instantiate-preview-template distinct-snippets)
+           (spit preview-tex))
+      (let [dimensions (-> (invoke-latex :output-dir dir :file preview-tex)
+                           ::out parse-latex-output)
+            _ (invoke-dvisvgm :output-dir output-dir :file preview-xdv)]
+        ;; Adorn each snippet with dimensions and errors parsed from
+        ;; LaTeX's output, and the paths to SVG files generated by
+        ;; dvisvgm.
+        (assert (= (count distinct-snippets) (count dimensions)))
+        (->> (map (fn [ix snippet dimensions]
+                    {snippet
+                     (-> dimensions
+                         (assoc
+                          :file (fs/file output-dir
+                                         (format "%09d.svg" (inc ix)))))})
+                  (range)
+                  distinct-snippets
+                  dimensions)
+             (into {}))))))
+
+(comment
+  (render "/tmp/doerg-tex-svgs"
+          "\\(c = \\sqrt{x^2 + y^2}\\)"
+          "\\(x\\)" "\\(y\\)" "\\(x\\)"
+          "\\(\\undefinedcommandlol\\)"))
+

src/net/deertopia/doerg/tex/temml.clj

@@ -0,0 +1,90 @@
+(ns net.deertopia.doerg.tex.temml
+  (:require [babashka.process :as p]
+            [net.deertopia.doerg.common :as common]
+            [net.deertopia.doerg.config :as cfg]
+            [clj-cbor.core :as cbor]
+            [clojure.java.io :as io]
+            [clojure.string :as str]
+            [clojure.tools.logging :as l]
+            [babashka.fs :as fs]
+            [net.deertopia.doerg :as-alias doerg])
+  (:import (java.io ByteArrayOutputStream)))
+
+(def ^:dynamic *worker-timeout-duration*
+  "Number of milliseconds to wait before killing the external Uniorg
+  process."
+  (* 10 1000))
+
+(def ^:dynamic *worker*)
+
+;; 외부의 브로그램이 JVM resource를 사용 위해서 파일 시스템에서 써야
+;; 합니다.
+(defonce ^:private prelude-file
+  (-> (fs/create-temp-file {:prefix "doerg-prelude-"
+                            :suffix ".tex"})
+      fs/file))
+
+(defn worker []
+  (let [doerg-temml-worker (-> cfg/*cfg* ::doerg/doerg-temml-worker)]
+    (when (or (not (fs/exists? prelude-file))
+              (zero? (fs/size prelude-file)))
+      (-> "net/deertopia/doerg/prelude.tex"
+          io/resource
+          io/input-stream
+          (io/copy prelude-file)))
+    (p/process
+     {:shutdown p/destroy-tree
+      :err (l/log-stream :info "temml/err")}
+     doerg-temml-worker
+     "--preamble" prelude-file)))
+
+(defn close-worker [tw]
+  (.close (:in tw)))
+
+(defmacro with-worker [tw & body]
+  `(let [~tw (worker)]
+     (try
+       (do ~@body)
+       (finally
+         (close-worker ~tw)
+         (p/destroy-tree ~tw)))))
+
+(defmacro binding-worker [& body]
+  `(binding [*worker* (worker)]
+     (try
+       ~@body
+       (finally
+         (close-worker *worker*)))))
+
+(defn command-worker [x]
+  (cbor/encode cbor/default-codec (:in *worker*) x)
+  (.flush (:in *worker*))
+  (let [r (cbor/decode cbor/default-codec (:out *worker*))]
+    (if (string? r)
+      r
+      (throw (ex-info "bad data from temml worker"
+                      {:data r})))))
+
+(defn render-inline [s]
+  (command-worker s))
+
+(defn render-display [s]
+  (command-worker [s]))
+
+(defn render [s]
+  (let [s (str/trim s)]
+    (if-let [[_ inner] (re-matches #"(?s)\\\[(.*)\\]" s)]
+      (render-display inner)
+      (if (re-matches #"(?s)\\begin\{.+?}(.*?)\\end\{.+?}" s)
+        (render-display s)
+        (if-let [[_ inner] (re-matches #"(?s)\\\((.*)\\\)" s)]
+          (render-inline inner)
+          (throw (IllegalArgumentException.
+                  (ex-info
+                   (str "`net.deertopia.doerg.tex.temml` argument should"
+                        " be enclosed in math delimiters.")
+                   {:arg s}))))))))
+
+;; hackky....
+(defn erroneous-output? [s]
+  (re-find #"(#b22222|temml-error)" s))