refactor: doerg는 publisher와 결합

test/net/deertopia/doerg/common_test.clj

@@ -0,0 +1,32 @@
+(ns net.deertopia.doerg.common-test
+  (:require [net.deertopia.doerg.common :as sut]
+            [babashka.process :as p]
+            [clojure.test :as t]))
+
+(defn sleep-vs-timeout [& {:keys [sleep timeout]}]
+  (sut/deref-with-timeout
+   (p/process "sleep" (format "%ds" sleep))
+   (* timeout 1000)))
+
+;; Ideally we would test the following property:
+;;
+;;   For natural numbers n and m, evaluating the form
+;;     (sut/deref-with-timeout
+;;       (p/process "sleep" (format "%ds" n))
+;;       (* m 1000))
+;;   will throw an exception iff n < m (probably with some margin of
+;;   error lol).
+;;
+;; But, this is not something that we want to run dozens-to-hundreds
+;; of times. }:p
+
+(t/deftest long-sleep-vs-short-timeout
+  (t/testing "long sleep vs. short timeout"
+    (t/is (thrown-with-msg?
+           Exception #".*timed out.*"
+           (sleep-vs-timeout :sleep 5 :timeout 1)))))
+
+(t/deftest short-sleep-vs-long-timeout
+  (t/testing "short sleep vs. long timeout"
+    (t/is (instance? babashka.process.Process
+                     (sleep-vs-timeout :sleep 1 :timeout 5)))))

test/net/deertopia/doerg/config_test.clj

