From a1cde11d5ebe95a365120eb5aeb7f65469e44b30 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 3 Apr 2023 22:07:04 -0500 Subject: Changes and stuff I have done a bad job of documenting what I'm doing - it builds now - run `make` - it builds the pages in test/ and links them - ... that's it --- wikme.ss | 329 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 329 insertions(+) create mode 100644 wikme.ss (limited to 'wikme.ss') diff --git a/wikme.ss b/wikme.ss new file mode 100644 index 0000000..cc7aac1 --- /dev/null +++ b/wikme.ss @@ -0,0 +1,329 @@ +;;; Wikme --- convert a directory of markdown files into a static wiki + +;;; Records + +(define-record-type + ;;; A wiki is a collection of pages and assorted metadata. + (make-wiki base-url ; base URL for links + origin-dir ; origin directory + destination-dir ; destination directory + pages ; list of s + defaults ; alist of default properties for pages + ) + wiki? + (base-url wiki-base-url (setter wiki-base-url)) + (origin-dir wiki-origin-dir (setter wiki-origin-dir)) + (destination-dir wiki-destination-dir (setter wiki-destination-dir)) + (pages wiki-pages (setter wiki-pages)) + (defaults wiki-defaults (setter wiki-defaults))) + +(define (wiki-default-ref wiki key) + (alist-ref key (wiki-defaults wiki))) + +(define (wiki-default-set! wiki key value) + (set! (wiki-defaults wiki) (cons (cons key value) + (wiki-defaults wiki)))) + +(define-record-type + ;;; A wiki page is a mapping between source and body content, and between the + ;;; page's origin and its destination files, wrapped together with some + ;;; metadata. + (make-page source ; source markup + body ; rendered page body + origin ; source filename (relative to wiki) + destination ; destination file (relative to wiki) + template ; this page's template + source-transformers ; list of source transformer functions + path-transformers ; list of path transformers + wiki ; the this page is a part of + meta ; alist of metadata tags + ) + page? + (source page-source (setter page-source)) + (body page-body (setter page-body)) + (origin page-origin (setter page-origin)) + (destination page-destination (setter page-destination)) + (template page-template (setter page-template)) + (source-transformers page-source-transformers (setter page-source-transformers)) + (path-transformers page-path-transformers (setter page-path-transformers)) + (wiki page-wiki (setter page-wiki)) + (meta page-meta (setter page-meta))) + +(define (page-meta-ref page key) + ;;; Get metadata KEY from PAGE. + (alist-ref key (page-meta page))) + +(define (page-meta-set! page key value) + ;;; Set KEY in PAGE's metadata to VALUE. + (set! (page-meta page) (cons (cons key value) + (page-meta page)))) + +;;; Transformers + +(define (transform page input transformers) + (let loop ((ts transformers) + (it input)) + (if (null? ts) + it + (loop (cdr ts) + ;; This is ugly but I need it for some things (namely, `indexify'). + ;; Transformers can add an #!optional _ parameter to ignore it. + ((car ts) it page))))) + +(define (transform-source! page) + ;;; Transform PAGE's source to html. + ;; Passes page-source through each of page-transformers in order and sets + ;; page-body to the result. + (set! (page-body page) + (transform page (page-source page) (page-source-transformers page)))) + +(define (transform-path! page) + ;;; Transform PAGE's path from input directory to output directory. + ;; This will take the page-origin and transform it using + ;; page-path-transformers. It will then set page-destination to the result. + (set! (page-destination page) + (transform page (page-origin page) (page-path-transformers page)))) + +;; Cmark wrapper +(define (page-cmark->html input #!optional page) + (cmark->html input (page-meta-ref page 'safe))) + +;;; Templates + +(define (render-template template env) + ;;; Render TEMPLATE using ENV. + ;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value + ;; pairs to insert into the TEMPLATE's placeholders. + ;; XXX: Depends on the deprecated library (regex) which is just glue around + ;; irregex (apparently). + (string-substitute* template (env->replacements env))) + +(define (env->replacements env) + ;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...). + ;; X's are template variables and Y's are the values of those variables. In + ;; the template, both "{{X}}" and "{{ X }}" will be replaced. + ;; If Y is a thunk, call it. + (let loop ((env env) + (res '())) + (if (null? env) + res + (let* ((this (car env)) + (rest (cdr env)) + (key (->string (car this))) + (val (if (procedure? (cdr this)) + ((cdr this)) + (->string (cdr this))))) + (loop (cdr env) + (append (list (cons (sprintf "{{~a}}" key) val) + (cons (sprintf "{{ ~a }}" key) val)) + res)))))) + +(define (render page) + (render-template (page-template page) + (append `((source . ,(page-source page)) + (body . ,(page-body page)) + (origin . ,(page-origin page)) + (destination . ,(page-destination page))) + (page-meta page)))) + +;;; Links + +(define wiki-link-sre + ;;; An SRE for [[wiki-style links|with optional titles]]. + ;; XXX + '(: "[[" + (=> pname (*? (~ "|"))) + (? ($ "|" (=> ptitle + (*? (~ "]"))))) + "]]")) + +(define (wikify-links text #!optional page) + ;;; Convert [[Wiki-style links]] to tags in TEXT. + ;; The base url of PAGE's wiki is prepended to the generated links. + (irregex-replace/all wiki-link-sre + text + (lambda (m) + (let* ((pname (irregex-match-substring m 'pname)) + (ptitle (or (irregex-match-substring m 'ptitle) + pname))) + (sprintf "~a" + (linkify pname + (if page + (wiki-base-url + (page-wiki page)) + "")) + ptitle))))) + +;;; TODO: merge linkify and indexify ... they're almost the same thing. +(define (linkify pagename base-url) + ;;; Turn a page name into a link suitable for an tag. + (make-pathname (list base-url (slugify pagename)) + "index" + "html")) + +(define (slugify str) + ;;; Convert STR to a 'slug', that is, another string suitable for linking. + ;; This function will return the input string, in sentence case, and with all + ;; punctuation and spaces converted to a hypen. + (string-capitalize + (string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-") + (lambda (c) + (char=? c #\-))))) + +(define (string-capitalize str) + ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase. + ;; Returns the new string. + (let loop ((cs (string->list str)) + (it #f)) + (if (null? cs) + (reverse-list->string it) + (loop (cdr cs) + (if it + (cons (char-downcase (car cs)) it) + (list (char-upcase (car cs)))))))) + +(define (unslugify str) + ;;; Convert a SLUG back into a normal string as best as possible. + ;; Because information is lost in slugification, it's impossible to be sure + ;; that the result of this procedure is totally accurate. That is, + ;; slugification is not round-trippable. + (irregex-replace/all "-" str " ")) + +(define (path-relativize path dir) + ;;; Return PATH relative to DIR. + ;; Currently, this doesn't do anything special if PATH begins with / or ~ ... + ;; it probably should. + (let ((path (normalize-pathname path)) + (dir (normalize-pathname dir))) + (make-pathname + dir + (string-trim (string-drop path (string-prefix-length path dir)) + (lambda (c) (char=? c #\/)))))) + +(define (wiki-page-origin-path page #!optional wiki) + ;;; Return PAGE's origin path in WIKI. + (path-relativize (page-origin page) + (wiki-origin-dir (or wiki + (page-wiki page))))) + +(define (wiki-page-destination-path page #!optional wiki) + ;;; Return PAGE's destination path in WIKI. + (path-relativize (page-destination page) + (wiki-destination-dir (or wiki + (page-wiki page))))) + +;;; Build a page + +(define (file->page file wiki + #!key + (source + (with-input-from-file file read-string)) + (template + (wiki-default-ref wiki 'template)) + (source-transformers + (wiki-default-ref wiki 'source-transformers)) + (path-transformers + (wiki-default-ref wiki 'path-transformers))) + (let ((page (make-page source + #f + (path-relativize file (wiki-origin-dir wiki)) + #f + (with-input-from-file template read-string) + source-transformers + path-transformers + wiki + '()))) + (transform-source! page) + (page-meta-set! page 'title (guess-title page)) + (page-meta-set! page 'last-updated (guess-last-updated page)) + (transform-path! page) + (set! (wiki-pages wiki) (cons page (wiki-pages wiki))) + page)) + +(define (guess-title page) + ;;; Guess the title from PAGE. + ;; If the first line is a Markdown H1 ("# ..."), use that as the title. + ;; Otherwise, unslugify the basename of the PAGE file to use as the title. + (let* ((str (page-body page)) + (m (irregex-match '(: "#" (* whitespace) ($ (* nonl)) (* any)) + str))) + (if (irregex-match-data? m) + (irregex-match-substring m 1) + (unslugify (basename (page-origin page)))))) + +(define (basename file) + (receive (_ base _) (decompose-pathname file) + base)) + +(define (indexify _origin page) + ;;; Transform a PAGE's filename from a markdown source to an html destination. + (make-pathname (slugify (page-meta-ref page 'title)) + "index" + "html")) + +(define (guess-last-updated page) + ;;; Guess when PAGE was last edited. + ;; Tries to use git, but falls back to mtime. + (let ((f (wiki-page-origin-path page))) + (time->string + (seconds->local-time + (or #; + (string->number + (string-trim-both + (with-input-from-pipe + (sprintf "git log -1 --format=%ct --date=unix -C ~s ~s" + (wiki-origin-dir (page-wiki page)) + f) + read-string))) + (file-modification-time f)))))) + +(define (page->file page) + ;;; Write PAGE to its destination file. + (let ((dest (make-pathname (wiki-destination-dir (page-wiki page)) + (page-destination page)))) + (receive (dir _ _) (decompose-pathname dest) + (create-directory dir 'parents)) + (with-output-to-file dest + (lambda () + (write-string (render page)))))) + +(define (eprintf . args) + (apply fprintf (current-error-port) args)) + +(define (build-wiki origin + #!key + (destination (make-pathname origin "out")) + (base-url "") + (base-template (make-pathname origin "template.html")) + (source-transformers (list page-cmark->html wikify-links)) + (path-transformers (list indexify)) + (source-extension "md")) + (define w (make-wiki + base-url + origin + destination + '() + `((template . ,base-template) + (source-transformers . ,source-transformers) + (path-transformers . ,path-transformers) + (source-extension . ,source-extension)))) + + (eprintf "\nBuilding pages...\n") + (for-each (lambda (f) + (let ((p (file->page f w))) + (eprintf "~a -> ~a\n" f (page-meta-ref p 'title)))) + (glob (make-pathname origin + "*" + (wiki-default-ref w 'source-extension)))) + + (let ((dd (wiki-destination-dir w))) + (eprintf "\nCreating destination directory: ~a\n" dd) + (create-directory dd 'parents)) + + (eprintf "\nWriting pages...\n") + (for-each (lambda (p) + (eprintf "~a -> ~a\n" + (page-meta-ref p 'title) + (wiki-page-destination-path p)) + (page->file p)) + (wiki-pages w))) -- cgit 1.4.1-21-gabe81