diff options
| -rw-r--r-- | Alpha/Core.scm | 12 | ||||
| -rw-r--r-- | z.scm | 198 |
2 files changed, 174 insertions, 36 deletions
diff --git a/Alpha/Core.scm b/Alpha/Core.scm index 192a74f..db5975b 100644 --- a/Alpha/Core.scm +++ b/Alpha/Core.scm @@ -6,7 +6,7 @@ #:export (fmt printf pr prn rest last butlast true? false? some? empty? -> ->> fn /. curry comp - repeat + repeat for seq inc dec member? contains? comment get-source* get-source source)) @@ -49,7 +49,7 @@ (eq? #t x)) (define (some? a) - (not (nil? a))) + (not (null? a))) (define (empty? a) (equal? a '())) @@ -205,3 +205,11 @@ (define (contains? ls x) (member? x ls)) + +(define (for ls f) + (map f ls)) + +(define (seq x) + (if (list? x) + x + (list x))) @@ -1,10 +1,17 @@ (import (Alpha Core)) (import (prefix (Alpha String) string.)) (import (srfi srfi-1)) +(import (sxml simple)) (import (only (srfi srfi-19) date->string current-date)) +(import (only (ice-9 match) match)) +(import (prefix (dict) dict.)) (import (prefix (re) re.)) +(import (prefix (web server) http.)) +(import (prefix (web request) http.req.)) +(import (prefix (web response) http.res.)) +(import (prefix (web uri) http.uri.)) -;; general functions + ;; general functions, should be extracted to libs (import (only (ice-9 ftw) scandir)) (define (os.listdir path) @@ -14,9 +21,8 @@ (let ([home (getenv "HOME")]) (string.replace path "~" home))) -(import (only (srfi srfi-1) remove)) -(define (rm ls item) - (remove (/. x (eq? x item)) ls)) +(define (os.getenv var) + (getenv var)) (define (set.difference s1 s2) (cond [(null? s1) '()] @@ -31,10 +37,21 @@ (lambda [p] (read-delimited "" p 'concat)))) -;; z program +(import (prefix (ice-9 popen) popen/)) +(define (subprocess.call argv) + (apply system* argv)) + + ;; z program (define *zdir* (os.path.expanduser "~/test-z-wiki")) +(define *about* "\ +# z is a zettelkasten tool + +- notes are stored as markdown with metadata +- filenames serve as the note id's +") + ;; A node 'id' is a monotonically increasing number. ;; It can be represented as a string, in which case it is encoded in @@ -62,7 +79,7 @@ *zdir* (id->string id))) -;; Manipulating nodes + ;; Manipulating nodes (define (list-nodes* dir) (->> dir @@ -79,15 +96,17 @@ 0 (apply max ls))) -(define (make-node title) - (call-with-output-file - (-> (list-nodes) latest-node inc id->path) - (fn [file] - (format file "title: ~a\n" title) - (format file "created: ~a\n" - (date->string (current-date) "~Y.~m.~d..~H.~M")) - (format file "tags:\n") - (display "---\n" file)))) +(define (make-node) + (let ([path (-> (list-nodes) latest-node inc id->path)]) + (call-with-output-file path + + (fn [file] + (format file "title:\n") + (format file "created: ~a\n" + (date->string (current-date) "~Y.~m.~d..~H.~M")) + (format file "tags:\n") + (display "---\n" file))) + path)) (define (read-node id) (readlines (id->path id))) @@ -95,29 +114,140 @@ (define (cat-node id) (prn (read-node id))) -;; Metadata + ;; Metadata -(define (get-title id) - (-> id - read-node +(define (get-title node) + (-> node (re.match "title: ([^\n]*)") - (match:substring 1))) - -(define (get-by-title title) - (let ([index (index-titles)]) - (assoc title index))) + (re.group 1))) -(define (get-tags id) - (-> id - read-node +(define (get-tags node) + (-> node (re.match "tags: ([^\n]*)") (re.group 1) - (string.split #\space))) + (string.split #\space) + seq)) -;; Indexing + ;; Indexing -(define (index-titles) - (fold - (/. node ls (acons (get-title node) node ls)) - '() - (list-nodes))) +(define *tags* (dict.empty)) +(define *titles* (dict.empty)) + +(define (index-node id) + (let ([node (read-node id)]) + (dict.set *titles* (get-title node) id) + (for (get-tags node) + (/. tag + (if tag + (dict.update + *tags* + tag + (/. ids (cons id ids)))))))) + +(define (reindex) + (map index-node (list-nodes))) + + ;; Searching / filtering + +(define (tagged tag) + "returns a list of all files with the given tag" + (dict.get *tags* tag)) + +(define (get-by-title title) + (dict.get *titles* title)) + + ;; Printing + +(define (print-titles) + (for (list-nodes) + (lambda (id) + (pr id) (pr ": ") + (prn (get-title (read-node id)))))) + +(define (print-node id) + (pr (read-node id))) + + ;; webserver + +(define *css* "body{max-width:650px;margin:40px auto;padding:0 10px;font:18px/1.5 -apple-system, BlinkMacSystemFont, \"Segoe UI\", Roboto, \"Helvetica Neue\", Arial, \"Noto Sans\", sans-serif, \"Apple Color Emoji\", \"Segoe UI Emoji\", \"Segoe UI Symbol\", \"Noto Color Emoji\";color:#444}h1,h2,h3{line-height:1.2}@media (prefers-color-scheme: dark){body{color:white;background:#444}a:link{color:#5bf}a:visited{color:#ccf}}") + +(define (template title body) + `(html (head (title ,title)) + (style ,*css*) + (body ,@body))) + +(define* (respond #:optional body #:key + (status 200) + (title "z") + (doctype "<!DOCTYPE html>\n") + (content-type-params '((charset . "utf-8"))) + (content-type 'text/html) + (extra-headers '()) + (sxml (and body (template title body)))) + (values (http.res.build-response + #:code status + #:headers `((content-type + . (,content-type ,@content-type-params)) + ,@extra-headers)) + (lambda (port) + (when sxml + (if doctype (display doctype port)) + (sxml->xml sxml port))))) + +(define (path-components req) + (-> req + http.req.request-uri + http.uri.uri-path + http.uri.split-and-decode-uri-path)) + +(define (routes req body) + (match (path-components req) + ['() + (respond + `((h1 "z") + (ul + ,@(map + (lambda (id) + `(li (a (@ (href ,(fmt "/id/~a" id))) + ,(fmt "~a: ~a" + id (get-title (read-node id)))))) + (list-nodes)))))] + [("id" id) + (let ([node (read-node (string->id id))]) + (respond `((pre ,node)) + #:title (fmt "z - ~a" (get-title node))))] + [("hacker") + (respond "Hello hacker!")] + [_ (respond "not found")])) + + ;; CLI + +(define (usage) + (prn "\ +usage: z [command] +where 'command' is: + <none> create new note + tagged [tag] list notes tagged with 'tag'")) + +(define (main args) + (match (rest args) + ['() + (let ([path (make-node)] + [editor (os.getenv "EDITOR")]) + (subprocess.call (list editor path)) + (exit EXIT_SUCCESS))] + [("ls") (print-titles)] + [("tagged" tag) + (begin + (reindex) + (for (tagged tag) + (lambda (id) + (let* ([node (read-node id)] + [title (get-title node)]) + (pr id) + (pr ": ") + (pr title)))))] + [("web") (begin + (pr "z server") + (http.run-server routes))] + [_ (usage)])) |