This commit is contained in:
1
.dir-locals.el
Normal file
1
.dir-locals.el
Normal file
@@ -0,0 +1 @@
|
||||
((nil . ((cider-clojure-cli-aliases . ":dev:test"))))
|
||||
@@ -4,8 +4,9 @@
|
||||
, doerg-parser
|
||||
, doerg-temml-worker
|
||||
, ibm-plex-web
|
||||
, test-emacs ? callPackage ./test-emacs.nix {}
|
||||
, fake-git
|
||||
, our-tex ? callPackage ./our-tex.nix {}
|
||||
, our-tex
|
||||
, makeWrapper
|
||||
, writeText
|
||||
}:
|
||||
@@ -43,7 +44,7 @@ in mkCljBin' {
|
||||
name = "net.deertopia/doerg";
|
||||
version = "0.1.0";
|
||||
projectSrc = lib.cleanSource ./.;
|
||||
lockfile = ../deps-lock.json;
|
||||
lockfile = ./deps-lock.json;
|
||||
main-ns = "net.deertopia.doerg.main";
|
||||
nativeBuildInputs = [
|
||||
plex
|
||||
@@ -58,6 +59,7 @@ in mkCljBin' {
|
||||
nativeCheckInputs = [
|
||||
doerg-parser
|
||||
doerg-temml-worker
|
||||
test-emacs
|
||||
plex
|
||||
our-tex
|
||||
];
|
||||
@@ -66,7 +68,10 @@ in mkCljBin' {
|
||||
'';
|
||||
doCheck = true;
|
||||
checkPhase = ''
|
||||
export \
|
||||
EMACS=test-emacs \
|
||||
XDG_STATE_HOME=$(mktemp -d "state-home-XXXXXX")
|
||||
clojure -M:test
|
||||
'';
|
||||
passthru = { inherit plex our-tex; };
|
||||
passthru = { inherit plex our-tex test-emacs; };
|
||||
}
|
||||
@@ -1,14 +1,6 @@
|
||||
{
|
||||
"lock-version": 4,
|
||||
"git-deps": [
|
||||
{
|
||||
"lib": "io.github.msyds/spec-dict",
|
||||
"url": "https://github.com/msyds/spec-dict.git",
|
||||
"rev": "531d629b7f05f37232261cf9e8927a4b5915714f",
|
||||
"git-dir": "https/github.com/msyds/spec-dict",
|
||||
"hash": "sha256-5hMdPsB8OhOCtByPZS+CHXzVLq0H+OBKKnXec21xwmg="
|
||||
}
|
||||
],
|
||||
"git-deps": [],
|
||||
"mvn-deps": [
|
||||
{
|
||||
"mvn-path": "aero/aero/1.1.6/aero-1.1.6.jar",
|
||||
@@ -145,11 +137,6 @@
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-ccrFOSFR4qUozJoJF58KM0F58FxS+OWWz1jd8Suyfys="
|
||||
},
|
||||
{
|
||||
"mvn-path": "com/fasterxml/jackson/core/jackson-core/2.20.0/jackson-core-2.20.0.jar",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-vAz0YHWHcgH4QG7n3idBrn32wGb18EV72AYypxjAbnI="
|
||||
},
|
||||
{
|
||||
"mvn-path": "com/fasterxml/jackson/core/jackson-core/2.20.0/jackson-core-2.20.0.pom",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
@@ -370,11 +357,6 @@
|
||||
"mvn-repo": "https://repo.clojars.org/",
|
||||
"hash": "sha256-OaawIvv0GgkuZwK6MAFtmuyw3zNcYiZVd66K/IipB2A="
|
||||
},
|
||||
{
|
||||
"mvn-path": "fipp/fipp/0.6.26/fipp-0.6.26.jar",
|
||||
"mvn-repo": "https://repo.clojars.org/",
|
||||
"hash": "sha256-98tpbM5Vr9dMg41UQUGcfl9tSRrxhajlY9+nl5aFcoM="
|
||||
},
|
||||
{
|
||||
"mvn-path": "fipp/fipp/0.6.26/fipp-0.6.26.pom",
|
||||
"mvn-repo": "https://repo.clojars.org/",
|
||||
@@ -970,11 +952,6 @@
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-NnHYN2UlIwq6Ah8fYmx54g86ELYrXfgXIiWJDsSv4EU="
|
||||
},
|
||||
{
|
||||
"mvn-path": "org/clojure/core.rrb-vector/0.1.2/core.rrb-vector-0.1.2.jar",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-UfmOunss1C7jDzgmkl3N6HkRZ/dvcSMprlG4gkToE44="
|
||||
},
|
||||
{
|
||||
"mvn-path": "org/clojure/core.rrb-vector/0.1.2/core.rrb-vector-0.1.2.pom",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
@@ -1125,11 +1102,6 @@
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-E15H98p5wKoYG2kJPML50aYyKt1qgli2aXxQCNIwv00="
|
||||
},
|
||||
{
|
||||
"mvn-path": "org/clojure/tools.reader/1.3.6/tools.reader-1.3.6.jar",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
"hash": "sha256-EdGzHyxlwzVbKSu5tEuPyv2lS0TaY+NKuXt5qKs7uOA="
|
||||
},
|
||||
{
|
||||
"mvn-path": "org/clojure/tools.reader/1.3.6/tools.reader-1.3.6.pom",
|
||||
"mvn-repo": "https://repo1.maven.org/maven2/",
|
||||
|
||||
24
deps.edn
Normal file
24
deps.edn
Normal file
@@ -0,0 +1,24 @@
|
||||
{:deps {aero/aero #:mvn{:version "1.1.6"}
|
||||
babashka/fs #:mvn{:version "0.5.24"}
|
||||
babashka/process #:mvn{:version "0.6.25"}
|
||||
ch.qos.logback/logback-classic #:mvn{:version "1.1.3"}
|
||||
cheshire/cheshire #:mvn{:version "6.1.0"}
|
||||
com.github.seancorfield/next.jdbc #:mvn{:version "1.3.1070"}
|
||||
com.rpl/specter #:mvn{:version "1.1.6"}
|
||||
hiccup/hiccup #:mvn{:version "2.0.0-RC4"}
|
||||
http-kit/http-kit #:mvn{:version "2.8.0"}
|
||||
instaparse/instaparse #:mvn{:version "1.5.0"}
|
||||
metosin/reitit #:mvn{:version "0.10.1"}
|
||||
mvxcvi/clj-cbor #:mvn{:version "1.1.1"}
|
||||
org.clojars.pntblnk/clj-ldap #:mvn{:version "0.0.17"}
|
||||
org.clojure/clojure #:mvn{:version "1.12.0"}
|
||||
org.clojure/core.match #:mvn{:version "1.1.0"}
|
||||
org.clojure/test.check #:mvn{:version "1.1.3"}
|
||||
org.clojure/tools.logging #:mvn{:version "1.3.0"}
|
||||
org.xerial/sqlite-jdbc #:mvn{:version "3.47.1.0"}}
|
||||
: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,6 +0,0 @@
|
||||
#+title: Doerg specification
|
||||
#+author: Guppy
|
||||
|
||||
* Footnotes
|
||||
|
||||
- A bunch of metadata should be read into a node of type =doerg-data=
|
||||
@@ -1,18 +0,0 @@
|
||||
{:deps {org.clojure/tools.logging {:mvn/version "1.3.0"}
|
||||
babashka/fs {:mvn/version "0.5.24"}
|
||||
org.clojure/core.match {:mvn/version "1.1.0"}
|
||||
cheshire/cheshire {:mvn/version "6.1.0"}
|
||||
babashka/process {:mvn/version "0.6.25"}
|
||||
io.github.msyds/spec-dict
|
||||
{:git/sha "531d629b7f05f37232261cf9e8927a4b5915714f"}
|
||||
hiccup/hiccup {:mvn/version "2.0.0-RC4"}
|
||||
com.rpl/specter {:mvn/version "1.1.6"}
|
||||
mvxcvi/clj-cbor {:mvn/version "1.1.1"}
|
||||
ch.qos.logback/logback-classic {:mvn/version "1.1.3"}
|
||||
org.clojure/test.check {:mvn/version "1.1.3"}
|
||||
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"]}}}
|
||||
@@ -1,11 +0,0 @@
|
||||
#:net.deertopia.doerg
|
||||
{:ibm-plex-web #or [#xdg-data-dir "ibm-plex-web"
|
||||
#env IBM_PLEX_WEB]
|
||||
:latex "xelatex"
|
||||
:dvisvgm "dvisvgm"
|
||||
:doerg-temml-worker
|
||||
#profile {:dev #file "../../../../doerg-temml-worker/index.js"
|
||||
:default "doerg-temml-worker"}
|
||||
:doerg-parser
|
||||
#profile {:dev #file "../../../../doerg-parser/index.js"
|
||||
:default "doerg-parser"}}
|
||||
@@ -1,27 +0,0 @@
|
||||
(ns scratch
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[spec-dict.main :refer [dict]]
|
||||
[clojure.test.check.generators :as gen]))
|
||||
|
||||
|
||||
(defmulti node-spec :type)
|
||||
|
||||
(s/def ::node
|
||||
(s/multi-spec node-spec :type))
|
||||
|
||||
(s/def ::children (s/coll-of ::node :kind vector?))
|
||||
|
||||
(s/def ::value nat-int?)
|
||||
|
||||
(defmethod node-spec :branch [_]
|
||||
(dict {:children ::children})
|
||||
#_(s/keys :req-un [::children]))
|
||||
|
||||
(defmethod node-spec :leaf [_]
|
||||
(dict {:value ::value})
|
||||
#_
|
||||
(s/keys :req-un [::value]))
|
||||
|
||||
(comment
|
||||
(binding [s/*recursion-limit* 1]
|
||||
(gen/generate (s/gen ::node))))
|
||||
@@ -41,9 +41,10 @@
|
||||
in {
|
||||
inherit (vendored) ibm-plex-web;
|
||||
publisher = final.callPackage ./publisher {};
|
||||
doerg = final.callPackage ./doerg {};
|
||||
doerg-parser = final.callPackage ./doerg/doerg-parser {};
|
||||
doerg-temml-worker = final.callPackage ./doerg/doerg-temml-worker {};
|
||||
doerg = final.callPackage ./. {};
|
||||
doerg-parser = final.callPackage ./doerg-parser {};
|
||||
doerg-temml-worker = final.callPackage ./doerg-temml-worker {};
|
||||
our-tex = final.callPackage ./our-tex.nix {};
|
||||
};
|
||||
|
||||
checks = each-system ({ pkgs, system, ... }: {
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
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 "../doerg"}
|
||||
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"}
|
||||
|
||||
@@ -3,7 +3,6 @@
|
||||
[clojure.spec.alpha :as s]
|
||||
[net.deertopia.doerg.config :as doerg-config]
|
||||
[net.deertopia.doerg :as-alias doerg]
|
||||
[net.deertopia.publisher :as-alias p]
|
||||
[aero.core :as aero]
|
||||
[clojure.java.io :as io]))
|
||||
|
||||
|
||||
@@ -1,26 +1,25 @@
|
||||
(ns net.deertopia.publisher.roam-test
|
||||
(:require [net.deertopia.publisher.roam :as sut]
|
||||
(ns net.deertopia.doerg.roam-test
|
||||
(:require [net.deertopia.doerg.roam :as sut]
|
||||
[clojure.test :as t]
|
||||
[clojure.java.io :as io]
|
||||
[net.deertopia.publisher.config :as publisher-cfg]
|
||||
[net.deertopia.publisher :as-alias publisher]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[babashka.fs :as fs]
|
||||
[babashka.process :as p]
|
||||
[net.deertopia.publisher.config-test :refer [test-config-fixture]]
|
||||
[net.deertopia.doerg.config-test :refer [test-config-fixture]]
|
||||
[next.jdbc :as sql]
|
||||
[clojure.string :as str]
|
||||
[net.deertopia.publisher.elisp :as elisp]
|
||||
[net.deertopia.doerg.elisp :as elisp]
|
||||
[com.rpl.specter :as sp]))
|
||||
|
||||
(def org-roam-directory
|
||||
(fs/file "test/net/deertopia/publisher/roam-test"))
|
||||
(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/publisher/org-roam-db-sync.el"
|
||||
(io/copy (-> "net/deertopia/doerg/org-roam-db-sync.el"
|
||||
io/resource io/reader)
|
||||
(fs/file script-file))
|
||||
(p/shell {:out :string :err :string}
|
||||
@@ -28,7 +27,7 @@
|
||||
(fs/delete script-file)))
|
||||
|
||||
(defn test-db-fixture [f]
|
||||
(let [db-file (-> publisher-cfg/*cfg* ::publisher/org-roam-db-path)]
|
||||
(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"
|
||||
|
||||
18
resources/net/deertopia/doerg/default-config.edn
Normal file
18
resources/net/deertopia/doerg/default-config.edn
Normal file
@@ -0,0 +1,18 @@
|
||||
#:net.deertopia.doerg.config
|
||||
{:ibm-plex-web #or [#xdg-data-dir "ibm-plex-web"
|
||||
#env IBM_PLEX_WEB]
|
||||
:latex "xelatex"
|
||||
:dvisvgm "dvisvgm"
|
||||
:doerg-temml-worker
|
||||
#profile {:dev #file "../../../../doerg-temml-worker/index.js"
|
||||
:default "doerg-temml-worker"}
|
||||
:doerg-parser
|
||||
#profile {:dev #file "../../../../doerg-parser/index.js"
|
||||
:default "doerg-parser"}
|
||||
:state-directory #join [#or [#env XDG_STATE_HOME
|
||||
#envf ["%s/.local/share" HOME]]
|
||||
"/doerg-server"]
|
||||
: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}}
|
||||
|
Before Width: | Height: | Size: 66 KiB After Width: | Height: | Size: 66 KiB |
25
src/net/deertopia/doerg/cached_file.clj
Normal file
25
src/net/deertopia/doerg/cached_file.clj
Normal file
@@ -0,0 +1,25 @@
|
||||
(ns net.deertopia.doerg.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,25 +1,25 @@
|
||||
(ns net.deertopia.doerg.config
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[babashka.fs :as fs]
|
||||
[spec-dict.main :refer [dict]]
|
||||
[aero.core :as aero]
|
||||
[net.deertopia.doerg :as-alias d]
|
||||
[clojure.java.io :as io]))
|
||||
|
||||
(s/def ::d/config
|
||||
(s/keys :req [::d/ibm-plex-web
|
||||
::d/latex
|
||||
::d/dvisvgm
|
||||
::d/doerg-temml-worker
|
||||
::d/doerg-parser]))
|
||||
(s/def ::config
|
||||
(s/keys :req [::ibm-plex-web
|
||||
::latex
|
||||
::dvisvgm
|
||||
::doerg-temml-worker
|
||||
::doerg-parser
|
||||
::state-directory
|
||||
::org-roam-db-path]))
|
||||
|
||||
(s/def ::d/directory
|
||||
(s/def ::directory
|
||||
(s/conformer #(fs/file %)))
|
||||
|
||||
(s/def ::d/file
|
||||
(s/def ::file
|
||||
(s/conformer #(-> % fs/expand-home fs/file)))
|
||||
|
||||
(s/def ::d/executable
|
||||
(s/def ::executable
|
||||
(s/conformer
|
||||
;; I'd love to use `fs/which` here, but it's fairly problematic to
|
||||
;; check `fs/executable?` at… build time (which `fs/which` does)?
|
||||
@@ -28,15 +28,18 @@
|
||||
(some-> % fs/expand-home fs/file)
|
||||
::s/invalid)))
|
||||
|
||||
(s/def ::d/ibm-plex-web ::d/directory)
|
||||
(s/def ::ibm-plex-web ::directory)
|
||||
|
||||
(s/def ::d/latex ::d/executable)
|
||||
(s/def ::latex ::executable)
|
||||
|
||||
(s/def ::d/dvisvgm ::d/executable)
|
||||
(s/def ::dvisvgm ::executable)
|
||||
|
||||
(s/def ::d/doerg-temml-worker ::d/executable)
|
||||
(s/def ::doerg-temml-worker ::executable)
|
||||
|
||||
(s/def ::d/doerg-parser ::d/executable)
|
||||
(s/def ::doerg-parser ::executable)
|
||||
|
||||
(s/def ::state-directory ::file)
|
||||
(s/def ::org-roam-db-path ::file)
|
||||
|
||||
(defmethod aero/reader 'xdg-data-dir
|
||||
[_opts tag value]
|
||||
@@ -52,19 +55,19 @@
|
||||
(-> (aero/relative-resolver source value)
|
||||
fs/file))
|
||||
|
||||
(defn read-config [spec files & {:as opts}]
|
||||
(defn read-config [files & {:as opts}]
|
||||
(let [r (->> files
|
||||
(filter identity)
|
||||
(map #(aero/read-config % opts))
|
||||
(apply merge))
|
||||
conformed (s/conform spec r)]
|
||||
conformed (s/conform ::config r)]
|
||||
(if-not (s/invalid? conformed)
|
||||
conformed
|
||||
(throw (ex-info "Failed to conform config"
|
||||
(s/explain-data spec r))))))
|
||||
(s/explain-data ::config r))))))
|
||||
|
||||
(defn load-config! [var spec files & {:as opts}]
|
||||
(alter-var-root var (constantly (read-config spec files opts))))
|
||||
(alter-var-root var (constantly (read-config files opts))))
|
||||
|
||||
(def sources
|
||||
[;; Default config.
|
||||
@@ -74,6 +77,6 @@
|
||||
;; Config set at runtime.
|
||||
(System/getenv "DOERG_CONFIG")])
|
||||
|
||||
(def default (read-config ::d/config sources))
|
||||
(def default (read-config sources))
|
||||
|
||||
(def ^:dynamic *cfg* default)
|
||||
@@ -7,7 +7,6 @@
|
||||
[net.deertopia.doerg :as-alias doerg]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.set :as set]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.string :as str]
|
||||
[clojure.test.check.generators :as gen]
|
||||
[clojure.tools.logging.readable :as lr]
|
||||
@@ -16,7 +15,6 @@
|
||||
[com.rpl.specter.zipper :as sz]
|
||||
[net.deertopia.doerg.common :as common]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[spec-dict.main :refer [dict]]
|
||||
[clojure.tools.logging :as l])
|
||||
(:import
|
||||
(java.util UUID)))
|
||||
@@ -65,8 +63,6 @@
|
||||
(and (map? e) (contains? e :children)))
|
||||
|
||||
(defn org-element? [element]
|
||||
#_
|
||||
(s/valid? ::org-element element)
|
||||
(and (map? element)
|
||||
(contains? element :type)))
|
||||
|
||||
@@ -99,16 +95,6 @@
|
||||
(and (of-type? element "latex-fragment")
|
||||
(-> element :contents (str/starts-with? "\\[")))))
|
||||
|
||||
|
||||
;;; Spec
|
||||
|
||||
(s/def ::org-element
|
||||
(dict {:type string?}
|
||||
^:opt {:contents-begin nat-int?
|
||||
:contents-end nat-int?
|
||||
:children (s/coll-of ::org-element
|
||||
:kind seq?)}))
|
||||
|
||||
|
||||
;;; Zipper
|
||||
|
||||
@@ -315,149 +301,3 @@
|
||||
(recur (conj acc c) rest)
|
||||
[] acc))))))
|
||||
|
||||
|
||||
;;; Specs (top-level)
|
||||
|
||||
;; Data taken from uniorg/index.d.ts
|
||||
|
||||
(comment
|
||||
(defn- typescript-enum->set [s]
|
||||
(as-> s
|
||||
it
|
||||
(str/split it #" \| ")
|
||||
(map camel->kebab it)
|
||||
(into #{} it))))
|
||||
|
||||
(def greater-element-types
|
||||
#{"org-data" "section" "property-drawer" "drawer" "plain-list"
|
||||
"list-item" "quote-block" "verse-block" "center-block"
|
||||
"special-block" "footnote-definition" "table"})
|
||||
|
||||
(def element-types
|
||||
#{"list-item-tag" "src-block" "comment-block" "latex-environment"
|
||||
"keyword" "paragraph" "node-property" "example-block" "clock"
|
||||
"planning" "diary-sexp" "fixed-width" "export-block"
|
||||
"horizontal-rule" "comment" "table-row" "headline"})
|
||||
|
||||
(def recursive-object-types
|
||||
#{"citation" "footnote-reference" "superscript" "table-cell" "link"
|
||||
"italic" "citation-common-prefix" "subscript" "citation-prefix"
|
||||
"citation-common-suffix" "strike-through" "citation-reference"
|
||||
"bold" "underline"})
|
||||
|
||||
(def object-types
|
||||
#{"line-break" "citation-suffix" "statistics-cookie" "timestamp"
|
||||
"text" "verbatim" "citation-key" "export-snippet" "latex-fragment"
|
||||
"entity" "code"})
|
||||
|
||||
(s/def ::greater-element-type greater-element-types)
|
||||
(s/def ::element-type element-types)
|
||||
(s/def ::object-type (set/union recursive-object-types object-types))
|
||||
(s/def ::recursive-object-type recursive-object-types)
|
||||
|
||||
(s/def ::contents-begin nat-int?)
|
||||
(s/def ::contents-end nat-int?)
|
||||
|
||||
(defmulti node-spec :type)
|
||||
|
||||
(defn- unimplemented-spec [x]
|
||||
(lr/warnf "unimplemented method for %s" x)
|
||||
(s/with-gen any?
|
||||
(constantly (gen/return {}))))
|
||||
|
||||
(defmethod node-spec :default [x] (unimplemented-spec x))
|
||||
|
||||
(def ^:private nfe
|
||||
"NFE — “no further expectations.” Used in sub-specs of `::element`
|
||||
et al. for elements with no additional structure beyond that
|
||||
provided by their parents."
|
||||
(s/with-gen any?
|
||||
(constantly (gen/return {}))))
|
||||
|
||||
(s/def ::node
|
||||
(s/multi-spec node-spec :type))
|
||||
|
||||
(s/def :object/type ::object-type)
|
||||
|
||||
(s/def ::object
|
||||
(s/keys :req-un [:object/type]))
|
||||
|
||||
(s/def :element/children (s/coll-of ::object :kind vector?))
|
||||
(s/def :element/type ::element-type)
|
||||
|
||||
(s/def ::element
|
||||
(s/keys :opt-un [::contents-begin ::contents-end]
|
||||
:req-un [:element/children :element/type]))
|
||||
|
||||
(s/def :greater-element/children
|
||||
(s/coll-of (s/merge
|
||||
(dict {:type (set/union greater-element-types
|
||||
element-types)})
|
||||
::node)
|
||||
:kind vector?))
|
||||
|
||||
(s/def :greater-element/type ::greater-element-type)
|
||||
|
||||
(s/def ::greater-element
|
||||
(s/keys :req-un [::contents-begin ::contents-end
|
||||
:greater-element/children
|
||||
:greater-element/type]))
|
||||
|
||||
(s/def :recursive-object/children
|
||||
(s/coll-of
|
||||
(s/merge
|
||||
(dict {:type ::object-type})
|
||||
::node)
|
||||
:kind vector?))
|
||||
|
||||
(s/def :recursive-object/type ::object-type)
|
||||
|
||||
(s/def ::recursive-object
|
||||
(s/keys :opt-un [::contents-begin ::contents-end]
|
||||
:req-un [:recursive-object/children
|
||||
:recursive-object/type]))
|
||||
|
||||
(comment
|
||||
(use 'net.deertopia.doerg.repl)
|
||||
(def doc (-> "test/net/deertopia/doerg/element_test/paragraph-with-multiple-latex.org"
|
||||
slurp
|
||||
(read-string :post-processors
|
||||
[gather-first-section])))
|
||||
(s/explain ::node doc)
|
||||
(binding [s/*recursion-limit* 1]
|
||||
(gen/generate (s/gen ::node)))
|
||||
(sp/select [postorder-walker (sp/must :children)
|
||||
(sp/continuous-subseqs)]
|
||||
doc))
|
||||
|
||||
(s/def ::todo-keyword string?)
|
||||
(s/def ::priority string?)
|
||||
(s/def ::commented boolean?)
|
||||
(s/def ::level nat-int?)
|
||||
(s/def ::tags (s/coll-of string? :kind vector?))
|
||||
|
||||
|
||||
;;; Specs (specific elements)
|
||||
|
||||
(def ^:private string-value (dict {:value string?}))
|
||||
|
||||
(defmethod node-spec "text" [_] (s/merge ::object string-value))
|
||||
(defmethod node-spec "verbatim" [_] (s/merge ::object string-value))
|
||||
(defmethod node-spec "code" [_] (s/merge ::object string-value))
|
||||
(defmethod node-spec "bold" [_] ::recursive-object)
|
||||
(defmethod node-spec "italic" [_] ::recursive-object)
|
||||
|
||||
(defmethod node-spec "headline" [_]
|
||||
(s/merge ::element
|
||||
(dict {:todo-keyword (s/nilable ::todo-keyword)
|
||||
:priority (s/nilable ::priority)
|
||||
:level ::level
|
||||
:commented ::commented
|
||||
:raw-value string?
|
||||
:tags ::tags})))
|
||||
|
||||
(defmethod node-spec "org-data" [_]
|
||||
::greater-element)
|
||||
|
||||
(defmethod node-spec "section" [_]
|
||||
::greater-element)
|
||||
119
src/net/deertopia/doerg/elisp.clj
Normal file
119
src/net/deertopia/doerg/elisp.clj
Normal file
@@ -0,0 +1,119 @@
|
||||
(ns net.deertopia.doerg.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/doerg/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.doerg.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))")))
|
||||
183
src/net/deertopia/doerg/roam.clj
Normal file
183
src/net/deertopia/doerg/roam.clj
Normal file
@@ -0,0 +1,183 @@
|
||||
(ns net.deertopia.doerg.roam
|
||||
(:require [babashka.fs :as fs]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[net.deertopia.doerg.elisp :as elisp]
|
||||
[net.deertopia.doerg.slug :as slug]
|
||||
[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* ::cfg/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.doerg.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})}))
|
||||
188
src/net/deertopia/doerg/server.clj
Normal file
188
src/net/deertopia/doerg/server.clj
Normal file
@@ -0,0 +1,188 @@
|
||||
(ns net.deertopia.doerg.server
|
||||
(:require [clojure.pprint :refer [pprint]]
|
||||
[clojure.tools.logging :as l]
|
||||
[hiccup2.core :as hiccup]
|
||||
[net.deertopia.doerg.html :as doerg-html]
|
||||
[net.deertopia.doerg.config :as-alias cfg]
|
||||
[net.deertopia.doerg.slug :as slug]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[net.deertopia.doerg.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.doerg.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* ::cfg/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* ::cfg/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* ::cfg/port)))))
|
||||
|
||||
(defn status []
|
||||
(if @server
|
||||
(http/server-status @server)
|
||||
:stopped))
|
||||
64
src/net/deertopia/doerg/slug.clj
Normal file
64
src/net/deertopia/doerg/slug.clj
Normal file
@@ -0,0 +1,64 @@
|
||||
(ns net.deertopia.doerg.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)))
|
||||
10
test-emacs.nix
Normal file
10
test-emacs.nix
Normal file
@@ -0,0 +1,10 @@
|
||||
{ emacsPackages
|
||||
, symlinkJoin
|
||||
, writeScriptBin
|
||||
, lib
|
||||
}:
|
||||
|
||||
let emacs = emacsPackages.emacsWithPackages (epkgs: [ epkgs.org-roam ]);
|
||||
in writeScriptBin "test-emacs" ''
|
||||
exec ${lib.getExe emacs} "$@"
|
||||
''
|
||||
9
test/net/deertopia/doerg/config_test.clj
Normal file
9
test/net/deertopia/doerg/config_test.clj
Normal file
@@ -0,0 +1,9 @@
|
||||
(ns net.deertopia.doerg.config-test
|
||||
(:require [clojure.test :as t]
|
||||
[net.deertopia.doerg.config :as cfg]))
|
||||
|
||||
(defn test-config-fixture
|
||||
"`clojure.test` fixture to run tests with the :test configuration."
|
||||
[f]
|
||||
(binding [cfg/*cfg* (cfg/read-config cfg/sources :profile :test)]
|
||||
(f)))
|
||||
8
test/net/deertopia/doerg/org-roam-db-sync.el
Executable file
8
test/net/deertopia/doerg/org-roam-db-sync.el
Executable file
@@ -0,0 +1,8 @@
|
||||
#!/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)
|
||||
@@ -0,0 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: 23ee464d-b13e-4649-826f-622d0edef24e
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: awesome file
|
||||
|
||||
wow!
|
||||
23
test/net/deertopia/doerg/roam-test/404.org
Normal file
23
test/net/deertopia/doerg/roam-test/404.org
Normal file
@@ -0,0 +1,23 @@
|
||||
: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
|
||||
7
test/net/deertopia/doerg/roam-test/categorytheory.org
Normal file
7
test/net/deertopia/doerg/roam-test/categorytheory.org
Normal file
@@ -0,0 +1,7 @@
|
||||
: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.
|
||||
7
test/net/deertopia/doerg/roam-test/fake-homepage.org
Normal file
7
test/net/deertopia/doerg/roam-test/fake-homepage.org
Normal file
@@ -0,0 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: ebc5ea84-77ab-4d60-9b13-ef9160b11d1f
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: deertopia.net!!!!!!!!
|
||||
|
||||
homeee
|
||||
22
test/net/deertopia/doerg/roam-test/monoepi.org
Normal file
22
test/net/deertopia/doerg/roam-test/monoepi.org
Normal file
@@ -0,0 +1,22 @@
|
||||
: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
|
||||
63
test/net/deertopia/doerg/roam_test.clj
Normal file
63
test/net/deertopia/doerg/roam_test.clj
Normal file
@@ -0,0 +1,63 @@
|
||||
(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)))))
|
||||
52
test/net/deertopia/doerg/server_test.clj
Normal file
52
test/net/deertopia/doerg/server_test.clj
Normal file
@@ -0,0 +1,52 @@
|
||||
(ns net.deertopia.doerg.server-test
|
||||
(:require [net.deertopia.doerg.server :as sut]
|
||||
[reitit.ring]
|
||||
[clojure.test :as t]
|
||||
[net.deertopia.doerg.config :as cfg]
|
||||
[net.deertopia.doerg.roam :as roam]
|
||||
[babashka.fs :as fs]
|
||||
[clojure.java.io :as io]
|
||||
[net.deertopia.doerg.roam-test :refer [test-db-fixture]]
|
||||
[net.deertopia.doerg.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"
|
||||
(::cfg/port 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)))))
|
||||
Reference in New Issue
Block a user