@@ -0,0 +1,9 @@
+(ns net.deertopia.doerg.config-test
+  (:require [clojure.test :as t]
+            [net.deertopia.doerg.config :as cfg]))
+
+(defn test-config-fixture
+  "`clojure.test` fixture to run tests with the :test configuration."
+  [f]
+  (binding [cfg/*cfg* (cfg/read-config cfg/sources :profile :test)]
+    (f)))

test/net/deertopia/doerg/element_test.clj

@@ -0,0 +1,115 @@
+(ns net.deertopia.doerg.element-test
+  (:require [net.deertopia.doerg.element :as sut]
+            [babashka.process :as p]
+            [clojure.test :as t]
+            [clojure.zip :as z]
+            [clojure.java.io :as io]
+            [com.rpl.specter :as sp]))
+
+(defn- first-child-of-type [parent type]
+  (some #(and (sut/of-type? % type) %) (:children parent)))
+
+(defn- parse-resource [path]
+  (-> (str "net/deertopia/doerg/element_test/" path)
+      io/resource slurp
+      (sut/read-string)))
+
+(t/deftest known-greater-elements
+  (t/testing "known greater elements satisfy `greater-element?`"
+    (let [root (parse-resource "greater-elements.org")
+          section (->> root
+                       (sp/select [sut/children-walker
+                                   #(sut/of-type? % "section")])
+                       second)
+          headline (first-child-of-type section "headline")
+          headline-text (first-child-of-type headline "text")
+          paragraph (first-child-of-type section "paragraph")
+          paragraph-text (first-child-of-type paragraph "text")]
+      (t/is (sut/greater-element? root))
+      (t/is (sut/greater-element? section))
+      (t/is (sut/greater-element? headline))
+      (t/is (not (sut/greater-element? headline-text)))
+      (t/is (sut/greater-element? paragraph))
+      (t/is (not (sut/greater-element? paragraph-text))))))
+
+(defn- first-paragraph-belongs-to-first-section? [doc]
+  (let [first-paragraph (sp/select-first [sut/postorder-walker
+                                          #(sut/of-type? % "paragraph")]
+                                         doc)
+        first-section (sp/select-first [sut/postorder-walker
+                                        #(sut/of-type? % "section")]
+                                       doc)]
+    (if (and first-paragraph first-section)
+      (boolean (some #(= % first-paragraph)
+                     (:children first-section)))
+      true)))
+
+(t/deftest first-paragraph-under-first-section
+  (t/is (-> (parse-resource "first-paragraph-under-first-section.org")
+            first-paragraph-belongs-to-first-section?)))
+
+(t/deftest first-paragraph-under-heading
+  (t/is (-> (parse-resource "first-paragraph-under-heading.org")
+            first-paragraph-belongs-to-first-section?
+            not)))
+
+(defn- walk-types [type & types]
+  [sut/postorder-walker #(apply sut/of-type? % type types)])
+
+(t/deftest paragraph-ending-with-latex
+  (let [doc (parse-resource "paragraph-ending-with-latex.org")
+        type (-> (sp/select-first [(walk-types "paragraph")
+                                   (sp/must :children)
+                                   sp/LAST]
+                                  doc)
+                 sut/type)]
+    (t/is (= "latex-environment" type))))
+
+(t/deftest paragraph-surrounding-latex
+  (let [doc (parse-resource "paragraph-surrounding-latex.org")
+        children (->> doc
+                      (sp/select-first [(walk-types "paragraph")])
+                      :children
+                      (map sut/type))]
+    (t/is (= ["text" "latex-environment" "text"]
+             children))))
+
+(t/deftest paragraph-ending-in-bold-surrounding-latex
+  (let [doc (parse-resource "paragraph-ending-in-bold-surrounding-latex.org")
+        children (->> doc
+                      (sp/select-first [(walk-types "paragraph")])
+                      :children
+                      (map sut/type))]
+    (t/is (= ["text" "bold" "latex-environment" "text"]
+             children))))
+
+(t/deftest paragraph-with-multiple-latex
+  (let [doc (parse-resource "paragraph-with-multiple-latex.org")
+        paragraphs (sp/select (walk-types "paragraph") doc)]
+    (t/is (= 2 (count paragraphs)))
+    (let [[p₁ p₂] paragraphs]
+      (doseq [[p ts] [[p₁ ["text" "latex-environment"
+                           "text" "latex-environment"]]
+                      [p₂ ["text" "latex-environment"
+                           "text" "latex-environment" "text"]]]]
+        (t/is (= ts (sp/select [(sp/must :children)
+                                sp/ALL (sp/view sut/type)] p)))))))
+
+(t/deftest paragraph-with-separate-latex
+  (let [doc (parse-resource "paragraph-with-separate-latex.org")
+        cs (sp/select [(walk-types "section")
+                       (sp/must :children)
+                       sp/ALL
+                       (sp/view sut/type)]
+                      doc)]
+    (t/is (= ["paragraph" "latex-environment"] cs))))
+
+(t/deftest paragraph-surrounding-separate-latex
+  (let [doc (parse-resource "paragraph-surrounding-separate-latex.org")
+        cs (sp/select [(walk-types "section")
+                       (sp/must :children)
+                       sp/ALL
+                       (sp/view sut/type)]
+                      doc)]
+    (t/is (= ["paragraph" "latex-environment" "paragraph"] cs))))
+

test/net/deertopia/doerg/element_test/first-paragraph-under-first-section.org

@@ -0,0 +1,7 @@
+#+title: first paragraph under first section
+
+first paragraph is here and not under the first heading
+
+* first heading
+
+second paragraph

test/net/deertopia/doerg/element_test/first-paragraph-under-heading.org

@@ -0,0 +1,5 @@
+#+title: first paragraph under a heading
+
+* first heading
+
+first paragraph is here and not in the first section

test/net/deertopia/doerg/element_test/greater-elements.org

@@ -0,0 +1,5 @@
+#+title: greater elements test
+
+* a headline/section
+
+this should be a greater element

test/net/deertopia/doerg/element_test/paragraph-ending-in-bold-surrounding-latex.org

@@ -0,0 +1,7 @@
+#+title: bold-final paragraph surrounding latex
+
+first part of *paragraph*
+\begin{equation*}
+\text{some \LaTeX \}:)}
+\end{equation*}
+last part of paragraph

test/net/deertopia/doerg/element_test/paragraph-ending-with-latex.org

@@ -0,0 +1,7 @@
+#+title: paragraph ending with latex
+
+here is the paragraph,
+\begin{align*}
+\text{and here} &
+\\ & \text{is the \LaTeX}
+\end{align*}

test/net/deertopia/doerg/element_test/paragraph-surrounding-latex.org

@@ -0,0 +1,7 @@
+#+title: paragraph surrounding latex
+
+first part of paragraph
+\begin{equation*}
+\text{some \LaTeX \}:)}
+\end{equation*}
+last part of paragraph

test/net/deertopia/doerg/element_test/paragraph-surrounding-separate-latex.org

@@ -0,0 +1,9 @@
+#+title: paragraphs surrounding separate latex
+
+a paragraph!
+
+\begin{gather*}
+\text{and now, an unrelated latex fragment}
+\end{gather*}
+
+more unrelated text

test/net/deertopia/doerg/element_test/paragraph-with-multiple-latex.org

@@ -0,0 +1,24 @@
+#+title: paragraph with multiple latex environments
+
+* interleaved
+
+first part of paragraph
+\begin{equation*}
+\text{first \LaTeX\ environment}
+\end{equation*}
+second part of paragraph
+\begin{equation*}
+\text{second \LaTeX\ environment}
+\end{equation*}
+
+* fenceposted
+
+first fencepost
+\begin{equation*}
+\text{first fenceposted \LaTeX\ environment}
+\end{equation*}
+second fencepost
+\begin{equation*}
+\text{second fenceposted \LaTeX\ environment}
+\end{equation*}
+third fencepost

test/net/deertopia/doerg/element_test/paragraph-with-separate-latex.org

@@ -0,0 +1,7 @@
+#+title: paragraph with separate latex
+
+a paragraph!
+
+\begin{gather*}
+\text{and now, an unrelated latex fragment}
+\end{gather*}

test/net/deertopia/doerg/org-roam-db-sync.el

@@ -0,0 +1,8 @@
+#!/usr/bin/env -S emacs -Q -x
+
+(require 'org-roam)
+
+(setq org-roam-directory (expand-file-name (car command-line-args-left)))
+(setq org-roam-db-location (expand-file-name (cadr command-line-args-left)))
+
+(org-roam-db-sync)

test/net/deertopia/doerg/render_test.clj

@@ -0,0 +1,60 @@
+(ns net.deertopia.doerg.render-test
+  (:require [net.deertopia.doerg.render :as sut]
+            [net.deertopia.doerg.element :as element]
+            [net.deertopia.doerg.tex.temml :as temml]
+            [net.deertopia.doerg.tex.native :as native]
+            [com.rpl.specter :as sp]
+            [clojure.edn :as edn]
+            [clojure.test :as t]
+            [clojure.java.io :as io]
+            [clojure.string :as str]))
+
+;; Stupid and hacky.
+(defn mathml? [s]
+  (str/starts-with? s "<math"))
+
+;; Also stupid and hacky. }:)
+(defn svg? [s]
+  (some? (re-matches #"(?s)(<!--.*?-->\n)<svg.*" s)))
+
+(defn read-resource [s]
+  (let [p (-> (format "net/deertopia/doerg/render_test/%s" s)
+              io/resource slurp)]
+    (cond (str/ends-with? s ".edn") (edn/read-string p)
+          (str/ends-with? s ".org") (element/read-string p))))
+
+(t/deftest latex-fallbacks
+  (t/testing "LaTeX fallback behaviour"
+    (let [doc (temml/binding-worker
+                (-> "fallbacks.org" read-resource sut/render-tex-snippets))
+          snippets (->> doc
+                        (sp/select
+                         [element/postorder-walker
+                          #(element/of-type?
+                            % "latex-fragment" "latex-environment")
+                          (sp/view #(-> % ::sut/rendered deref str))]))
+          expectations (-> "fallbacks.edn" read-resource)]
+      (doall (map (fn [s e]
+                    (let [mathml (mathml? s)
+                          svg (svg? s)]
+                      (assert
+                       (not= mathml svg)
+                       "`mathml?` and `svg?` should be mutually-exclusive.")
+                      (case e
+                        :mathml (t/is mathml)
+                        :svg (t/is svg))))
+                  snippets expectations)))))
+
+(t/deftest latex-laziness
+  (t/testing "LaTeX laziness"
+    (let [ex (Exception. "you're supposed to be lazy!")
+          bad (fn [& _] (throw ex))
+          doc (read-resource "latexless.org")
+          r (try (with-redefs-fn {#'native/render bad
+                                  #'temml/render bad}
+                   #(sut/render-tex-snippets doc))
+                 (catch Exception e
+                   (if (= e ex)
+                     false
+                     (throw e))))]
+      (t/is r))))

test/net/deertopia/doerg/render_test/fallbacks.edn

@@ -0,0 +1,7 @@
+[:mathml
+ :mathml
+ :mathml
+ :mathml
+ :svg
+ :mathml
+ :svg]

test/net/deertopia/doerg/render_test/fallbacks.org

@@ -0,0 +1,20 @@
+#+title: aghhh
+
+- blah blah prose prose prose \(c = \sqrt{x^2 + y^2}\), alal.
+- this thing is \(x\)
+- another thing \(y\)
+- this thing is also \(x\) and uses the same svg
+- ifxetex: \(\ifxetex alalala\fi \)
+
+balahahahahahaj
+\begin{align*}
+x &= y
+\\ &= zzz.
+\end{align*}
+awawawa
+
+cool ass tbale
+\begin{tabular}{|c|c|c|}
+blah & glah & zlah
+\\ abdwa & www &dj
+\end{tabular}

test/net/deertopia/doerg/render_test/latexless.org

@@ -0,0 +1,3 @@
+#+title: 이 파일은 LaTeX 코드가 포함되지 않습니다.
+
+🦌!

test/net/deertopia/doerg/roam-test/20260325083230-awesome_file.org

@@ -0,0 +1,7 @@
+:PROPERTIES:
+:ID:       23ee464d-b13e-4649-826f-622d0edef24e
+:DeertopiaVisibility: public
+:END:
+#+title: awesome file
+
+wow!

test/net/deertopia/doerg/roam-test/404.org

@@ -0,0 +1,23 @@
+:PROPERTIES:
+:ID:       3c60c74e-f533-43ad-89b3-563975bf80f2
+:DeertopiaVisibility: public
+:END:
+#+title: page not found
+
+the page you're looking for doesn't exist, or you lack the permissions necessary to view it........
+
+#+attr_doerg: :center? true :alt "A doe sitting and sobbing" :scale 1.4
+#+begin_example
+  \{ /    \ }/
+   \/ .  . \/
+ .. \Y`  `Y/ ..
+ \ `\|~==~|/' /
+  '". T T  ."`
+     {`^' }
+      |  |
+     /</3 \
+    ||    ||
+    _| || |_
+.,_) ) || ( (_,.
+|__  /_||_\  __|
+#+end_example

test/net/deertopia/doerg/roam-test/categorytheory.org

@@ -0,0 +1,7 @@
+:PROPERTIES:
+:ID:       90f23e03-f746-42cb-862f-1af2d4bde3cc
+:DeertopiaVisibility: public
+:END:
+#+title: Category theory
+
+*Category theory* is the mathematical study of categories and functors between them.

test/net/deertopia/doerg/roam-test/fake-homepage.org

@@ -0,0 +1,7 @@
+:PROPERTIES:
+:ID:       ebc5ea84-77ab-4d60-9b13-ef9160b11d1f
+:DeertopiaVisibility: public
+:END:
+#+title: deertopia.net!!!!!!!!
+
+homeee

test/net/deertopia/doerg/roam-test/monoepi.org

@@ -0,0 +1,22 @@
+:PROPERTIES:
+:ID:       897bfc9d-94ce-4c58-8d21-93f13372b17b
+:END:
+#+title: Monomorphisms and epimorphisms
+
+In [[id:90f23e03-f746-42cb-862f-1af2d4bde3cc][category theory]], *monomorphisms* and *epimorphisms* are types of cancellative morphisms generalising injective and surjective functions, respectively.[fn:1]
+
+\begin{tikzcd}
+% https://q.uiver.app/#q=WzAsNixbMCwwLCJYIl0sWzEsMCwiWSJdLFsyLDAsIloiXSxbMSwxLCJZIl0sWzIsMSwiWiJdLFswLDEsIlgiXSxbMCwxLCJnXzEiLDAseyJvZmZzZXQiOi0yfV0sWzAsMSwiZ18yIiwyLHsib2Zmc2V0IjoyfV0sWzEsMiwiZiIsMl0sWzMsNCwiZ18xIiwwLHsib2Zmc2V0IjotMn1dLFszLDQsImdfMiIsMix7Im9mZnNldCI6Mn1dLFs1LDMsImYiLDJdXQ==
+	X & Y & Z \\
+	X & Y & Z
+	\arrow["{g_1}", shift left=2, from=1-1, to=1-2]
+	\arrow["{g_2}"', shift right=2, from=1-1, to=1-2]
+	\arrow["f"', from=1-2, to=1-3]
+	\arrow["f"', from=2-1, to=2-2]
+	\arrow["{g_1}", shift left=2, from=2-2, to=2-3]
+	\arrow["{g_2}"', shift right=2, from=2-2, to=2-3]
+\end{tikzcd}
+
+* Footnotes
+
+[fn:1] blahahahahah blah blah

test/net/deertopia/doerg/roam_test.clj

@@ -0,0 +1,63 @@
+(ns net.deertopia.doerg.roam-test
+  (:require [net.deertopia.doerg.roam :as sut]
+            [clojure.test :as t]
+            [clojure.java.io :as io]
+            [net.deertopia.doerg.config :as cfg]
+            [babashka.fs :as fs]
+            [babashka.process :as p]
+            [net.deertopia.doerg.config-test :refer [test-config-fixture]]
+            [next.jdbc :as sql]
+            [clojure.string :as str]
+            [net.deertopia.doerg.elisp :as elisp]
+            [com.rpl.specter :as sp]))
+
+(def org-roam-directory
+  (fs/file "test/net/deertopia/doerg/roam-test"))
+
+(defn org-roam-db-sync [db-file]
+  (let [script-file (fs/create-temp-file {:prefix "org-roam-db-sync-"
+                                          :suffix ".el"})
+        emacs (->> [(System/getenv "EMACS") "test-emacs" "emacs"]
+                   (some #(some-> % fs/which)))]
+    (io/copy (-> "net/deertopia/doerg/org-roam-db-sync.el"
+                 io/resource io/reader)
+             (fs/file script-file))
+    (p/shell {:out :string :err :string}
+             emacs "-Q" "-x" script-file org-roam-directory db-file)
+    (fs/delete script-file)))
+
+(defn test-db-fixture [f]
+  (let [db-file (-> cfg/*cfg* ::cfg/org-roam-db-path)]
+    (assert (->> db-file fs/canonicalize str
+                 (re-matches #"^/(build|tmp)/.*"))
+            (format "i'm scared to delete a non-test database... %s"
+                    (str db-file)))
+    (fs/delete-if-exists db-file)
+    (org-roam-db-sync db-file)
+    (f)
+    (fs/delete db-file)))
+
+(t/use-fixtures
+  :once (t/join-fixtures [test-config-fixture test-db-fixture]))
+
+
+
+(t/deftest all-nodes-exist
+  (let [known-node-files (->> (fs/list-dir org-roam-directory)
+                              (map (comp str fs/canonicalize))
+                              (into #{}))
+        database-nodes
+        (->> (sql/execute!
+              (sut/ds) ["select file, id from nodes"])
+             (map (fn [x]
+                    {:file (-> x :nodes/file elisp/read-string)
+                     :id (-> x :nodes/id elisp/read-string parse-uuid)}))
+             (into #{}))]
+    (t/testing "database has a node for each file?"
+      (t/is (= known-node-files (sp/transform
+                                 [sp/ALL]
+                                 #(:file %)
+                                 database-nodes))))
+    (t/testing "each uuid exists?"
+      (t/is (every? (comp sut/uuid-exists? :id)
+                    database-nodes)))))

test/net/deertopia/doerg/server_test.clj

@@ -0,0 +1,52 @@
+(ns net.deertopia.doerg.server-test
+  (:require [net.deertopia.doerg.server :as sut]
+            [reitit.ring]
+            [clojure.test :as t]
+            [net.deertopia.doerg.config :as cfg]
+            [net.deertopia.doerg.roam :as roam]
+            [babashka.fs :as fs]
+            [clojure.java.io :as io]
+            [net.deertopia.doerg.roam-test :refer [test-db-fixture]]
+            [net.deertopia.doerg.config-test :refer [test-config-fixture]]))
+
+(t/use-fixtures
+  :once (t/join-fixtures [test-config-fixture test-db-fixture]))
+
+(defn with-server [f]
+  (let [was-already-running? (= :running (sut/status))]
+    (when-not was-already-running?
+      (sut/start!))
+    (f)
+    (when-not was-already-running?
+      (sut/stop!))))
+
+(defn get-sut [uri]
+  (sut/app {:request-method :get
+            :uri uri}))
+
+
+
+(t/deftest server-is-running
+  ;; 서버는 벌써 시작한 다음에 이 테스트 하면 잘못됩니다.
+  ;; (assert (not= :running (sut/status)))
+  (with-server
+    (fn []
+      (t/is (= :running (sut/status)))
+      (t/is (->> (format "http://localhost:%d"
+                         (::cfg/port cfg/*cfg*))
+                   slurp
+                   string?)))))
+
+(t/deftest get-nonexistent-node
+  (let [slug "3Lxvxnb0QrivoU3DX-l_5w"]
+    (assert (nil? (roam/make-node slug)))
+    (t/is (= 404
+             (-> (str "/n/" slug)
+                 get-sut :status)))))
+
+(t/deftest get-homepage
+  (let [resp (-> (str "/n/" sut/homepage-slug)
+                 get-sut)]
+    (t/is (= 200 (:status resp)))
+    (t/is (= (-> "/" get-sut :body)
+             (-> resp :body)))))