doerg/src/net/deertopia/doerg/config.clj

@@ -11,8 +11,7 @@
                 ::doerg-parser]))
 
 (s/def ::file
-  #(or (instance? java.io.File %)
-       (string? %)))
+  (s/conformer (comp fs/file fs/absolutize fs/expand-home)))
 
 (s/def ::executable #(or (fs/executable? %)
                          (and (fs/relative? %)

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

@@ -16,14 +16,22 @@
 
 (def ^:dynamic *worker*)
 
-(defn worker [& {:keys [preamble]}]
+(def ^:private prelude-file
+  (fs/create-temp-file {:prefix "doerg-prelude-"
+                        :suffix ".tex"}))
+
+(defn worker []
   (let [doerg-temml-worker (::cfg/doerg-temml-worker cfg/*cfg*)]
+    (when-not (fs/exists? prelude-file)
+      (-> "net/deertopia/doerg/prelude.tex"
+          io/resource
+          io/input-stream
+          (io/copy prelude-file)))
     (p/process
      {:shutdown p/destroy-tree
       :err (l/log-stream :info "temml/err")}
      doerg-temml-worker
-     "--preamble"
-     "resources/net/deertopia/doerg/prelude.tex")))
+     "--preamble" prelude-file)))
 
 (defn close-worker [tw]
   (.close (:in tw)))

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/cached_file.clj

@@ -0,0 +1,24 @@
+(ns net.deertopia.publisher.cached-file
+  (:require [babashka.fs :as fs]))
+
+(defn newer-than?
+  "Return `true` if fs `file₁` was last modified sooner or at the same
+  time as `file₂`, or if `file₂` does not exist."
+  [file₁ file₂]
+  (or (not (fs/exists? file₂))
+      (<= 0 (compare (fs/last-modified-time file₁)
+                     (fs/last-modified-time file₂)))))
+
+(def ^:dynamic *use-cache?*
+  "Bind to `false` to disable caching for debugging purposes."
+  true)
+
+(defn cached-file
+  "Return a file path after potentially regenerating the file by
+  calling `compute` with no arguments only if stale? is logical true."
+  [& {:keys [file stale? compute]}]
+  (when (or (not *use-cache?*) stale?)
+    (let [r (compute)]
+      (assert (string? r))
+      (spit file r)))
+  file)

publisher/src/net/deertopia/publisher/config.clj

@@ -0,0 +1,17 @@
+(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
+                ::org-roam-db-path]))
+
+(def default
+  {::state-directory (fs/xdg-state-home "doerg-publisher")
+   ::org-roam-db-path (fs/file (fs/home) ".cache" "emacs" "org-roam.db")})
+
+(def ^:dynamic *cfg* default)
+
+(s/def ::state-directory ::doerg/file)
+(s/def ::org-roam-db-path ::doerg/file)

publisher/src/net/deertopia/publisher/elisp.clj

@@ -0,0 +1,119 @@
+(ns net.deertopia.publisher.elisp
+  (:require
+   [clojure.core.match :refer [match]]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [instaparse.core :as ip]))
+
+(ip/defparser read*
+  (io/resource "net/deertopia/publisher/elisp/grammar"))
+
+(defn- transform-string [s]
+  (let [s* (loop [s (seq 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 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]
+  (let [r (->> s read*
+               (ip/transform
+                (merge transforms
+                       {:symbol (fn [s] (symbol s))
+                        :string (fn [s] s)}))
+               first)]
+    (match r
+      [:cons* pairs] (->> (for [pair pairs]
+                            (let [x (car pair)
+                                  y (cdr pair)]
+                              {x y}))
+                          (apply merge))
+      _ nil)))
+
+(defn read-string [s]
+  (match (-> s read first)
+    [:string x & props] x
+    :else nil))
+
+(defn print [x]
+  ;; TODO: this is really not how it should be done lol. at the
+  ;; moment, `print` is only used in `net.deertopia.publisher.roam`
+  ;; and only to serialise uuids, so it's not a /massive/ priority.
+  (cond (string? x) (str \" x \")
+        :else (throw (ex-info "`print` is unimplemented lol"
+                              {:x x}))))
+
+(comment
+  (do (ip/defparser parse* (io/resource "elisp-grammar"))
+      (read "#(\"blah\" 0 1 (doge))")
+      (read "\"bla\\nh\"")
+      (read-alist "((x . y))")))

publisher/src/net/deertopia/publisher/roam.clj

@@ -0,0 +1,170 @@
+(ns net.deertopia.publisher.roam
+  (:require [babashka.fs :as fs]
+            [net.deertopia.publisher.config :as cfg]
+            [net.deertopia.publisher.elisp :as elisp]
+            [net.deertopia.publisher.slug :as slug]
+            [next.jdbc :as sql])
+  (:import (java.util UUID)))
+
+
+;;; Global database
+
+(defonce ^:dynamic *use-db-cache?* true)
+
+(def db-path (-> cfg/*cfg* ::cfg/org-roam-db-path
+                 fs/expand-home str))
+
+(def db {:dbtype "sqlite"
+         :dbname db-path})
+
+(def ds (sql/get-datasource db))
+
+
+;;; Elisp sexp (de)serialisation
+
+(defn id [node]
+  (-> node :id))
+
+(defn slug [node]
+  (-> node :id slug/from-uuid))
+
+(defn- print-id [node]
+  (-> node id print))
+
+
+;;; 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 = ?"
+                     (-> node :id str elisp/print)])]
+       (-> r :nodes/file elisp/read-string)))))
+
+(defprotocol GetNode
+  (get-node [this]
+    "Return the node associated with `this` or nil."))
+
+(extend-protocol GetNode
+  String
+  (get-node [this]
+    (or (some-> this slug/from-string get-node)
+        (some-> this parse-uuid get-node)
+        (throw (IllegalArgumentException.
+                "Give `get-node` a UUID or slug string plz. }:)"))))
+  java.util.UUID
+  (get-node [this]
+    (make-node this))
+  net.deertopia.publisher.slug.Slug
+  (get-node [this]
+    (-> this slug/to-uuid make-node))
+  Node
+  (get-node [this]
+    this))
+
+(comment
+  (def node (get-node "68XqhHerTWCbE--RYLEdHw"))
+  (fetch-with-cache
+   node :title
+   #(do (println "fetch")
+        (sql/execute-one! ds ["select title from nodes where id = ?"
+                              (elisp/print (: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
+        elisp/read-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 = ?"
+                          (elisp/print (:id node))])
+        :let [id (elisp/read-string id)]
+        :when (graph-visible? (get-node (UUID/fromString id)))]
+    {:id id
+     :title (elisp/read-string title)}))
+
+
+;;; Graph support
+
+(defn- read-string-field [n field]
+  (-> n (get field) elisp/read-string))
+
+(defn- uuid-graph-visible? [uuid]
+  (-> uuid parse-uuid get-node graph-visible?))
+
+(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 (uuid-graph-visible? 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 (uuid-graph-visible? source)
+                             (uuid-graph-visible? target))]
+              {:source source
+               :target target})}))

publisher/src/net/deertopia/publisher/server.clj

@@ -4,11 +4,21 @@
             [hiccup2.core :as hiccup]
             [net.deertopia.doerg.html :as doerg-html]
             [net.deertopia.publisher.slug :as slug]
+            [net.deertopia.publisher.config :as cfg]
+            [net.deertopia.publisher.roam :as roam]
             [org.httpkit.server :as http]
             [reitit.coercion]
             [reitit.coercion.spec]
+            [reitit.ring.coercion]
+            [reitit.core :as r]
             [reitit.ring]
-            [ring.util.response :as response]))
+            [reitit.ring.middleware.exception :as reitit-exception]
+            [ring.util.response :as response]
+            [spec-tools.spell]
+            [reitit.spec]
+            [reitit.dev.pretty]
+            [clojure.spec.alpha :as s]
+            [net.deertopia.doerg.render :as doerg-render]))
 
 
 ;;; Routes
@@ -28,24 +38,41 @@
       response/response
       (response/content-type "text/html")))
 
-(defn node-by-slug [req]
-  (hello req))
+(defn node-by-slug [{{{:keys [slug]} :path} :parameters}]
+  (let [html (-> slug slug/from-string roam/get-node
+                 roam/org-file doerg-render/to-html)]
+    (-> html response/response
+        (response/content-type "text/html"))))
 
 (defn node-by-id [req]
   (hello req))
 
+(def exception-middleware
+  (reitit-exception/create-exception-middleware
+   (merge
+    reitit-exception/default-handlers
+    {::reitit-exception/wrap
+     (fn [handler e request]
+       (l/error e "error in fucking somwhere dude")
+       (handler e request))})))
+
 (def router
   (reitit.ring/router
    #{["/" {:get hello}]
-     ["/n/:slug" {:get node-by-slug
-                  #_#_#_#_:coercion reitit.coercion.spec/coercion
-                  :parameters {:path {:slug ::slug/slug}}}]
-     ["/id/:id" {:get node-by-id}]}
-   #_{:compile reitit.coercion/compile-request-coercers}))
-
-(defn match-by-path-and-coerce! [path]
-  (if-let [match (r/match-by-path router path)]
-    (assoc match :parameters (reitit.coercion/coerce! match))))
+     ["/n/:slug"
+      {:get {:handler #'node-by-slug
+             :parameters
+             {:path {:slug ::slug/slug}}}}]
+     ["/id/:id" {:get #'node-by-id}]}
+   {:validate reitit.spec/validate
+    :exception reitit.dev.pretty/exception
+    :spec (s/merge :reitit.spec/default-data)
+    :data
+    {:coercion reitit.coercion.spec/coercion
+     :middleware [exception-middleware
+                  reitit.ring.coercion/coerce-request-middleware
+                  reitit.ring.coercion/coerce-response-middleware
+                  #_reitit.ring.coercion/coerce-exceptions-middleware]}}))
 
 
 ;;; Server API

publisher/src/net/deertopia/publisher/slug.clj

@@ -1,5 +1,6 @@
 (ns net.deertopia.publisher.slug
-  (:require [clojure.spec.alpha :as s])
+  (:require [clojure.spec.alpha :as s]
+            [spec-tools.core :as st])
   (:import (java.nio ByteBuffer)
            (java.util Base64 UUID)))
 
@@ -12,11 +13,9 @@
   (try (let [decoder (Base64/getUrlDecoder)]
          (when (= 16 (count (.decode decoder s)))
            (Slug. s)))
-       (catch IllegalArgumentException e
-         (when (not= (ex-message e)
-                     (str "Input byte[] should at least "
-                          "have 2 bytes for base64 bytes"))
-           (throw e)))))
+       ;; really stupid
+       (catch IllegalArgumentException _
+         nil)))
 
 (defn to-string [s]
   (str s))
@@ -47,11 +46,11 @@
   (let [decoder (Base64/getUrlDecoder)]
     (bytes->uuid (.decode decoder (str slug)))))
 
-#_
-(let [uuid #uuid "f9eab66e-7773-4b87-b854-0bfc8f563809"
+(comment
+  (let [uuid #uuid "f9eab66e-7773-4b87-b854-0bfc8f563809"
         slug (from-uuid uuid)
         round-tripped (to-uuid slug)]
-  {:uuid uuid, :slug slug, :round-tripped round-tripped})
+    {:uuid uuid, :slug slug, :round-tripped round-tripped}))
 
 (defn make-slug [string]
   (assert (try (to-uuid string)
@@ -60,7 +59,6 @@
           "invalid slug")
   (->Slug string))
 
-(defn slug? [s]
-  (some? (from-string s)))
-
-(s/def ::slug slug?)
+(s/def ::slug
+  (s/conformer #(or (some-> % from-string)
+                    ::s/invalid)))