feat: html 캐시
All checks were successful
build / build (push) Successful in 4s

This commit was merged in pull request #27.
This commit is contained in:
2026-03-24 17:49:50 -06:00
parent e02b77e1e4
commit 9cc0def4d5
21 changed files with 247 additions and 100 deletions

View File

@@ -4,10 +4,8 @@
:latex "xelatex"
:dvisvgm "dvisvgm"
:doerg-temml-worker
#profile {:dev-publisher "../doerg/doerg-temml-worker/index.js"
:dev-doerg "./doerg-temml-worker/index.js"
#profile {:dev #file "../../../../doerg-temml-worker/index.js"
:default "doerg-temml-worker"}
:doerg-parser
#profile {:dev-publisher "../doerg/doerg-parser/index.js"
:dev-doerg "./doerg-parser/index.js"
#profile {:dev #file "../../../../doerg-parser/index.js"
:default "doerg-parser"}}

Binary file not shown.

After

Width:  |  Height:  |  Size: 66 KiB

View File

@@ -0,0 +1 @@
../Temml-Plex.css

View File

@@ -0,0 +1 @@
../deerstar.css

View File

@@ -0,0 +1 @@
../tuftesque.css

View File

@@ -45,29 +45,35 @@
(and (fs/exists? x) x))
(fs/split-paths (System/getenv "XDG_DATA_DIRS"))))
(defn make-read-config [spec]
(fn [& files]
(let [r (->> files
(filter identity)
(map aero/read-config)
(apply merge))
conformed (s/conform spec r)]
(if-not (s/invalid? conformed)
conformed
(throw (IllegalArgumentException.
"bad config"
(ex-info "couldn't conform"
(s/explain-data spec r))))))))
(defmethod aero/reader 'file
[{:keys [source]} tag value]
"Aero tag to reference a `java.io.File` relative to the config
file."
(-> (aero/relative-resolver source value)
fs/file))
(def read-config (make-read-config ::d/config))
(defn read-config [spec files & {:as opts}]
(let [r (->> files
(filter identity)
(map #(aero/read-config % opts))
(apply merge))
conformed (s/conform spec r)]
(if-not (s/invalid? conformed)
conformed
(throw (ex-info "Failed to conform config"
(s/explain-data spec r))))))
(def default
(read-config
;; Default config.
(defn load-config! [var spec files & {:as opts}]
(alter-var-root var (constantly (read-config spec files opts))))
(def sources
[;; Default config.
(io/resource "net/deertopia/doerg/default-config.edn")
;; Defaults set at build time, if any.
(io/resource "net/deertopia/doerg/extra-config.edn")
;; Config set at runtime.
(System/getenv "DOERG_CONFIG")))
(System/getenv "DOERG_CONFIG")])
(def default (read-config ::d/config sources))
(def ^:dynamic *cfg* default)

View File

@@ -27,7 +27,7 @@
[:meta {:charset "utf-8"}])
(defn external-stylesheet [href]
[:link {:rel "stylesheet" :type "text/css" :href href}])
[:link {:rel "stylesheet" :type "text/css" :href (str "/resource/" href)}])
(def ibm-plex
(concat

View File

@@ -179,7 +179,7 @@
(defn- render-pprint
(defn render-pprint
"Render the argument inline as `clojure.pprint/pprint` output."
[x & {:keys [text]
:or {text "debug!"}}]

View File

@@ -31,17 +31,17 @@
(defn render-html [& {:keys [src dest]
:or {src some-org-file
dest "/tmp/doerg-test"}}]
(fs/create-dirs dest)
(force-create-sym-link (fs/file dest "ibm-plex-web")
(-> cfg/*cfg* ::doerg/ibm-plex-web))
(force-create-sym-link (fs/file dest "deerstar.css")
(io/resource "net/deertopia/doerg/deerstar.css"))
(force-create-sym-link (fs/file dest "tuftesque.css")
(io/resource "net/deertopia/doerg/tuftesque.css"))
(force-create-sym-link (fs/file dest "Temml-Plex.css")
(io/resource "net/deertopia/doerg/Temml-Plex.css"))
(fs/delete-if-exists (fs/file dest "index.html"))
(->> src render/to-html str (spit (fs/file dest "index.html"))))
(let [resource-dir (fs/file dest "resource")]
(fs/create-dirs dest)
(fs/create-dirs resource-dir)
(force-create-sym-link (fs/file resource-dir "ibm-plex-web")
(-> cfg/*cfg* ::doerg/ibm-plex-web))
(doseq [x #{"Temml-Plex.css" "tuftesque.css" "deerstar.css"}]
(force-create-sym-link
(fs/file resource-dir x)
(io/resource (str "net/deertopia/doerg/" x))))
(fs/delete-if-exists (fs/file dest "index.html"))
(->> src render/to-html str (spit (fs/file dest "index.html")))))
(defn render-edn [& {:keys [src dest]
:or {src some-org-file

View File

@@ -1,11 +1,12 @@
((nil
. ((cider-clojure-cli-aliases . ":dev")
(eval
. (progn
(defun start-deertopia-server ()
(let ((n (cider-format-connection-params "%j" cider-launch-params)))
(when (equal n "net-deertopia")
(cider-interactive-eval
"(do (require '[net.deertopia.publisher.server :as server])
(server/start!))"))))
(add-hook 'cider-connected-hook #'start-deertopia-server))))))
. ((cider-clojure-cli-aliases . ":dev:test")
;; (eval
;; . (progn
;; (defun start-deertopia-server ()
;; (let ((n (cider-format-connection-params "%j" cider-launch-params)))
;; (when (equal n "net-deertopia")
;; (cider-interactive-eval
;; "(do (require '[net.deertopia.publisher.server :as server])
;; (server/start!))"))))
;; (add-hook 'cider-connected-hook #'start-deertopia-server)))
)))

View File

@@ -17,4 +17,5 @@
:aliases
{:test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}
:extra-paths ["test"]
:main-opts ["-m" "kaocha.runner"]}}}
:main-opts ["-m" "kaocha.runner"]}
:dev {:extra-paths ["dev"]}}}

24
publisher/dev/user.clj Normal file
View File

@@ -0,0 +1,24 @@
(ns user
(:require [net.deertopia.publisher.server :as server]
[net.deertopia.doerg :as-alias doerg]
[net.deertopia.publisher :as-alias publisher]
[net.deertopia.doerg.config :as doerg-config]
[net.deertopia.publisher.config :as publisher-config]
[babashka.fs :as fs]))
(doerg-config/load-config! #'doerg-config/*cfg*
::doerg/config
doerg-config/sources
:profile :dev)
(doerg-config/load-config! #'publisher-config/*cfg*
::publisher/config
publisher-config/sources
:profile :dev)
(when (not= :running (server/status))
(server/start!))
(defn invalidate-html-cache! []
(fs/delete-tree (server/html-dir))
nil)

View File

@@ -2,5 +2,7 @@
{:state-directory #join [#or [#env XDG_STATE_HOME
#envf ["%s/.local/share" HOME]]
"/doerg-publisher"]
:org-roam-db-path #join [#env HOME "/.cache/emacs/org-roam.db"]
:port 8080}
:org-roam-db-path
#profile {:default #join [#env HOME "/.cache/emacs/org-roam.db"]
:test #file "../../../../test/net/deertopia/publisher/roam-test.db"}
:port #profile {:default 8080}}

View File

@@ -20,5 +20,6 @@
(when (or (not *use-cache?*) stale?)
(let [r (compute)]
(assert (string? r))
(fs/create-dirs (fs/parent file))
(spit file r)))
file)

View File

@@ -14,15 +14,15 @@
(s/def ::p/state-directory ::doerg/file)
(s/def ::p/org-roam-db-path ::doerg/file)
(def read-config (doerg-config/make-read-config ::p/config))
(def default
(read-config
;; Default config.
(def sources
[;; Default config.
(io/resource "net/deertopia/publisher/default-config.edn")
;; Defaults set at build time, if any.
(io/resource "net/deertopia/publisher/extra-config.edn")
;; Config set at runtime.
(System/getenv "DOERG_PUBLISHER_CONFIG")))
(System/getenv "DOERG_PUBLISHER_CONFIG")])
(def default
(doerg-config/read-config ::p/config sources))
(def ^:dynamic *cfg* default)

View File

@@ -12,13 +12,10 @@
(defonce ^:dynamic *use-db-cache?* true)
(def db-path (-> cfg/*cfg* ::publisher/org-roam-db-path
fs/expand-home str))
(def db {:dbtype "sqlite"
:dbname db-path})
(def ds (sql/get-datasource db))
(defn- ds []
(sql/get-datasource
{:dbtype "sqlite"
:dbname (-> cfg/*cfg* ::publisher/org-roam-db-path str)}))
;;; Elisp sexp (de)serialisation
@@ -37,8 +34,14 @@
(defrecord Node [id cache])
(defn- uuid-exists? [uuid]
(sql/execute-one! (ds)
["select 1 from nodes where id = ? limit 1"
(-> uuid str elisp/print)]))
(defn make-node [uuid]
(->Node uuid (atom {})))
(and (uuid-exists? uuid)
(->Node uuid (atom {}))))
(defn- fetch-with-cache [node field fetch]
(if *use-db-cache?*
@@ -53,7 +56,7 @@
node :org-file
(fn [node]
(when-some [r (sql/execute-one!
ds
(ds)
["select file from nodes where id = ?"
(-> node :id str elisp/print)])]
(-> r :nodes/file elisp/read-string)))))
@@ -84,7 +87,7 @@
(fetch-with-cache
node :title
#(do (println "fetch")
(sql/execute-one! ds ["select title from nodes where id = ?"
(sql/execute-one! (ds) ["select title from nodes where id = ?"
(elisp/print (:id %))]))))
@@ -94,7 +97,7 @@
(fetch-with-cache
node :level
#(-> (sql/execute-one!
ds ["select level from nodes where id = ?"
(ds) ["select level from nodes where id = ?"
(print-id %)])
:nodes/level)))
@@ -105,7 +108,7 @@
(fetch-with-cache
node :file
#(-> (sql/execute-one!
ds ["select file from nodes where id = ?"
(ds) ["select file from nodes where id = ?"
(print-id %)])
:nodes/file
elisp/read-string)))
@@ -114,7 +117,7 @@
(fetch-with-cache
node :properties
#(-> (sql/execute-one!
ds ["select properties from nodes where id = ?"
(ds) ["select properties from nodes where id = ?"
(print-id %)])
:nodes/properties
elisp/read-alist)))
@@ -130,7 +133,7 @@
"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
(sql/execute! (ds) ["select distinct nodes.id, nodes.title from links
inner join nodes
on nodes.id = links.source
where links.dest = ?"
@@ -150,9 +153,9 @@
(-> uuid parse-uuid get-node graph-visible?))
(defn get-graph []
(let [nodes (sql/execute! ds ["select id, title from nodes"])
(let [nodes (sql/execute! (ds) ["select id, title from nodes"])
links (sql/execute!
ds
(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

View File

@@ -22,11 +22,17 @@
[net.deertopia.doerg.render :as doerg-render]
[net.deertopia.publisher.cached-file :as cached-file]
[babashka.fs :as fs]
[aero.core :as aero]))
[aero.core :as aero]
[clojure.string :as str]
[net.deertopia.doerg :as-alias doerg]
[net.deertopia.doerg.config :as doerg-config]))
;;; Routes
(def homepage-slug "68XqhHerTWCbE--RYLEdHw")
(def not-found-slug "PGDHTvUzQ62Js1Y5db-A8g")
(defn hello [req]
(-> (hiccup/html {}
[:html
@@ -42,11 +48,37 @@
response/response
(response/content-type "text/html")))
(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 html-dir []
(-> cfg/*cfg* ::publisher/state-directory (fs/file "html")))
(defn not-found [req]
(response/not-found "not found"))
(defn org-file->html-file [org-file]
(fs/file (html-dir)
(-> org-file
fs/file-name
(fs/strip-ext {:ext "org"})
(str ".html"))))
(defmethod doerg-render/org-link "id"
[{:keys [path raw-link children]}]
[:span.org-link
[:a {:href (str "/n/" (slug/from-uuid path))}
(or (seq children) raw-link)]])
(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)
html-file (org-file->html-file org-file)]
(cached-file/cached-file
:file html-file
:stale? (cached-file/newer-than? org-file html-file)
:compute #(doerg-render/to-html org-file))
(-> (str html-file)
response/file-response
(response/content-type "text/html")))
(not-found req)))
(defn node-by-id [req]
(hello req))
@@ -60,17 +92,39 @@
(l/error e "error in fucking somwhere dude")
(handler e request))})))
(defn handle-homepage [req]
(-> req
(assoc-in [:path-params :slug] homepage-slug)
node-by-slug))
(def doerg-resources
#{"Temml-Plex.css" "tuftesque.css" "deerstar.css"})
(defn handle-resource [{:keys [uri]}]
(if-some [[_ resource] (re-matches #"^/resource/ibm-plex-web/(.*)" uri)]
(-> resource
(response/file-response
{:root (-> doerg-config/*cfg* ::doerg/ibm-plex-web str)}))
(-> uri
(str/replace-first #"^/resource/" "")
(response/resource-response
{:root "net/deertopia/doerg/public"
:allow-symlinks? true}))))
(defn handle-favicon [_]
(response/resource-response "net/deertopia/doerg/favicon.ico"))
(def router
(reitit.ring/router
#{["/" {:get hello}]
["/n/:slug"
{:get {:handler #'node-by-slug
:parameters
{:path {:slug ::slug/slug}}}}]
["/id/:id" {:get #'node-by-id}]}
#{["/" #'handle-homepage]
["/n/:slug" #'node-by-slug]
["/id/:id" #'node-by-id]
["/resource/*" #'handle-resource]
["/myreq" #'hello]
["/favicon.ico" #'handle-favicon]}
{:validate reitit.spec/validate
:exception reitit.dev.pretty/exception
:spec (s/merge :reitit.spec/default-data)
:spec :reitit.spec/default-data
:data
{:coercion reitit.coercion.spec/coercion
:middleware [exception-middleware

Binary file not shown.

View File

@@ -0,0 +1,7 @@
:PROPERTIES:
:ID: 23ee464d-b13e-4649-826f-622d0edef24e
:DeertopiaVisibility: public
:END:
#+title: awesome file
wow!

View File

@@ -0,0 +1,6 @@
:PROPERTIES:
:ID: ebc5ea84-77ab-4d60-9b13-ef9160b11d1f
:END:
#+title: deertopia.net!!!!!!!!
homeee

View File

@@ -2,23 +2,64 @@
(:require [net.deertopia.publisher.server :as sut]
[reitit.ring]
[clojure.test :as t]
[clojure.set :as set]
[net.deertopia.publisher.server :as server]
[net.deertopia.publisher.config :as cfg]
[net.deertopia.publisher :as-alias publisher]))
[net.deertopia.publisher.config :as publisher-cfg]
[net.deertopia.doerg.config :as doerg-cfg]
[net.deertopia.publisher :as-alias publisher]
[net.deertopia.doerg :as-alias doerg]
[net.deertopia.publisher.roam :as roam]))
(defn config-fixture [f]
(binding [doerg-cfg/*cfg*
(doerg-cfg/read-config
::doerg/config doerg-cfg/sources
:profile :test)
publisher-cfg/*cfg*
(doerg-cfg/read-config
::publisher/config publisher-cfg/sources
:profile :test)]
(f)))
(t/use-fixtures
:once config-fixture)
(defn with-server [f]
(let [was-already-running? (= :running (sut/status))]
(when-not was-already-running?
(sut/start!))
(f)
(when-not was-already-running?
(sut/stop!))))
(defn get-sut [uri]
(sut/app {:request-method :get
:uri uri}))
(t/deftest server-is-running
;; 서버 벌써 시작한 다음에 이 테스트 하면 잘못됩니다.
(assert (not= :running (server/status)))
(server/start!)
(t/is (= :running (server/status)))
(server/stop!))
;; 서버 벌써 시작한 다음에 이 테스트 하면 잘못됩니다.
;; (assert (not= :running (sut/status)))
(with-server
(fn []
(t/is (= :running (sut/status)))
;; 테스트 데이터베이스를 아직 안 준비한다.
#_(t/is (->> (format "http://localhost:%d"
(::publisher/port publisher-cfg/*cfg*))
slurp
string?)))))
(t/deftest can-get-real-server-root
;; 서버가 벌써 시작한 다음에 이 테스트 하면 잘못됩니다.
(assert (not= :running (server/status)))
(server/start!)
(t/is (->> (format "http://localhost:%d" (::publisher/port cfg/*cfg*))
slurp
string?))
(server/stop!))
(comment
;; 테스트 데이터베이스를 아직 안 준비한다.
(t/deftest get-nonexistent-node
(let [slug "3Lxvxnb0QrivoU3DX-l_5w"]
(assert (nil? (roam/make-node slug)))
(t/is (= 404
(-> (str "/n/" slug)
get-sut :status))))))
(comment
;; 테스트 데이터베이스를 아직 안 준비한다.
(t/deftest get-homepage
(let [resp (-> (str "/n/" sut/homepage-slug)
get-sut)]
(t/is (= 200 (:status resp)))
(t/is (= (-> "/" get-sut :body)
(-> resp :body))))))