refactor: doerg는 publisher와 결합 #40

Merged
msyds merged 3 commits from 결합 into main 2026-04-03 13:30:59 -06:00
76 changed files with 912 additions and 325 deletions
Showing only changes of commit 6e9531f944 - Show all commits

No files matched your search

+1
View File
@@ -0,0 +1 @@
((nil . ((cider-clojure-cli-aliases . ":dev:test"))))
+8 -3
View File
@@ -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
View File
@@ -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
View 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"]}}}
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.
-6
View File
@@ -1,6 +0,0 @@
#+title: Doerg specification
#+author: Guppy
* Footnotes
- A bunch of metadata should be read into a node of type =doerg-data=
-18
View File
@@ -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"}}
-27
View File
@@ -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))))
+40 -39
View File
@@ -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
];
};
];
};
});
};
}
View File
File renamed without changes.
+1 -1
View File
@@ -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"
@@ -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}}
+25
View 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)
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)
+119
View 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))")))
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
+183
View 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
View 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
View 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)))
File renamed without changes.
+10
View 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
View 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
View 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!
@@ -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
+63
View 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
View 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)))))
View File
File renamed without changes.