feat: html 캐시

publisher/.dir-locals.el

@@ -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)))
+     )))

publisher/deps.edn

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

publisher/dev/user.clj

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

publisher/resources/net/deertopia/publisher/default-config.edn

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

publisher/src/net/deertopia/publisher/cached_file.clj

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

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

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

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

@@ -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

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

@@ -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

publisher/test/net/deertopia/publisher/roam-test/20260325083230-awesome_file.org

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

publisher/test/net/deertopia/publisher/roam-test/fake-homepage.org

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

publisher/test/net/deertopia/publisher/server_test.clj

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