공사중: feat: backlinks

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

@@ -40,7 +40,7 @@
   #(do (assert (element/of-type? % "keyword"))
        (:key %)))
 
-(def ^:dynamic ^:private *document-info*)
+(def ^:dynamic ^:private *opts*)
 
 (declare ^:private gather-footnotes render-renderer-error
          view-children-as-seq render-tex-snippets)
@@ -63,23 +63,28 @@
 
 (defn org-document
   "Recursively render an Org-mode document to Hiccup."
-  [doc]
+  [doc & {:as opts :keys [postamble]}]
-  (tex-temml/binding-worker
+  (binding [*opts* opts]
-    (let [rendered (-> doc gather-footnotes render-tex-snippets
+    (tex-temml/binding-worker
-                       org-element-recursive)]
+      (let [rendered (-> doc gather-footnotes render-tex-snippets
-      [:html
+                         org-element-recursive)]
-       [:head
+        [:html
-        [:title "org document"]
+         [:head
-        doerg-html/head]
+          [:title "org document"]
-       [:body {:lang default-language}
+          doerg-html/head]
-        [:article
+         [:body {:lang default-language}
-         rendered]]])))
+          [:article
+           rendered
+           (when postamble
+             [:footer
+              [:hr]
+              postamble])]]]))))
 
 (defn to-html
   "Read `f` with `slurp` as an Org document and return a string of
-  rendered HTML."
+  rendered HTML.  See `org-document` for opts."
-  [f]
+  [f & {:as opts}]
-  (str (hiccup/html {} (-> f slurp element/read-string org-document))))
+  (str (hiccup/html {} (-> f slurp element/read-string (org-document opts)))))
 
 
 ;;; Further dispatching on `org-element`

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

@@ -108,7 +108,7 @@
   ;; 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 \")
+  (cond (or (string? x) (uuid? x)) (str \" x \")
         :else (throw (ex-info "`print` is unimplemented lol"
                               {:x x}))))
 

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

@@ -27,7 +27,7 @@
   (-> node :id slug/from-uuid))
 
 (defn- print-id [node]
-  (-> node id print))
+  (-> node id elisp/print))
 
 
 ;;; Node
@@ -39,9 +39,11 @@
                     ["select 1 from nodes where id = ? limit 1"
                      (-> uuid str elisp/print)]))
 
-(defn make-node [uuid]
+(defn make-node
-  (and (uuid-exists? uuid)
+  ([uuid] (make-node uuid {}))
-       (->Node uuid (atom {}))))
+  ([uuid props]
+   (and (uuid-exists? uuid)
+        (->Node uuid (atom props)))))
 
 (defn- fetch-with-cache [node field fetch]
   (if *use-db-cache?*
@@ -61,6 +63,15 @@
                      (-> node :id str elisp/print)])]
        (-> r :nodes/file elisp/read-string)))))
 
+(defn title [node]
+  (fetch-with-cache
+   node :title
+   #(when-some [r (sql/execute-one!
+                   (ds)
+                   ["select title from nodes where id = ?"
+                    (print-id %)])]
+      (-> r :nodes/title elisp/read-string))))
+
 (defprotocol GetNode
   (get-node [this]
     "Return the node associated with `this` or nil."))
@@ -130,18 +141,17 @@
    (-> node properties (get "DEERTOPIAVISIBILITY"))))
 
 (defn backlinks
-  "Returns a collection of maps {:id …, :title …}."
+  "Returns a collection of nodes linking to `node`."
   [node]
-  (for [{id :nodes/id, title :nodes/title}
+  (for [{id :nodes/id title :nodes/title}
         (sql/execute! (ds) ["select distinct nodes.id, nodes.title from links
-                           inner join nodes
+                             inner join nodes
-                           on nodes.id = links.source
+                             on nodes.id = links.source
-                           where links.dest = ?"
+                             where links.dest = ?"
-                          (elisp/print (:id node))])
+                            (elisp/print (str (:id node)))])
-        :let [id (elisp/read-string id)]
+        :let [id' (elisp/read-string id)]
-        :when (graph-visible? (get-node (UUID/fromString id)))]
+        :when (-> id' parse-uuid get-node public?)]
-    {:id id
+    (make-node id' {:title (elisp/read-string title)})))
-     :title (elisp/read-string title)}))
 
 
 ;;; Graph support

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

@@ -61,12 +61,27 @@
                (fs/strip-ext {:ext "org"})
                (str ".html"))))
 
+(defn slug-link [slug & contents]
+  [:a {:href (str "/n/" slug)}
+   contents])
+
 (defmethod doerg-render/org-link "id"
   [{:keys [path raw-link children]}]
   [:span.org-link
-   [:a {:href (str "/n/" (slug/from-uuid path))}
+   (slug-link (slug/from-uuid path)
+              (or (seq children) raw-link))
+   #_[:a {:href (str "/n/" (slug/from-uuid path))}
     (or (seq children) raw-link)]])
 
+(defn backlinks-postamble [node]
+  [:section#backlinks
+   [:h2 "Backlinks"]
+   [:ul
+    (for [n (->> (roam/backlinks node)
+                 (sort-by (comp str/lower-case roam/title)))]
+      [:li (slug-link (roam/slug n)
+                      (roam/title n))])]])
+
 (defn node-by-slug [{{:keys [slug]} :path-params :as req}]
   (if-some [node (some-> slug slug/from-string roam/get-node)]
     (let [org-file (roam/org-file node)
@@ -74,7 +89,9 @@
       (cached-file/cached-file
        :file html-file
        :stale? (cached-file/newer-than? org-file html-file)
-       :compute #(doerg-render/to-html org-file))
+       :compute #(doerg-render/to-html
+                  org-file
+                  :postamble (backlinks-postamble node)))
       (-> (str html-file)
           response/file-response
           (response/content-type "text/html")))