msyds committed
1 parent
5ca59fdb5e
commit
6e9531f944
76 files changed
+912
-325
No files matched your search
@@ -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
-29
@@ -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/",
|
||||
|
||||
@@ -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"]}}}
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -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))))
|
||||
@@ -15,15 +15,15 @@
|
||||
];
|
||||
|
||||
each-system = f: nixpkgs.lib.genAttrs supportedSystems (system: f rec {
|
||||
pkgs = import nixpkgs {
|
||||
inherit system;
|
||||
overlays = [
|
||||
pkgs = import nixpkgs {
|
||||
inherit system;
|
||||
overlays = [
|
||||
inputs.sydpkgs.overlays.default
|
||||
clj-nix.overlays.default
|
||||
self.overlays.default
|
||||
];
|
||||
};
|
||||
inherit (pkgs) lib;
|
||||
clj-nix.overlays.default
|
||||
self.overlays.default
|
||||
];
|
||||
};
|
||||
inherit (pkgs) lib;
|
||||
inherit system;
|
||||
});
|
||||
in {
|
||||
@@ -31,47 +31,48 @@
|
||||
_pkgs = each-system ({ pkgs, ... }: pkgs);
|
||||
|
||||
packages = each-system ({ pkgs, ... }: {
|
||||
inherit (pkgs) publisher doerg doerg-parser doerg-temml-worker;
|
||||
default = pkgs.publisher;
|
||||
inherit (pkgs) publisher doerg doerg-parser doerg-temml-worker;
|
||||
default = pkgs.publisher;
|
||||
});
|
||||
|
||||
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 {};
|
||||
doerg = final.callPackage ./doerg {};
|
||||
doerg-parser = final.callPackage ./doerg/doerg-parser {};
|
||||
doerg-temml-worker = final.callPackage ./doerg/doerg-temml-worker {};
|
||||
};
|
||||
vendored = final.callPackage ./vendor {};
|
||||
in {
|
||||
inherit (vendored) ibm-plex-web;
|
||||
publisher = final.callPackage ./publisher {};
|
||||
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, ... }: {
|
||||
build-all =
|
||||
pkgs.linkFarmFromDrvs
|
||||
"all"
|
||||
(pkgs.lib.attrValues self.packages.${system});
|
||||
build-all =
|
||||
pkgs.linkFarmFromDrvs
|
||||
"all"
|
||||
(pkgs.lib.attrValues self.packages.${system});
|
||||
});
|
||||
|
||||
devShells = each-system ({ pkgs, system, ... }: {
|
||||
default = pkgs.mkShell {
|
||||
inputsFrom = [
|
||||
pkgs.doerg
|
||||
pkgs.publisher
|
||||
pkgs.doerg-parser
|
||||
pkgs.doerg-temml-worker
|
||||
];
|
||||
packages = with pkgs; [
|
||||
clojure-lsp
|
||||
doerg-parser
|
||||
doerg-temml-worker
|
||||
zprint
|
||||
clojure
|
||||
babashka
|
||||
sqlite-web
|
||||
default = pkgs.mkShell {
|
||||
inputsFrom = [
|
||||
pkgs.doerg
|
||||
pkgs.publisher
|
||||
pkgs.doerg-parser
|
||||
pkgs.doerg-temml-worker
|
||||
];
|
||||
packages = with pkgs; [
|
||||
clojure-lsp
|
||||
doerg-parser
|
||||
doerg-temml-worker
|
||||
zprint
|
||||
clojure
|
||||
babashka
|
||||
sqlite-web
|
||||
pkgs.publisher.test-emacs
|
||||
];
|
||||
};
|
||||
];
|
||||
};
|
||||
});
|
||||
};
|
||||
}
|
||||
File renamed without changes.
+1
-1
@@ -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"
|
||||
|
||||
File renamed without changes.
File renamed without changes.
@@ -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}}
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -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)
|
||||
File renamed without changes.
@@ -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)
|
||||
@@ -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))")))
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -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})}))
|
||||
@@ -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))
|
||||
@@ -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)))
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -0,0 +1,10 @@
|
||||
{ emacsPackages
|
||||
, symlinkJoin
|
||||
, writeScriptBin
|
||||
, lib
|
||||
}:
|
||||
|
||||
let emacs = emacsPackages.emacsWithPackages (epkgs: [ epkgs.org-roam ]);
|
||||
in writeScriptBin "test-emacs" ''
|
||||
exec ${lib.getExe emacs} "$@"
|
||||
''
|
||||
File renamed without changes.
@@ -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)))
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
Executable
+8
@@ -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)
|
||||
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -0,0 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: 23ee464d-b13e-4649-826f-622d0edef24e
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: awesome file
|
||||
|
||||
wow!
|
||||
@@ -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
|
||||
@@ -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.
|
||||
@@ -0,0 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: ebc5ea84-77ab-4d60-9b13-ef9160b11d1f
|
||||
:DeertopiaVisibility: public
|
||||
:END:
|
||||
#+title: deertopia.net!!!!!!!!
|
||||
|
||||
homeee
|
||||
@@ -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
|
||||
@@ -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)))))
|
||||
@@ -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)))))
|
||||
File renamed without changes.
Reference in new issue
Block a user