chore: cleanup

wip: feat: org-element specs

deps-lock.json

@@ -675,6 +675,11 @@
       "mvn-repo": "https://repo1.maven.org/maven2/",
       "hash": "sha256-g5qUXfrO6lvVB5+CSPM0bdIULesJFGyj9dG/riYxCWc="
     },
+    {
+      "mvn-path": "org/clojure/pom.contrib/1.4.0/pom.contrib-1.4.0.pom",
+      "mvn-repo": "https://repo1.maven.org/maven2/",
+      "hash": "sha256-CZNnaHYIH0kbpa+C+mtaA3o77joSWgLW1eJ6op81Z4c="
+    },
     {
       "mvn-path": "org/clojure/spec.alpha/0.2.194/spec.alpha-0.2.194.jar",
       "mvn-repo": "https://repo1.maven.org/maven2/",
@@ -715,6 +720,16 @@
       "mvn-repo": "https://repo1.maven.org/maven2/",
       "hash": "sha256-UZ45jnJMYvCsnWsZ15+P8QAdqYWD/eAb1wUrB+Ga1ow="
     },
+    {
+      "mvn-path": "org/clojure/test.check/1.1.3/test.check-1.1.3.jar",
+      "mvn-repo": "https://repo1.maven.org/maven2/",
+      "hash": "sha256-iwY3sTmCc0dC+z9NEp8KnZ49dSsa7AxvZc7UVV9ytkk="
+    },
+    {
+      "mvn-path": "org/clojure/test.check/1.1.3/test.check-1.1.3.pom",
+      "mvn-repo": "https://repo1.maven.org/maven2/",
+      "hash": "sha256-pPIf6yOG+/zUKlIgDRTA94u+9omfdIzO/LCkSZ4P3sU="
+    },
     {
       "mvn-path": "org/clojure/tools.cli/1.1.230/tools.cli-1.1.230.jar",
       "mvn-repo": "https://repo1.maven.org/maven2/",

doerg/deps.edn

@@ -9,7 +9,8 @@
         com.rpl/specter {:mvn/version "1.1.6"}
         lambdaisland/deep-diff2 {:mvn/version "2.12.219"}
         mvxcvi/clj-cbor {:mvn/version "1.1.1"}
-        ch.qos.logback/logback-classic {:mvn/version "1.1.3"}}
+        ch.qos.logback/logback-classic {:mvn/version "1.1.3"}
+        org.clojure/test.check {:mvn/version "1.1.3"}}
  :paths ["src" "resources" "test"]
  :aliases
  {:test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}

doerg/doerg-parser/index.js

@@ -2,13 +2,17 @@
 
 const { parse } = require ("uniorg-parse/lib/parser.js");
 
+const opts = {
+    trackPosition: true
+}
+
 async function main () {
     const chunks = []
     for await (const chunk of process.stdin) {
 	chunks.push (chunk)
     }
     const orgText = Buffer.concat (chunks).toString ("utf8")
-    process.stdout.write (JSON.stringify (parse (orgText)))
+    process.stdout.write (JSON.stringify (parse (orgText, opts)))
 }
 
 main ()

doerg/resources/net/deertopia/doerg/preview-template.tex

