This commit was merged in pull request #36.
This commit is contained in:
@@ -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]
|
||||
(tex-temml/binding-worker
|
||||
(let [rendered (-> doc gather-footnotes render-tex-snippets
|
||||
org-element-recursive)]
|
||||
[:html
|
||||
[:head
|
||||
[:title "org document"]
|
||||
doerg-html/head]
|
||||
[:body {:lang default-language}
|
||||
[:article
|
||||
rendered]]])))
|
||||
[doc & {:as opts :keys [postamble]}]
|
||||
(binding [*opts* opts]
|
||||
(tex-temml/binding-worker
|
||||
(let [rendered (-> doc gather-footnotes render-tex-snippets
|
||||
org-element-recursive)]
|
||||
[:html
|
||||
[:head
|
||||
[:title "org document"]
|
||||
doerg-html/head]
|
||||
[:body {:lang default-language}
|
||||
[: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."
|
||||
[f]
|
||||
(str (hiccup/html {} (-> f slurp element/read-string org-document))))
|
||||
rendered HTML. See `org-document` for opts."
|
||||
[f & {:as opts}]
|
||||
(str (hiccup/html {} (-> f slurp element/read-string (org-document opts)))))
|
||||
|
||||
|
||||
;;; Further dispatching on `org-element`
|
||||
|
||||
@@ -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}))))
|
||||
|
||||
|
||||
@@ -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]
|
||||
(and (uuid-exists? uuid)
|
||||
(->Node uuid (atom {}))))
|
||||
(defn make-node
|
||||
([uuid] (make-node uuid {}))
|
||||
([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
|
||||
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)}))
|
||||
inner join nodes
|
||||
on nodes.id = links.source
|
||||
where links.dest = ?"
|
||||
(elisp/print (str (:id node)))])
|
||||
:let [id' (elisp/read-string id)]
|
||||
:when (-> id' parse-uuid get-node public?)]
|
||||
(make-node id' {:title (elisp/read-string title)})))
|
||||
|
||||
|
||||
;;; Graph support
|
||||
|
||||
@@ -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")))
|
||||
|
||||
Reference in New Issue
Block a user