basic rendering!

doerg/src/net/deertopia/doerg/config.clj

@@ -0,0 +1,10 @@
+(ns net.deertopia.doerg.config
+  (:require [clojure.spec.alpha :as s]
+            [spec-dict.main :refer [dict]]))
+
+(s/def ::config
+  (s/keys :req []))
+
+(def default {})
+
+(def ^:dynamic *cfg* default)

doerg/src/net/deertopia/doerg/element.clj

@@ -0,0 +1,101 @@
+(ns net.deertopia.doerg.element
+  (:require [babashka.process :as p]
+            [clojure.string :as str]
+            [clojure.zip :as z]
+            [babashka.fs :as fs]
+            [clojure.java.io :as io]
+            [cheshire.core :as json]
+            [clojure.spec.alpha :as s]
+            [spec-dict.main :refer [dict]]
+            [net.deertopia.doerg.config :as cfg])
+  (:refer-clojure :exclude [read-string]))
+
+
+(defonce ^:private uniorg-script-path-atom (atom nil))
+
+(def ^:dynamic *uniorg-timeout-after-milliseconds*
+  (* 10 1000))
+
+(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- 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}
+               "doerg-parser")
+              (deref-with-timeout *uniorg-timeout-after-milliseconds*))]
+    (if (zero? (:exit r))
+      (-> r :out (json/parse-string (comp keyword camel->kebab))))))
+
+(defn read-string [s]
+  (with-in-str s
+    (uniorg :in *in*)))
+
+
+
+(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.
+  (contains? e :children))
+
+(defn org-element? [element]
+  #_
+  (s/valid? ::org-element element)
+  (and (map? element)
+       (contains? element :type)))
+
+(defn of-type? [element type]
+  (= (:type element) type))
+
+
+;;; Spec
+
+(s/def ::org-element
+  (dict {:type string?}
+        ^:opt {:contents-begin nat-int?
+               :contents-end nat-int?
+               :children (s/coll-of ::org-element
+                                    :kind seq?)}))
+
+
+;;; Zipper
+
+(defn doerg-zip [document]
+  (z/zipper greater-element?
+            :children
+            #(assoc %1 :children %2)
+            document))
+
+(defn cata
+  "Catamorphism on a zipper."
+  [loc f]
+  (let [loc* (if-some [child (z/down loc)]
+               (loop [current child]
+                 (let [current* (cata current f)]
+                   (if-some [right (z/right current*)]
+                     (recur right)
+                     (z/up current*))))
+               loc)]
+    (z/replace loc* (f (z/node loc*)))))

doerg/src/net/deertopia/doerg/html.clj

@@ -0,0 +1,37 @@
+(ns net.deertopia.doerg.html
+  "Common HTML elements and utilities"
+  (:require [clojure.java.io :as io]))
+
+#_
+(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"}])
+
+(def tuftesque
+  #_
+  [:link {:rel "stylesheet"
+          :type "text/css"
+          :href "/resources/tuftesque.css"}]
+  [:style
+   (slurp (io/resource "net/deertopia/doerg/tuftesque.css"))])
+
+(def head
+  (list viewport charset tuftesque))

doerg/src/net/deertopia/doerg/parse.clj

@@ -1,17 +0,0 @@
-(ns net.deertopia.doerg.parse
-  (:require [babashka.process :as p]
-            [babashka.fs :as fs]
-            [clojure.java.io :as io]
-            [cheshire.core :as json])
-  (:refer-clojure :exclude [read-string]))
-
-(defonce ^:private uniorg-script-path-atom (atom nil))
-
-(defn- uniorg []
-  @(p/process {:in (slurp "/home/msyds/org/20260124165717-if_so_in_korean.org")
-               :out :string}
-              "doerg-parser"))
-
-(defn read-string [s]
-  #_
-  (p/process "node" (uniorg-script-path)))

doerg/src/net/deertopia/doerg/render.clj

@@ -0,0 +1,76 @@
+(ns net.deertopia.doerg.render
+  (:require [net.deertopia.doerg.element :as element]
+            [clojure.tools.logging :as l]
+            [clojure.tools.logging.readable :as lr]
+            [net.deertopia.doerg.html :as doerg-html]
+            [clojure.zip :as z]))
+
+;;; 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 *document-info*)
+
+(declare ^:private gather-footnotes renderer-error)
+
+(defn org-element-recursive
+  "Recursively render an Org-mode element to Hiccup."
+  [e]
+  (let [loc (element/doerg-zip e)]
+    (-> loc
+        (element/cata
+         (fn [node]
+           (try (org-element node)
+                (catch Throwable e
+                  (lr/error e "Error in renderer" {:node node})
+                  (renderer-error e)))))
+        z/node)))
+
+(defn org-document
+  "Recursively render an Org-mode document to Hiccup."
+  [doc]
+  (let [loc (element/doerg-zip doc)]
+    (binding [*document-info* {:footnotes (gather-footnotes loc)}]
+      (let [rendered (org-element-recursive doc)]
+        [:html
+         [:head
+          [:title "org document"]
+          doerg-html/viewport
+          doerg-html/charset
+          doerg-html/tuftesque]
+         [:body
+          [:article
+           rendered]]]))))
+
+
+
+(defn- gather-footnotes [loc]
+  {})
+
+
+
+(defn- renderer-error
+  "Render a `Throwable` to display within the document."
+  [e]
+  "aaaa an error!")