@@ -48,6 +48,12 @@
 \newcommand{\optic}[3]{\opticname{#1}^\prime\;#2\;#3}
 \newcommand{\Optic}[5]{\opticname{#1}\;#2\;#3\;#4\;#5}
 
+% Default uses arrow glyphs from the active font, which are kinda ugly in the
+% case of Plex.
+\tikzcdset{
+  arrow style=tikz
+}
+
 \begin{document}
 \setlength\abovedisplayskip{0pt} % Remove padding before equation environments.
 %% \color[rgb]{0.000,0.000,0.004}\special{dvisvgm:currentcolor on}\setcounter{equation}{0}%

doerg/resources/net/deertopia/doerg/tuftesque.css

@@ -104,6 +104,7 @@ section {
 p,
 dl,
 ol,
+.latex-fragment,
 ul {
     font-size: 1.2rem;
     line-height: 1.5rem;
@@ -549,10 +550,15 @@ figure.fullwidth figcaption {
 
 .latex-fragment.display-math
 { display: block
-; width: 55%
 /* Center it — do we want to do that? */
 ; align-items: center
 ; justify-content: center
 ; display: flex
 ; max-width: 55%
+; width: 55%
+}
+
+p > .latex-fragment.display-math
+{ max-width: 100%
+; width: 100%
 }

doerg/scratch.clj

@@ -0,0 +1,27 @@
+(ns scratch
+  (:require [clojure.spec.alpha :as s]
+            [spec-dict.main :refer [dict]]
+            [clojure.test.check.generators :as gen]))
+
+
+(defmulti node-spec :type)
+
+(s/def ::node
+  (s/multi-spec node-spec :type))
+
+(s/def ::children (s/coll-of ::node :kind vector?))
+
+(s/def ::value nat-int?)
+
+(defmethod node-spec :branch [_]
+  (dict {:children ::children})
+  #_(s/keys :req-un [::children]))
+
+(defmethod node-spec :leaf [_]
+  (dict {:value ::value})
+  #_
+  (s/keys :req-un [::value]))
+
+(comment
+  (binding [s/*recursion-limit* 1]
+    (gen/generate (s/gen ::node))))

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

@@ -1,18 +1,25 @@
 (ns net.deertopia.doerg.element
-  (:require [babashka.process :as p]
-            [net.deertopia.doerg.common :as common]
-            [clojure.string :as str]
-            [clojure.zip]
-            [babashka.fs :as fs]
-            [clojure.java.io :as io]
+  (:refer-clojure :exclude [read-string type])
+  (:require [babashka.fs :as fs]
+            [babashka.process :as p]
             [cheshire.core :as json]
+            [clojure.core.match :refer [match]]
+            [clojure.java.io :as io]
+            [clojure.set :as set]
             [clojure.spec.alpha :as s]
-            [spec-dict.main :refer [dict]]
-            [net.deertopia.doerg.config :as cfg]
+            [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]
-            [clojure.tools.logging.readable :as lr])
-  (:import (java.util UUID))
-  (:refer-clojure :exclude [read-string]))
+            [com.rpl.specter.zipper :as sz]
+            [net.deertopia.doerg.common :as common]
+            [net.deertopia.doerg.config :as cfg]
+            [spec-dict.main :refer [dict]]
+            [clojure.tools.logging :as l])
+  (:import
+   (java.util UUID)))
+
 
 
 (def ^:dynamic *uniorg-timeout-duration*
@@ -34,10 +41,12 @@
     (if (zero? (:exit r))
       (-> r :out (json/parse-string (comp keyword camel->kebab))))))
 
-(declare gather-first-section)
+(declare gather-first-section gather-latex-paragraphs element-types)
 
-(defn read-string [s & {:keys [post-processors]
-                        :or {post-processors [gather-first-section]}}]
+(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*)
@@ -60,6 +69,9 @@
   (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
@@ -196,6 +208,22 @@
      :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.")
@@ -203,8 +231,232 @@
         (split-sections (:children node))
         ;; TODO: Construct `:contents-begin` and `:contents-end` data
         ;; by spanning the children.
-        new-children (concat top-level-nodes
-                             (list {:type "section"
-                                    :children first-section-nodes})
-                             rest)]
+        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))))))
+
+
+;;; Specs (top-level)
+
+;; Data taken from uniorg/index.d.ts
+
+(comment
+  (defn- typescript-enum->set [s]
+    (as-> s
+        it
+      (str/split it #" \| ")
+      (map camel->kebab it)
+      (into #{} it))))
+
+(def greater-element-types
+  #{"org-data" "section" "property-drawer" "drawer" "plain-list"
+    "list-item" "quote-block" "verse-block" "center-block"
+    "special-block" "footnote-definition" "table"})
+
+(def element-types
+  #{"list-item-tag" "src-block" "comment-block" "latex-environment"
+    "keyword" "paragraph" "node-property" "example-block" "clock"
+    "planning" "diary-sexp" "fixed-width" "export-block"
+    "horizontal-rule" "comment" "table-row" "headline"})
+
+(def recursive-object-types
+  #{"citation" "footnote-reference" "superscript" "table-cell" "link"
+    "italic" "citation-common-prefix" "subscript" "citation-prefix"
+    "citation-common-suffix" "strike-through" "citation-reference"
+    "bold" "underline"})
+
+(def object-types
+  #{"line-break" "citation-suffix" "statistics-cookie" "timestamp"
+    "text" "verbatim" "citation-key" "export-snippet" "latex-fragment"
+    "entity" "code"})
+
+(s/def ::greater-element-type greater-element-types)
+(s/def ::element-type element-types)
+(s/def ::object-type (set/union recursive-object-types object-types))
+(s/def ::recursive-object-type recursive-object-types)
+
+(s/def ::contents-begin nat-int?)
+(s/def ::contents-end nat-int?)
+
+(defmulti node-spec :type)
+
+(defn- unimplemented-spec [x]
+  (lr/warnf "unimplemented method for %s" x)
+  (s/with-gen any?
+    (constantly (gen/return {}))))
+
+(defmethod node-spec :default [x] (unimplemented-spec x))
+
+(def ^:private nfe
+  "NFE — “no further expectations.” Used in sub-specs of `::element`
+  et al. for elements with no additional structure beyond that
+  provided by their parents."
+  (s/with-gen any?
+    (constantly (gen/return {}))))
+
+(s/def ::node
+  (s/multi-spec node-spec :type))
+
+(s/def :object/type ::object-type)
+
+(s/def ::object
+  (s/keys :req-un [:object/type]))
+
+(s/def :element/children (s/coll-of ::object :kind vector?))
+(s/def :element/type ::element-type)
+
+(s/def ::element
+  (s/keys :opt-un [::contents-begin ::contents-end]
+          :req-un [:element/children :element/type]))
+
+(s/def :greater-element/children
+  (s/coll-of (s/merge
+              (dict {:type (set/union greater-element-types
+                                      element-types)})
+              ::node)
+             :kind vector?))
+
+(s/def :greater-element/type ::greater-element-type)
+
+(s/def ::greater-element
+  (s/keys :req-un [::contents-begin ::contents-end
+                   :greater-element/children
+                   :greater-element/type]))
+
+(s/def :recursive-object/children
+  (s/coll-of
+   (s/merge
+    (dict {:type ::object-type})
+    ::node)
+   :kind vector?))
+
+(s/def :recursive-object/type ::object-type)
+
+(s/def ::recursive-object
+  (s/keys :opt-un [::contents-begin ::contents-end]
+          :req-un [:recursive-object/children
+                   :recursive-object/type]))
+
+(comment
+  (use 'net.deertopia.doerg.repl)
+  (def doc (-> "test/net/deertopia/doerg/element_test/paragraph-with-multiple-latex.org"
+               slurp
+               (read-string :post-processors
+                            [gather-first-section])))
+  (s/explain ::node doc)
+  (binding [s/*recursion-limit* 1]
+    (gen/generate (s/gen ::node)))
+  (sp/select [postorder-walker (sp/must :children)
+              (sp/continuous-subseqs)]
+             doc))
+
+(s/def ::todo-keyword string?)
+(s/def ::priority string?)
+(s/def ::commented boolean?)
+(s/def ::level nat-int?)
+(s/def ::tags (s/coll-of string? :kind vector?))
+
+
+;;; Specs (specific elements)
+
+(def ^:private string-value (dict {:value string?}))
+
+(defmethod node-spec "text" [_] (s/merge ::object string-value))
+(defmethod node-spec "verbatim" [_] (s/merge ::object string-value))
+(defmethod node-spec "code" [_] (s/merge ::object string-value))
+(defmethod node-spec "bold" [_] ::recursive-object)
+(defmethod node-spec "italic" [_] ::recursive-object)
+
+(defmethod node-spec "headline" [_]
+  (s/merge ::element
+           (dict {:todo-keyword (s/nilable ::todo-keyword)
+                  :priority (s/nilable ::priority)
+                  :level ::level
+                  :commented ::commented
+                  :raw-value string?
+                  :tags ::tags})))
+
+(defmethod node-spec "org-data" [_]
+  ::greater-element)
+
+(defmethod node-spec "section" [_]
+  ::greater-element)

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

@@ -9,9 +9,7 @@
             [net.deertopia.doerg.html :as doerg-html]
             [hiccup2.core :as hiccup]
             [clojure.pprint]
-            ;; #_
             [net.deertopia.doerg.tex :as tex]
-            ;; [net.deertopia.doerg.tex.native :as tex-native]
             [net.deertopia.doerg.tex.temml :as tex-temml]
             [clojure.zip :as z]
             [babashka.fs :as fs]))
@@ -341,9 +339,7 @@
 (defmethod org-keyword "TITLE" [{:keys [value]}]
   [:h1 value])
 
-;; Completely ignore the LATEX_COMPILER keyword.
 (defmethod org-keyword "LATEX_COMPILER" [_] nil)
-
 (defmethod org-keyword "LATEX_HEADER" [_] nil)
 
 ;; Not sure how to deal with this one yet.

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

@@ -34,16 +34,7 @@
       ;; it doesn't get e.g. TikZ arrows.
       (str/replace #"stroke=['\"]#000['\"]" "stroke=\"currentColor\"")))
 
-(def ^:dynamic *save-snippets?* false)
-
 (defn render-snippets [snippet-promises]
-  (with-redefs [fs/delete-tree
-                (fn
-                  ([path]
-                   (l/warnf "refusing to delete %s" path))
-                  ([path opts]
-                   (lr/warnf "refusing to delete %s with opts %s"
-                             path opts)))]
   (fs/with-temp-dir [svg-dir {:prefix "doerg-svg-"}]
     (let [rendered-snippets
           (delay (->> snippet-promises
@@ -60,7 +51,7 @@
                     hiccup/raw (deliver p)))
              (catch Exception e
                (l/error e "Error in TeX thread")
-                 (throw e))))))))
+               (throw e)))))))
 
 (comment
   (let [snippets (for [x ["\\(\\ifxetex blah \\fi\\)"

doerg/test/net/deertopia/doerg/element_test.clj

@@ -11,7 +11,8 @@
 
 (defn- parse-resource [path]
   (-> (str "net/deertopia/doerg/element_test/" path)
-      io/resource slurp sut/read-string))
+      io/resource slurp
+      (sut/read-string)))
 
 (t/deftest known-greater-elements
   (t/testing "known greater elements satisfy `greater-element?`"
@@ -44,8 +45,71 @@
       true)))
 
 (t/deftest first-paragraph-under-first-section
-  (t/testing "first paragraph should belong to a section"
   (t/is (-> (parse-resource "first-paragraph-under-first-section.org")
-              first-paragraph-belongs-to-first-section?))
-    (t/is (not (-> (parse-resource "first-paragraph-under-heading.org")
-                   first-paragraph-belongs-to-first-section?)))))
+            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))))
+

doerg/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

doerg/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*}

doerg/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

doerg/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

doerg/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

doerg/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*}