From 2cc1a079a7a23c9db9fb8d2603925582788097d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Fri, 3 Apr 2026 13:21:56 -0600 Subject: [PATCH] =?UTF-8?q?=EB=8D=94?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitea/workflows/build.yaml | 2 - .gitignore | 1 - flake.nix | 7 +- vendor/ibm-plex-web.nix => ibm-plex-web.nix | 0 publisher/.dir-locals.el | 12 -- publisher/default.nix | 55 ----- publisher/deps.edn | 21 -- publisher/dev/user.clj | 24 --- publisher/override_deps.bb | 56 ------ .../deertopia/publisher/default-config.edn | 8 - .../net/deertopia/publisher/cached_file.clj | 25 --- .../src/net/deertopia/publisher/config.clj | 27 --- .../src/net/deertopia/publisher/elisp.clj | 119 ----------- .../src/net/deertopia/publisher/main.clj | 7 - .../src/net/deertopia/publisher/roam.clj | 184 ----------------- .../src/net/deertopia/publisher/server.clj | 188 ------------------ .../src/net/deertopia/publisher/slug.clj | 64 ------ publisher/test-emacs.nix | 10 - .../net/deertopia/publisher/config_test.clj | 19 -- .../deertopia/publisher/org-roam-db-sync.el | 8 - .../roam-test/20260325083230-awesome_file.org | 7 - .../net/deertopia/publisher/roam-test/404.org | 23 --- .../publisher/roam-test/categorytheory.org | 7 - .../publisher/roam-test/fake-homepage.org | 7 - .../deertopia/publisher/roam-test/monoepi.org | 22 -- .../net/deertopia/publisher/roam_test.clj | 63 ------ .../net/deertopia/publisher/server_test.clj | 55 ----- publisher/tests.edn | 1 - publisher/vendor.nix | 25 --- vendor/default.nix | 8 - 30 files changed, 2 insertions(+), 1053 deletions(-) rename vendor/ibm-plex-web.nix => ibm-plex-web.nix (100%) delete mode 100644 publisher/.dir-locals.el delete mode 100644 publisher/default.nix delete mode 100644 publisher/deps.edn delete mode 100644 publisher/dev/user.clj delete mode 100644 publisher/override_deps.bb delete mode 100644 publisher/resources/net/deertopia/publisher/default-config.edn delete mode 100644 publisher/src/net/deertopia/publisher/cached_file.clj delete mode 100644 publisher/src/net/deertopia/publisher/config.clj delete mode 100644 publisher/src/net/deertopia/publisher/elisp.clj delete mode 100644 publisher/src/net/deertopia/publisher/main.clj delete mode 100644 publisher/src/net/deertopia/publisher/roam.clj delete mode 100644 publisher/src/net/deertopia/publisher/server.clj delete mode 100644 publisher/src/net/deertopia/publisher/slug.clj delete mode 100644 publisher/test-emacs.nix delete mode 100644 publisher/test/net/deertopia/publisher/config_test.clj delete mode 100755 publisher/test/net/deertopia/publisher/org-roam-db-sync.el delete mode 100644 publisher/test/net/deertopia/publisher/roam-test/20260325083230-awesome_file.org delete mode 100644 publisher/test/net/deertopia/publisher/roam-test/404.org delete mode 100644 publisher/test/net/deertopia/publisher/roam-test/categorytheory.org delete mode 100644 publisher/test/net/deertopia/publisher/roam-test/fake-homepage.org delete mode 100644 publisher/test/net/deertopia/publisher/roam-test/monoepi.org delete mode 100644 publisher/test/net/deertopia/publisher/roam_test.clj delete mode 100644 publisher/test/net/deertopia/publisher/server_test.clj delete mode 100644 publisher/tests.edn delete mode 100644 publisher/vendor.nix delete mode 100644 vendor/default.nix diff --git a/.gitea/workflows/build.yaml b/.gitea/workflows/build.yaml index d084c7b..e276411 100644 --- a/.gitea/workflows/build.yaml +++ b/.gitea/workflows/build.yaml @@ -9,5 +9,3 @@ jobs: uses: actions/checkout@v4 - name: build doerg run: nix build -L .#doerg - - name: build publisher - run: nix build -L .#publisher diff --git a/.gitignore b/.gitignore index 6b6b1fd..56c0aa5 100644 --- a/.gitignore +++ b/.gitignore @@ -9,7 +9,6 @@ result-* .lsp .nrepl .direnv/ -resources/vendor/* node_modules .cljs_node_repl build/ diff --git a/flake.nix b/flake.nix index 4ff5b5a..5cdc3c2 100644 --- a/flake.nix +++ b/flake.nix @@ -37,10 +37,8 @@ overlays.default = final: prev: let graal = x: final.mkGraalBin { cljDrv = x; }; - vendored = final.callPackage ./vendor {}; in { - inherit (vendored) ibm-plex-web; - publisher = final.callPackage ./publisher {}; + ibm-plex-web = final.callPackage ./ibm-plex-web.nix {}; doerg = final.callPackage ./. {}; doerg-parser = final.callPackage ./doerg-parser {}; doerg-temml-worker = final.callPackage ./doerg-temml-worker {}; @@ -58,7 +56,6 @@ default = pkgs.mkShell { inputsFrom = [ pkgs.doerg - pkgs.publisher pkgs.doerg-parser pkgs.doerg-temml-worker ]; @@ -70,7 +67,7 @@ clojure babashka sqlite-web - pkgs.publisher.test-emacs + pkgs.doerg.test-emacs ]; }; }); diff --git a/vendor/ibm-plex-web.nix b/ibm-plex-web.nix similarity index 100% rename from vendor/ibm-plex-web.nix rename to ibm-plex-web.nix diff --git a/publisher/.dir-locals.el b/publisher/.dir-locals.el deleted file mode 100644 index 129c890..0000000 --- a/publisher/.dir-locals.el +++ /dev/null @@ -1,12 +0,0 @@ -((nil - . ((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))) - ))) diff --git a/publisher/default.nix b/publisher/default.nix deleted file mode 100644 index ecd172d..0000000 --- a/publisher/default.nix +++ /dev/null @@ -1,55 +0,0 @@ -{ mkCljBin -, doerg -, babashka -, callPackage -, test-emacs ? callPackage ./test-emacs.nix {} -, fake-git -, breakpointHook -, doerg-temml-worker -, doerg-parser -}: - -let - # 이 mkCljBin에는 fake-git가 포함되지 않는다. 그것 불필요해서 dev - # shell에 없고 싶는다. - mkCljBin' = args: (mkCljBin args).overrideAttrs (final: prev: { - nativeBuildInputs = - builtins.filter - # A possibly-sketchy predicate, lol. - (x: x != fake-git) - prev.nativeBuildInputs; - }); -in mkCljBin' { - name = "net.deertopia/publisher"; - version = "0.1.0"; - projectSrc = ./.; - lockfile = ../deps-lock.json; - main-ns = "net.deertopia.publisher.main"; - buildInputs = [ - doerg - ]; - nativeBuildInputs = [ - babashka - ]; - nativeCheckInputs = [ - doerg-parser - doerg-temml-worker - test-emacs - doerg - doerg.our-tex - doerg.plex - ]; - postPatch = '' - mv deps.edn deps.edn.old - bb -cp . -m override-deps < deps.edn.old > deps.edn \ - net.deertopia/doerg '{:local/root "${doerg.lib}/${doerg.name}.jar"}' - ''; - doCheck = true; - checkPhase = '' - export \ - EMACS=test-emacs \ - XDG_STATE_HOME=$(mktemp -d "state-home-XXXXXX") - clojure -M:test - ''; - passthru = { inherit test-emacs; }; -} diff --git a/publisher/deps.edn b/publisher/deps.edn deleted file mode 100644 index 17aee68..0000000 --- a/publisher/deps.edn +++ /dev/null @@ -1,21 +0,0 @@ -{:deps {org.clojure/clojure {:mvn/version "1.12.0"} - org.clojure/tools.logging {:mvn/version "1.3.0"} - hiccup/hiccup {:mvn/version "2.0.0-RC4"} - org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"} - babashka/fs {:mvn/version "0.5.24"} - org.clojure/core.match {:mvn/version "1.1.0"} - 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"} - org.clojure/test.check {:mvn/version "1.1.3"} - net.deertopia/doerg {:local/root ".."} - metosin/reitit {:mvn/version "0.10.1"} - http-kit/http-kit {:mvn/version "2.8.0"} - instaparse/instaparse {:mvn/version "1.5.0"} - aero/aero {:mvn/version "1.1.6"}} - :paths ["src" "resources"] - :aliases - {:test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}} - :extra-paths ["test"] - :main-opts ["-m" "kaocha.runner"]} - :dev {:extra-paths ["dev"]}}} diff --git a/publisher/dev/user.clj b/publisher/dev/user.clj deleted file mode 100644 index 7bfe3fc..0000000 --- a/publisher/dev/user.clj +++ /dev/null @@ -1,24 +0,0 @@ -(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) diff --git a/publisher/override_deps.bb b/publisher/override_deps.bb deleted file mode 100644 index afcbc4f..0000000 --- a/publisher/override_deps.bb +++ /dev/null @@ -1,56 +0,0 @@ -;;; -*- mode:clojure -*- -;;; -;;; USAGE: -;;; -;;; bb -cp . -m override-deps -- [DEP-NAME INFO]… -;;; -;;; This script takes a series of deps substitutions on the command -;;; line, applies them to a deps.edn file (read on stdin), and spits -;;; the result to stdout. -;;; -;;; It is used to build the Doerg server with Nix, since Clj-nix does -;;; not resolve the local deps itself. - -(ns override-deps - (:require [rewrite-clj.zip :as z] - [babashka.fs :as fs] - [clojure.edn :as edn])) - -(defn apply-overrides [zloc overrides] - (loop [os (seq overrides) - loc zloc] - (if-some [[[k v] & xs] os] - (do (binding [*out* *err*] - (printf "override dep %s with %s\n" - (pr-str k) (pr-str v))) - (recur xs (z/assoc loc k v))) - loc))) - -(defn args->overrides [args] - (assert (even? (count args))) - (->> args (map edn/read-string) (apply hash-map))) - -(defn -main [& args] - (let [zloc (-> (slurp *in*) z/of-string) - overrides (args->overrides args)] - (-> zloc - z/down - (z/find-value :deps) z/right - (apply-overrides overrides) - z/root-string - print))) - - - -(comment - "Example overrides" - (def overrides '{net.deertopia/doerg "blah!!!!" - ring/ring-defaults {:mvn/version "xxxxx"}})) - -(comment - "Behaviour of `args->overrides`." - (= (args->overrides ["net.deertopia/doerg" "{:mvn/version \"abc\"}" - "ring/ring-defaults" "{:local/root \"/path/to/jar\"}"]) - '{ring/ring-defaults {:local/root "/path/to/jar"} - net.deertopia/doerg {:mvn/version "abc"}})) - diff --git a/publisher/resources/net/deertopia/publisher/default-config.edn b/publisher/resources/net/deertopia/publisher/default-config.edn deleted file mode 100644 index 85bb147..0000000 --- a/publisher/resources/net/deertopia/publisher/default-config.edn +++ /dev/null @@ -1,8 +0,0 @@ -#:net.deertopia.publisher -{:state-directory #join [#or [#env XDG_STATE_HOME - #envf ["%s/.local/share" HOME]] - "/doerg-publisher"] - :org-roam-db-path - #profile {:default #join [#env HOME "/.cache/emacs/org-roam.db"] - :test #join [#or [#env TMP "/tmp"] "/doerg-org-roam-test.db"]} - :port #profile {:default 8080}} diff --git a/publisher/src/net/deertopia/publisher/cached_file.clj b/publisher/src/net/deertopia/publisher/cached_file.clj deleted file mode 100644 index 995b28e..0000000 --- a/publisher/src/net/deertopia/publisher/cached_file.clj +++ /dev/null @@ -1,25 +0,0 @@ -(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)) - (fs/create-dirs (fs/parent file)) - (spit file r))) - file) diff --git a/publisher/src/net/deertopia/publisher/config.clj b/publisher/src/net/deertopia/publisher/config.clj deleted file mode 100644 index b7c0cba..0000000 --- a/publisher/src/net/deertopia/publisher/config.clj +++ /dev/null @@ -1,27 +0,0 @@ -(ns net.deertopia.publisher.config - (:require [babashka.fs :as fs] - [clojure.spec.alpha :as s] - [net.deertopia.doerg.config :as doerg-config] - [net.deertopia.doerg :as-alias doerg] - [aero.core :as aero] - [clojure.java.io :as io])) - -(s/def ::p/config - (s/keys :req [::p/state-directory - ::p/org-roam-db-path])) - -(s/def ::p/state-directory ::doerg/file) -(s/def ::p/org-roam-db-path ::doerg/file) - -(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")]) - -(def default - (doerg-config/read-config ::p/config sources)) - -(def ^:dynamic *cfg* default) diff --git a/publisher/src/net/deertopia/publisher/elisp.clj b/publisher/src/net/deertopia/publisher/elisp.clj deleted file mode 100644 index 8a0604d..0000000 --- a/publisher/src/net/deertopia/publisher/elisp.clj +++ /dev/null @@ -1,119 +0,0 @@ -(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]) - (:refer-clojure :exclude [print read read-string])) - -(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 (or (string? x) (uuid? 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))"))) diff --git a/publisher/src/net/deertopia/publisher/main.clj b/publisher/src/net/deertopia/publisher/main.clj deleted file mode 100644 index 6dcf569..0000000 --- a/publisher/src/net/deertopia/publisher/main.clj +++ /dev/null @@ -1,7 +0,0 @@ -(ns net.deertopia.publisher.main - (:require [net.deertopia.doerg.main :as doerg] - [net.deertopia.publisher.server :as server]) - (:gen-class)) - -(defn -main [] - (server/start!)) diff --git a/publisher/src/net/deertopia/publisher/roam.clj b/publisher/src/net/deertopia/publisher/roam.clj deleted file mode 100644 index e6cef35..0000000 --- a/publisher/src/net/deertopia/publisher/roam.clj +++ /dev/null @@ -1,184 +0,0 @@ -(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] - [net.deertopia.publisher :as-alias publisher] - [next.jdbc :as sql]) - (:import (java.util UUID))) - - -;;; Global database - -(defonce ^:dynamic *use-db-cache?* true) - -(defn ds [] - (sql/get-datasource - {:dbtype "sqlite" - :dbname (-> cfg/*cfg* ::publisher/org-roam-db-path str)})) - - -;;; Elisp sexp (de)serialisation - -(defn id [node] - (-> node :id)) - -(defn slug [node] - (-> node :id slug/from-uuid)) - -(defn- print-id [node] - (-> node id elisp/print)) - - -;;; Node - -(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] (make-node uuid {})) - ([uuid props] - (and (uuid-exists? uuid) - (->Node uuid (atom props))))) - -(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))))) - -(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.")) - -(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 nodes linking to `node`." - [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 (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 - -(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})})) diff --git a/publisher/src/net/deertopia/publisher/server.clj b/publisher/src/net/deertopia/publisher/server.clj deleted file mode 100644 index a064794..0000000 --- a/publisher/src/net/deertopia/publisher/server.clj +++ /dev/null @@ -1,188 +0,0 @@ -(ns net.deertopia.publisher.server - (:require [clojure.pprint :refer [pprint]] - [clojure.tools.logging :as l] - [hiccup2.core :as hiccup] - [net.deertopia.doerg.html :as doerg-html] - [net.deertopia.publisher :as-alias publisher] - [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] - [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] - [net.deertopia.publisher.cached-file :as cached-file] - [babashka.fs :as fs] - [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 - [:head - [:title "hello"] - doerg-html/charset - doerg-html/viewport] - [:body - [:pre - (with-out-str - (pprint req))]]]) - str - 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")))) - -(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 - (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) - 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 - :postamble (backlinks-postamble node))) - (-> (str html-file) - response/file-response - (response/content-type "text/html"))) - (not-found req))) - -(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))}))) - -(defn handle-homepage [req] - (-> req - (assoc-in [:path-params :slug] homepage-slug) - node-by-slug)) - -(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 - #{["/" #'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 :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 - -(def app (reitit.ring/ring-handler router)) - -(defonce server (atom nil)) - -(defn stop! [] - (when @server - (http/server-stop! @server {:timeout 100}) - (reset! server nil) - (l/info "Stopped server"))) - -;; For some reason, the log messages from `stop!` are not flushed -;; before the JVM shuts dowm. Nevertheless, the server /does/ come to -;; a graceful halt. -(def ^:private shutdown-hook (Thread. stop!)) - -(defn start! [] - (if @server - (throw (IllegalStateException. "Server already started")) - (do (reset! server - (http/run-server (bound-fn* #'app) - {:port (-> cfg/*cfg* ::publisher/port) - :legacy-return-value? false})) - ;; For some reason, the log messages are not flushed before - ;; the JVM shuts dowm. Nevertheless, the server /does/ come - ;; to a graceful halt. - (try (.addShutdownHook (Runtime/getRuntime) shutdown-hook) - (catch IllegalArgumentException e - (when (not= "Hook previously registered" - (ex-message e)) - (throw e)))) - (l/infof "Server started on port %d" - (-> cfg/*cfg* ::publisher/port))))) - -(defn status [] - (if @server - (http/server-status @server) - :stopped)) diff --git a/publisher/src/net/deertopia/publisher/slug.clj b/publisher/src/net/deertopia/publisher/slug.clj deleted file mode 100644 index 0d183cb..0000000 --- a/publisher/src/net/deertopia/publisher/slug.clj +++ /dev/null @@ -1,64 +0,0 @@ -(ns net.deertopia.publisher.slug - (:require [clojure.spec.alpha :as s] - [spec-tools.core :as st]) - (:import (java.nio ByteBuffer) - (java.util Base64 UUID))) - -(defrecord Slug [slug-string] - Object - (toString [this] - (:slug-string this))) - -(defn from-string [s] - (try (let [decoder (Base64/getUrlDecoder)] - (when (= 16 (count (.decode decoder s))) - (Slug. s))) - ;; really stupid - (catch IllegalArgumentException _ - nil))) - -(defn to-string [s] - (str s)) - -(defn- coerce-to-uuid [string-or-uuid] - (cond (string? string-or-uuid) (UUID/fromString string-or-uuid) - (uuid? string-or-uuid) string-or-uuid)) - -(defn- uuid->bytes [string-or-uuid] - (let [uuid (coerce-to-uuid string-or-uuid)] - (.array (doto (ByteBuffer/wrap (byte-array 16)) - (.putLong (.getMostSignificantBits uuid)) - (.putLong (.getLeastSignificantBits uuid)))))) - -(defn- bytes->uuid [bytes] - (when (= (count bytes) 16) - (let [bb (ByteBuffer/wrap bytes) - high (.getLong bb) - low (.getLong bb)] - (UUID. high low)))) - -(defn from-uuid [string-or-uuid] - (let [uuid (coerce-to-uuid string-or-uuid) - encoder (.withoutPadding (Base64/getUrlEncoder))] - (Slug. (.encodeToString encoder (uuid->bytes uuid))))) - -(defn to-uuid [slug] - (let [decoder (Base64/getUrlDecoder)] - (bytes->uuid (.decode decoder (str slug))))) - -(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})) - -(defn make-slug [string] - (assert (try (to-uuid string) - (catch Throwable _ - nil)) - "invalid slug") - (->Slug string)) - -(s/def ::slug - (s/conformer #(or (some-> % from-string) - ::s/invalid))) diff --git a/publisher/test-emacs.nix b/publisher/test-emacs.nix deleted file mode 100644 index 6bea7d8..0000000 --- a/publisher/test-emacs.nix +++ /dev/null @@ -1,10 +0,0 @@ -{ emacsPackages -, symlinkJoin -, writeScriptBin -, lib -}: - -let emacs = emacsPackages.emacsWithPackages (epkgs: [ epkgs.org-roam ]); -in writeScriptBin "test-emacs" '' - exec ${lib.getExe emacs} "$@" -'' diff --git a/publisher/test/net/deertopia/publisher/config_test.clj b/publisher/test/net/deertopia/publisher/config_test.clj deleted file mode 100644 index 634693e..0000000 --- a/publisher/test/net/deertopia/publisher/config_test.clj +++ /dev/null @@ -1,19 +0,0 @@ -(ns net.deertopia.publisher.config-test - (:require [clojure.test :as t] - [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])) - -(defn test-config-fixture - "`clojure.test` fixture to run tests with the :test configuration." - [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))) diff --git a/publisher/test/net/deertopia/publisher/org-roam-db-sync.el b/publisher/test/net/deertopia/publisher/org-roam-db-sync.el deleted file mode 100755 index 0f1eaa8..0000000 --- a/publisher/test/net/deertopia/publisher/org-roam-db-sync.el +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/env -S emacs -Q -x - -(require 'org-roam) - -(setq org-roam-directory (expand-file-name (car command-line-args-left))) -(setq org-roam-db-location (expand-file-name (cadr command-line-args-left))) - -(org-roam-db-sync) diff --git a/publisher/test/net/deertopia/publisher/roam-test/20260325083230-awesome_file.org b/publisher/test/net/deertopia/publisher/roam-test/20260325083230-awesome_file.org deleted file mode 100644 index 0367438..0000000 --- a/publisher/test/net/deertopia/publisher/roam-test/20260325083230-awesome_file.org +++ /dev/null @@ -1,7 +0,0 @@ -:PROPERTIES: -:ID: 23ee464d-b13e-4649-826f-622d0edef24e -:DeertopiaVisibility: public -:END: -#+title: awesome file - -wow! diff --git a/publisher/test/net/deertopia/publisher/roam-test/404.org b/publisher/test/net/deertopia/publisher/roam-test/404.org deleted file mode 100644 index 2fd2627..0000000 --- a/publisher/test/net/deertopia/publisher/roam-test/404.org +++ /dev/null @@ -1,23 +0,0 @@ -:PROPERTIES: -:ID: 3c60c74e-f533-43ad-89b3-563975bf80f2 -:DeertopiaVisibility: public -:END: -#+title: page not found - -the page you're looking for doesn't exist, or you lack the permissions necessary to view it........ - -#+attr_doerg: :center? true :alt "A doe sitting and sobbing" :scale 1.4 -#+begin_example - \{ / \ }/ - \/ . . \/ - .. \Y` `Y/ .. - \ `\|~==~|/' / - '". T T ."` - {`^' } - | | - /> [(System/getenv "EMACS") "test-emacs" "emacs"] - (some #(some-> % fs/which)))] - (io/copy (-> "net/deertopia/doerg/org-roam-db-sync.el" - io/resource io/reader) - (fs/file script-file)) - (p/shell {:out :string :err :string} - emacs "-Q" "-x" script-file org-roam-directory db-file) - (fs/delete script-file))) - -(defn test-db-fixture [f] - (let [db-file (-> cfg/*cfg* ::cfg/org-roam-db-path)] - (assert (->> db-file fs/canonicalize str - (re-matches #"^/(build|tmp)/.*")) - (format "i'm scared to delete a non-test database... %s" - (str db-file))) - (fs/delete-if-exists db-file) - (org-roam-db-sync db-file) - (f) - (fs/delete db-file))) - -(t/use-fixtures - :once (t/join-fixtures [test-config-fixture test-db-fixture])) - - - -(t/deftest all-nodes-exist - (let [known-node-files (->> (fs/list-dir org-roam-directory) - (map (comp str fs/canonicalize)) - (into #{})) - database-nodes - (->> (sql/execute! - (sut/ds) ["select file, id from nodes"]) - (map (fn [x] - {:file (-> x :nodes/file elisp/read-string) - :id (-> x :nodes/id elisp/read-string parse-uuid)})) - (into #{}))] - (t/testing "database has a node for each file?" - (t/is (= known-node-files (sp/transform - [sp/ALL] - #(:file %) - database-nodes)))) - (t/testing "each uuid exists?" - (t/is (every? (comp sut/uuid-exists? :id) - database-nodes))))) diff --git a/publisher/test/net/deertopia/publisher/server_test.clj b/publisher/test/net/deertopia/publisher/server_test.clj deleted file mode 100644 index 0f61d5f..0000000 --- a/publisher/test/net/deertopia/publisher/server_test.clj +++ /dev/null @@ -1,55 +0,0 @@ -(ns net.deertopia.publisher.server-test - (:require [net.deertopia.publisher.server :as sut] - [reitit.ring] - [clojure.test :as t] - [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] - [babashka.fs :as fs] - [clojure.java.io :as io] - [net.deertopia.publisher.roam-test :refer [test-db-fixture]] - [net.deertopia.publisher.config-test :refer [test-config-fixture]])) - -(t/use-fixtures - :once (t/join-fixtures [test-config-fixture test-db-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 (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 get-nonexistent-node - (let [slug "3Lxvxnb0QrivoU3DX-l_5w"] - (assert (nil? (roam/make-node slug))) - (t/is (= 404 - (-> (str "/n/" slug) - get-sut :status))))) - -(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))))) diff --git a/publisher/tests.edn b/publisher/tests.edn deleted file mode 100644 index 9d8d845..0000000 --- a/publisher/tests.edn +++ /dev/null @@ -1 +0,0 @@ -#kaocha/v1 {} diff --git a/publisher/vendor.nix b/publisher/vendor.nix deleted file mode 100644 index 7c4ba7a..0000000 --- a/publisher/vendor.nix +++ /dev/null @@ -1,25 +0,0 @@ -{ fetchzip -, fetchurl -}: - -{ - ibm-plex-serif = fetchzip { - url = "https://github.com/IBM/plex/releases/download/%40ibm%2Fplex-serif%401.1.0/ibm-plex-serif.zip"; - hash = "sha256-8ygaAeMKygYS4GCub4YUQmkh87pYHfi3s0PQ6AbaeGw="; - }; - - ibm-plex-math = fetchzip { - url = "https://github.com/IBM/plex/releases/download/%40ibm%2Fplex-math%401.1.0/ibm-plex-math.zip"; - hash = "sha256-dJA6uqxa/yb3eLY4l39NeP0yIl2NfrbaRpf6h0/F7Xc="; - }; - - ibm-plex-sans-kr = fetchzip { - url = "https://github.com/IBM/plex/releases/download/%40ibm%2Fplex-sans-kr%401.1.0/ibm-plex-sans-kr.zip"; - hash = "sha256-FsHxMvLlI4yylgG96DOZIdW2DYpk7I+c5QgkVIkNZIE="; - }; - - "d3.v7.min.js" = fetchurl { - url = "https://d3js.org/d3.v7.min.js"; - hash = "sha256-8glLv2FBs1lyLE/kVOtsSw8OQswQzHr5IfwVj864ZTk="; - }; -} diff --git a/vendor/default.nix b/vendor/default.nix deleted file mode 100644 index af2f076..0000000 --- a/vendor/default.nix +++ /dev/null @@ -1,8 +0,0 @@ -{ fetchzip -, fetchurl -, callPackage -}: - -{ - ibm-plex-web = callPackage ./ibm-plex-web.nix {}; -}