From 10bfc1145d8fbf3af9dd8402d84bda1505a834fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sat, 21 Mar 2026 18:08:45 -0600 Subject: [PATCH] --- publisher/deps.edn | 4 +- .../net/deertopia/publisher/elisp/grammar | 30 +++ .../src/net/deertopia/publisher/config.clj | 14 ++ .../src/net/deertopia/publisher/elisp.clj | 101 ++++++++++ .../src/net/deertopia/publisher/node.clj | 173 ++++++++++++++++++ 5 files changed, 320 insertions(+), 2 deletions(-) create mode 100644 publisher/resources/net/deertopia/publisher/elisp/grammar create mode 100644 publisher/src/net/deertopia/publisher/config.clj create mode 100644 publisher/src/net/deertopia/publisher/elisp.clj create mode 100644 publisher/src/net/deertopia/publisher/node.clj diff --git a/publisher/deps.edn b/publisher/deps.edn index 92c77da..1bbb4e8 100644 --- a/publisher/deps.edn +++ b/publisher/deps.edn @@ -7,9 +7,9 @@ com.github.seancorfield/next.jdbc {:mvn/version "1.3.1070"} org.xerial/sqlite-jdbc {:mvn/version "3.47.1.0"} cheshire/cheshire {:mvn/version "6.1.0"} - instaparse/instaparse {:mvn/version "1.5.0"} org.clojure/test.check {:mvn/version "1.1.2"} net.deertopia/doerg {:local/root "../doerg"} metosin/reitit {:mvn/version "0.10.1"} - http-kit/http-kit {:mvn/version "2.8.0"}} + http-kit/http-kit {:mvn/version "2.8.0"} + instaparse/instaparse {:mvn/version "1.5.0"}} :paths ["src" "resources" "test"]} diff --git a/publisher/resources/net/deertopia/publisher/elisp/grammar b/publisher/resources/net/deertopia/publisher/elisp/grammar new file mode 100644 index 0000000..6d8595c --- /dev/null +++ b/publisher/resources/net/deertopia/publisher/elisp/grammar @@ -0,0 +1,30 @@ + ::= elements + + ::= ws? element ws? elements + | ws? ε + + ::= string + | list + | symbol + | integer + | property-string + +string ::= <'"'> #'([^"\\]|\\.|\\\n)*' <'"'> + +property-string + ::= <'#('> ws? string text-property* ws? <')'> + +text-property ::= ws? element ws? element ws? element + +list ::= <'('> elements dot-cdr? <')'> + +symbol ::= #'([^?#0-9 \n\s\f()\[\]"\'\\.]|\\.)([^ \n\s\f()\[\]"\'\\]|\\.)*' + | #'\.([^ \n\s\f()\[\]"\'\\]|\\.)+' + +integer ::= #'[-+]?[0-9]+' <#'.'>? + +dot-cdr ::= <'.'> ws? element + + ::= ws? (string | property-string) ws? + + ::= <#'(\s| |\n)'>+ diff --git a/publisher/src/net/deertopia/publisher/config.clj b/publisher/src/net/deertopia/publisher/config.clj new file mode 100644 index 0000000..18af668 --- /dev/null +++ b/publisher/src/net/deertopia/publisher/config.clj @@ -0,0 +1,14 @@ +(ns net.deertopia.publisher.config + (:require [babashka.fs :as fs] + [clojure.spec.alpha :as s] + [net.deertopia.doerg.config :as doerg])) + +(s/def ::config + (s/keys :req [::state-directory])) + +(def default + {::state-directory (fs/xdg-state-home "doerg-publisher")}) + +(def ^:dynamic *cfg* default) + +(s/def ::state-directory ::doerg/file) diff --git a/publisher/src/net/deertopia/publisher/elisp.clj b/publisher/src/net/deertopia/publisher/elisp.clj new file mode 100644 index 0000000..6fff305 --- /dev/null +++ b/publisher/src/net/deertopia/publisher/elisp.clj @@ -0,0 +1,101 @@ +(ns net.deertopia.publisher.elisp + (:require [instaparse.core :as ip] + [clojure.java.io :as io] + [clojure.core.match :refer [match]] + [clojure.spec.alpha :as s])) + +(ip/defparser read* + (io/resource "net/deertopia/publisher/elisp/grammar")) + +(defn- transform-string [s] + (letfn [(go [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 (go (seq 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] + (match (->> (read* s) + (ip/transform (merge transforms + {:symbol (fn [s] (symbol s)) + :string (fn [s] s)})) + first) + [:cons* pairs] (->> (for [pair pairs] + (let [x (car pair) + y (cdr pair)] + {x y})) + (apply merge)) + _ nil)) + +(comment + (do (ip/defparser parse* (io/resource "elisp-grammar")) + (parse "#(\"blah\" 0 1 (doge))") + (read-alist "((x . y))"))) diff --git a/publisher/src/net/deertopia/publisher/node.clj b/publisher/src/net/deertopia/publisher/node.clj new file mode 100644 index 0000000..7e8d78d --- /dev/null +++ b/publisher/src/net/deertopia/publisher/node.clj @@ -0,0 +1,173 @@ +(ns net.deertopia.publisher.node + (:require [next.jdbc :as sql] + [net.deertopia.publisher.config :as cfg] + [net.deertopia.publisher.slug :as slug] + [babashka.fs :as fs] + [elisp.instaparse :as elisp]) + (:import (java.util UUID))) + +;;; Global database + +(defonce ^:dynamic *use-db-cache?* true) + +(def db-path (-> (cfg/get :org-roam :database) + fs/expand-home str)) + +(def db {:dbtype "sqlite" + :dbname db-path}) + +(def ds (sql/get-datasource db)) + + +;;; Elisp sexp (de)serialisation + +(defn- read-elisp-string [s] + (let [[_ in] (re-matches #"\"(.*)\"" s)] + in)) + +(defn- print-elisp-string [s] + (str \" s \")) + +(defn id [node] + (-> node :id)) + +(defn slug [node] + (-> node :id slug/from-uuid)) + +(defn- print-id [node] + (-> node id print-elisp-string)) + + +;;; Node + +(defrecord Node [id cache]) + +(defn make-node [uuid] + (->Node uuid (atom {}))) + +(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 = ?" + (print-elisp-string (:id node))])] + (-> r :nodes/file read-elisp-string))))) + +(defprotocol GetNode + (get-node [this] + "Return the node associated with `this` or nil.")) + +(extend-protocol GetNode + java.util.UUID + (get-node [this] + (make-node this)) + net.deertopia.publish.slug.Slug + (get-node [this] + (-> this slug/to-uuid make-node))) + +(comment + (let [n (make-node (slug/to-uuid (slug/->Slug "68XqhHerTWCbE--RYLEdHw")))] + (fetch-with-cache + n :title + #(do (println "fetch") + (sql/execute-one! ds ["select title from nodes where id = ?" + (print-elisp-string (: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 + read-elisp-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 maps {:id …, :title …}." + [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 = ?" + (print-elisp-string (:id node))]) + :let [id (read-elisp-string id)] + :when (graph-visible? (get-node (UUID/fromString id)))] + {:id id + :title (read-elisp-string title)})) + +(defn parent-node [node] + ) + + +;;; Graph support + +#_ +(defn- make-node [node] + {:id (-> node :nodes/id read-elisp-string) + :title (-> node :nodes/title read-elisp-string)}) + +(defn- read-string-field [n field] + (-> n (get field) read-elisp-string)) + +(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 (graph-visible? (get-node (UUID/fromString 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 (graph-visible? (get-node (UUID/fromString source))) + (graph-visible? (get-node (UUID/fromString target))))] + {:source source + :target target})}))