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"]}

publisher/resources/net/deertopia/publisher/elisp/grammar

@@ -0,0 +1,30 @@
+<file> ::= elements
+
+<elements> ::= ws? element ws? elements
+            |  ws? ε
+
+<element> ::= 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
+
+<text> ::= ws? (string | property-string) ws?
+
+<ws> ::= <#'(\s||\n)'>+

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)

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))")))

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})}))