@@ -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
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -9,7 +9,6 @@ result-*
|
||||
.lsp
|
||||
.nrepl
|
||||
.direnv/
|
||||
resources/vendor/*
|
||||
node_modules
|
||||
.cljs_node_repl
|
||||
build/
|
||||
|
||||
@@ -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
|
||||
];
|
||||
};
|
||||
});
|
||||
|
||||
@@ -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)))
|
||||
)))
|
||||
@@ -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; };
|
||||
}
|
||||
@@ -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"]}}}
|
||||
@@ -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)
|
||||
@@ -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"}}))
|
||||
|
||||
@@ -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}}
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
@@ -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))")))
|
||||
@@ -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!))
|
||||
@@ -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})}))
|
||||
@@ -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))
|
||||
@@ -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)))
|
||||
@@ -1,10 +0,0 @@
|
||||
{ emacsPackages
|
||||
, symlinkJoin
|
||||
, writeScriptBin
|
||||
, lib
|
||||
}:
|
||||
|
||||
let emacs = emacsPackages.emacsWithPackages (epkgs: [ epkgs.org-roam ]);
|
||||
in writeScriptBin "test-emacs" ''
|
||||
exec ${lib.getExe emacs} "$@"
|
||||
''
|
||||
@@ -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)))
|
||||
@@ -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)
|
||||
@@ -1,7 +0,0 @@
|
||||
:PROPERTIES:
|
||||
:ID: 23ee464d-b13e-4649-826f-622d0edef24e
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: awesome file
|
||||
|
||||
wow!
|
||||
@@ -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 ."`
|
||||
{`^' }
|
||||
| |
|
||||
/</3 \
|
||||
|| ||
|
||||
_| || |_
|
||||
.,_) ) || ( (_,.
|
||||
|__ /_||_\ __|
|
||||
#+end_example
|
||||
@@ -1,7 +0,0 @@
|
||||
:PROPERTIES:
|
||||
:ID: 90f23e03-f746-42cb-862f-1af2d4bde3cc
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: Category theory
|
||||
|
||||
*Category theory* is the mathematical study of categories and functors between them.
|
||||
@@ -1,7 +0,0 @@
|
||||
:PROPERTIES:
|
||||
:ID: ebc5ea84-77ab-4d60-9b13-ef9160b11d1f
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: deertopia.net!!!!!!!!
|
||||
|
||||
homeee
|
||||
@@ -1,22 +0,0 @@
|
||||
:PROPERTIES:
|
||||
:ID: 897bfc9d-94ce-4c58-8d21-93f13372b17b
|
||||
:END:
|
||||
#+title: Monomorphisms and epimorphisms
|
||||
|
||||
In [[id:90f23e03-f746-42cb-862f-1af2d4bde3cc][category theory]], *monomorphisms* and *epimorphisms* are types of cancellative morphisms generalising injective and surjective functions, respectively.[fn:1]
|
||||
|
||||
\begin{tikzcd}
|
||||
% https://q.uiver.app/#q=WzAsNixbMCwwLCJYIl0sWzEsMCwiWSJdLFsyLDAsIloiXSxbMSwxLCJZIl0sWzIsMSwiWiJdLFswLDEsIlgiXSxbMCwxLCJnXzEiLDAseyJvZmZzZXQiOi0yfV0sWzAsMSwiZ18yIiwyLHsib2Zmc2V0IjoyfV0sWzEsMiwiZiIsMl0sWzMsNCwiZ18xIiwwLHsib2Zmc2V0IjotMn1dLFszLDQsImdfMiIsMix7Im9mZnNldCI6Mn1dLFs1LDMsImYiLDJdXQ==
|
||||
X & Y & Z \\
|
||||
X & Y & Z
|
||||
\arrow["{g_1}", shift left=2, from=1-1, to=1-2]
|
||||
\arrow["{g_2}"', shift right=2, from=1-1, to=1-2]
|
||||
\arrow["f"', from=1-2, to=1-3]
|
||||
\arrow["f"', from=2-1, to=2-2]
|
||||
\arrow["{g_1}", shift left=2, from=2-2, to=2-3]
|
||||
\arrow["{g_2}"', shift right=2, from=2-2, to=2-3]
|
||||
\end{tikzcd}
|
||||
|
||||
* Footnotes
|
||||
|
||||
[fn:1] blahahahahah blah blah
|
||||
@@ -1,63 +0,0 @@
|
||||
(ns net.deertopia.doerg.roam-test
|
||||
(:require [net.deertopia.doerg.roam :as sut]
|
||||
[clojure.test :as t]
|
||||
[clojure.java.io :as io]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[babashka.fs :as fs]
|
||||
[babashka.process :as p]
|
||||
[net.deertopia.doerg.config-test :refer [test-config-fixture]]
|
||||
[next.jdbc :as sql]
|
||||
[clojure.string :as str]
|
||||
[net.deertopia.doerg.elisp :as elisp]
|
||||
[com.rpl.specter :as sp]))
|
||||
|
||||
(def org-roam-directory
|
||||
(fs/file "test/net/deertopia/doerg/roam-test"))
|
||||
|
||||
(defn org-roam-db-sync [db-file]
|
||||
(let [script-file (fs/create-temp-file {:prefix "org-roam-db-sync-"
|
||||
:suffix ".el"})
|
||||
emacs (->> [(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)))))
|
||||
@@ -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)))))
|
||||
@@ -1 +0,0 @@
|
||||
#kaocha/v1 {}
|
||||
@@ -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=";
|
||||
};
|
||||
}
|
||||
8
vendor/default.nix
vendored
8
vendor/default.nix
vendored
@@ -1,8 +0,0 @@
|
||||
{ fetchzip
|
||||
, fetchurl
|
||||
, callPackage
|
||||
}:
|
||||
|
||||
{
|
||||
ibm-plex-web = callPackage ./ibm-plex-web.nix {};
|
||||
}
|
||||
Reference in New Issue
Block a user