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/src/net/deertopia/doerg/element.clj

@@ -1,21 +1,26 @@
 (ns net.deertopia.doerg.element
-  (:require [babashka.process :as p]
+  (:refer-clojure :exclude [read-string type])
-            [net.deertopia.doerg.common :as common]
+  (:require
-            [clojure.string :as str]
-            [clojure.zip]
    [babashka.fs :as fs]
-            [clojure.java.io :as io]
+   [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]]
+   [clojure.string :as str]
-            [net.deertopia.doerg.config :as cfg]
+   [clojure.test.check.generators :as gen]
-            [com.rpl.specter :as sp]
    [clojure.tools.logging.readable :as lr]
    [clojure.zip :as z]
+   [com.rpl.specter :as sp]
    [com.rpl.specter.zipper :as sz]
-            [clojure.core.match :refer [match]])
+   [net.deertopia.doerg.common :as common]
-  (:import (java.util UUID))
+   [net.deertopia.doerg.config :as cfg]
-  (:refer-clojure :exclude [read-string]))
+   [spec-dict.main :refer [dict]]
+   [clojure.tools.logging :as l])
+  (:import
+   (java.util UUID)))
+
 
 
 (def ^:dynamic *uniorg-timeout-duration*
@@ -37,7 +42,7 @@
     (if (zero? (:exit r))
       (-> r :out (json/parse-string (comp keyword camel->kebab))))))
 
-(declare gather-first-section gather-latex-paragraphs)
+(declare gather-first-section gather-latex-paragraphs element-types)
 
 (defn read-string
   [s & {:keys [post-processors]
@@ -65,6 +70,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
@@ -280,3 +288,125 @@
               [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" "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 object-types)
+(s/def ::recursive-object-type recursive-object-types)
+
+(s/def ::contents-begin nat-int?)
+(s/def ::contents-end nat-int?)
+
+(defmulti object-spec :type)
+(defmulti recursive-object-spec :type)
+(defmulti element-spec :type)
+(defmulti greater-element-spec :type)
+
+(defn- unimplemented-spec [x]
+  (lr/warnf "unimplemented method for %s" (:type x))
+  any?)
+
+(defmethod object-spec :default [x] (unimplemented-spec x))
+(defmethod recursive-object-spec :default [x] (unimplemented-spec x))
+(defmethod greater-element-spec :default [x] (unimplemented-spec x))
+(defmethod element-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 (constantly true)
+    (constantly (gen/return {}))))
+
+(s/def ::object
+  (s/multi-spec object-spec :type))
+
+(s/def ::element
+  (s/merge (dict ^:opt {:contents-begin ::contents-begin
+                        :contents-end ::contents-end}
+                 {:children (s/coll-of ::object :kind vector?)})
+           (s/multi-spec element-spec :type)))
+
+(s/def ::greater-element
+  (s/merge (dict {:contents-begin ::contents-begin
+                  :contents-end ::contents-end
+                  :children (s/coll-of
+                             (s/or :element ::element
+                                   :greater-element ::greater-element)
+                             :kind vector?)})
+           (s/multi-spec greater-element-spec :type)))
+
+(s/def ::recursive-object-base
+  (dict ^:opt {:contents-begin ::contents-begin
+               :contents-end ::contents-end}
+        {:children (s/coll-of ::object-base :kind vector?)}))
+
+(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 objects)
+
+(def ^:private string-value (dict {:value string?}))
+
+(defmethod object-spec "text" [_] string-value)
+(defmethod object-spec "verbatim" [_] string-value)
+(defmethod object-spec "code" [_] string-value)
+(defmethod recursive-object-spec "bold" [_] nfe)
+(defmethod recursive-object-spec "italic" [_] nfe)
+
+
+;;; Specs (specific elements)
+
+(defmethod element-spec "headline" [_]
+  (dict {:todo-keyword (s/nilable ::todo-keyword)
+         :priority (s/nilable ::priority)
+         :level ::level
+         :commented ::commented
+         :raw-value string?
+         :tags ::tags}))
+
+
+;;; Specs (specific greater elements)
+
+(defmethod greater-element-spec "org-data" [_] nfe)
+
+(defmethod greater-element-spec "section" [_] nfe)

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

@@ -57,28 +57,31 @@
   ())
 
 (defn- paragraph-ends-with-latex? [doc]
-  (-> (sp/select-first [(walk-types "paragraph")
+  (let [type (-> (sp/select-first [(walk-types "paragraph")
                                    (sp/must :children)
                                    sp/LAST]
                                   doc)
-      (sut/of-type? "latex-environment")))
+                 sut/type)]
+    (t/is type "latex-environment")))
 
 (defn- paragraph-has-latex? [doc]
-  (sp/select-first [(walk-types "paragraph")
+  (t/is (sp/select-first [(walk-types "paragraph")
                           (sp/must :children)
                           sp/ALL
                           #(sut/of-type? % "latex-environment")]
-                   doc))
+                         doc)))
 
 (defn- paragraph-has-multiple-latex? [doc]
-  (let [[interleaved fenceposted]
+  (let [paragraphs (sp/select (walk-types "paragraph") doc)]
-        (sp/select [(walk-types "section")
+    (t/is (= 2 (count paragraphs)))
-                    (sp/must :children)
+    (let [[p₁ p₂] paragraphs]
-                    #(some-> % first (sut/of-type? "headline"))
+      (t/are [p ts] (= ts
-                    (sp/subselect (sp/view #(drop 1 %))
+                       (sp/select [(sp/must :children)
-                                  sp/ALL (sp/must :children) sp/ALL
+                                   sp/ALL (sp/view sut/type)] p))
-                                  (sp/must :type))]
+        p₁ ["text" "latex-environment"
-                   doc)]))
+            "text" "latex-environment"]
+        p₂ ["text" "latex-environment"
+            "text" "latex-environment" "text"]))))
 
 (t/deftest paragraph-separation
   (t/testing "paragraph ending with latex"
@@ -88,5 +91,5 @@
     (-> (parse-resource "paragraph-surrounding-latex.org")
         paragraph-has-latex?))
   (t/testing "paragraph with interleaved latex"
-    (let [(parse-resource "paragraph-with-multiple-latex.org")])
+    (-> (parse-resource "paragraph-with-multiple-latex.org")
-    (t/is (-))))
+        paragraph-has-multiple-latex?)))