From 6ecd50fb45c0876bdb588c1e820991ee680631b0 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 29 Mar 2023 23:51:02 -0500 Subject: Reorganize --- src/wikme.scm | 275 ---------------------------------------------------------- 1 file changed, 275 deletions(-) delete mode 100644 src/wikme.scm (limited to 'src/wikme.scm') diff --git a/src/wikme.scm b/src/wikme.scm deleted file mode 100644 index 14167d6..0000000 --- a/src/wikme.scm +++ /dev/null @@ -1,275 +0,0 @@ -;;;; wikme --- build a static wiki out of a folder of markdown files - -(import (cmark) - (srfi-152) - (utf8) - (chicken file) - (chicken file posix) - (chicken irregex) - (chicken pathname) - (chicken port) - (chicken process) - (chicken process-context) - (chicken string) - (chicken time posix)) - - -;;; Wiki - -(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 - page-template ; template for pages - file-transformers ; list of filename transformers - transformers ; list of source transformer functions - pages ; list of s - ) - 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)) - (page-template wiki-page-template (setter wiki-page-template)) - (file-transformers wiki-file-transformers (setter wiki-file-transformers)) - (transformers wiki-transformers (setter wiki-transformers)) - (pages wiki-pages (setter wiki-pages))) - -(define (directory->wiki directory - #!key - base-url - destination-directory - page-template - (extension "md") - (file-transformers (list indexify)) - (transformers (list cmark->html wikify-links))) - ;;; Build a out of the markdown files in DIRECTORY. - ;; The given keyword arguments will fill out the other fields in the result. - - (define wiki - (make-wiki base-url - directory - destination-directory - page-template - file-transformers - transformers - '())) - - (set! (wiki-pages wiki) - (map (lambda (f) (file->page f wiki)) - (glob (make-pathname directory "*.md")))) - - wiki) - - -;;; Pages - -(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 ; file containing the markup - destination ; destination file - 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-source)) - (origin page-origin (setter page-origin)) - (destination page-destination (setter page-destination)) - (wiki page-wiki (setter page-wiki)) - (meta page-meta (setter page-meta))) - -(define (page-meta-ref page key) - ;;; Get metadata KEY from PAGE. - (cdr (assq 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)))) - -(define (basename file) - (let-values (((_ base _) (decompose-pathname file))) - base)) - -(define (indexify fname outdir) - ;;; Transform a FILENAME of the form ..dir/name.md to outdir/name/index.html. - (make-pathname (list outdir (basename fname)) "index" "html")) - -(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) (submatch (nonl)) (* any)) - str))) - (if (irregex-match-data? m) - (irregex-match-substring m 1) - (unslugify (basename (page-origin page)))))) - -(define (guess-last-updated page) - ;;; Guess when PAGE was last edited. - ;; Tries to use git, but falls back to mtime. - (let ((f (page-origin page))) - (time->string - (seconds->local-time - (or (string->number - (string-trim-both - (with-input-from-pipe - (string-join '("git" "log" "-1" "--format=%ct" "--date=unix" - "-C" (wiki-origin-dir (page-wiki page)) - f) - " ") - read-string))) - (file-modification-time f)))))) - -(define (file->page file wiki) - ;;; Create a from FILE in WIKI. - ;; Wraps make-page for easier use. - (define source - (with-input-from-file file read-string)) - (define page - (make-page source - (apply transform source (wiki-transformers wiki)) - file - (apply file-transform - file - (wiki-destination-dir wiki) - (wiki-file-transformers wiki)) - wiki - '())) - - (page-meta-set! page 'title (guess-title page)) - (page-meta-set! page 'last-updated (guess-last-updated page)) - - page) - - -;;; Wiki links - -(define wiki-link-sre - ;;; An SRE for [[wiki-style links|with optional titles]]. - '(: "[[" - (submatch-named page (+ (~ "|"))) - (? (submatch "|" (submatch-named title (*? nonl)))) - "]]")) - -(define (wikify-links text) - ;;; Convert [[Wiki-style links]] to HTML style in TEXT. - (irregex-replace/all wiki-link-sre text - (lambda (m) - (let* ((page (irregex-match-substring m 'page)) - (title (or (irregex-match-substring m 'title) - page))) - (string-append - "" title ""))))) - -(define (linkify pagename) - ;;; Turn a page name into a link suitable for an tag. - (string-append (base-url) "/" (slugify pagename) "/index.html")) - -(define (string-capitalize str) - ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase. - ;; Stolen and adapted from MIT/GNU Scheme - (let* ((end (string-length str)) - (str* (make-string end))) - (do ((i 0 (+ i 1))) - ((= i end)) - (string-set! str* i ((if (= i 0) char-upcase char-downcase) - (string-ref str i)))) - str*)) - -(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 (unslugify slug) - ;;; 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 '("-") slug " ")) - - -;;; Transform source - -(define (transform source . transformers) - ;;; Transform SOURCE to html by passing it through a series of TRANSFORMERS. - ;; Each TRANSFORMER should be a one-argument procedure taking and returning a - ;; string. - (let loop ((transformers transformers) - (output source)) - (if (null? transformers) - output - (loop (cdr transformers) - ((car transformers) output))))) - -(define (file-transform origin destination-directory . transformers) - ;;; Transform ORIGIN to a DESTINATION filename using TRANSFORMERS. - ;; Each TRANSFORMER will be called with two arguments: the ORIGIN filaname and - ;; the DESTINATION-DIRECTORY. It should return the transformed filename. - (let loop ((transformers transformers) - (destination origin)) - (if (null? transformers) - destination - (loop (cdr transformers) - ((car transformers) origin destination-directory))))) - - -;;; Templates - -(define (render 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. - (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 (string-append "{{" key "}}") val) - (cons (string-append "{{ " key " }}") val)) - env)))))) - -(define (render-page template page) - ;;; Render PAGE with its metadata using TEMPLATE. - (render template `((title . ,(page-meta-ref 'title page)) - (body . ,(page-body page)) - (last_updated ,(page-meta-ref 'last-updated page)) - ;; TODO: backlinks and what-not - ))) - - -;;; Wikify - -(define (render-wiki wiki) - ;;; Render the files in WIKI to disk. - (create-directory (wiki-destination-dir wiki) #:parents) - (for-each (lambda (page) - (with-output-to-file (page-destination page) - (lambda () - (write-string - (render-page (wiki-page-template wiki) page))))) - (wiki-pages wiki))) -- cgit 1.4.1-21-gabe81