From 6d7bbec15031d689022c8e5155b81c15784f7deb Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 29 Mar 2023 21:21:14 -0500 Subject: Initial commit (oops) --- src/wikme.scm | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 src/wikme.scm (limited to 'src') diff --git a/src/wikme.scm b/src/wikme.scm new file mode 100644 index 0000000..187864e --- /dev/null +++ b/src/wikme.scm @@ -0,0 +1,177 @@ +;;; wikme --- build a static wiki out of a folder of markdown files + +(import (cmark) + (srfi-152) + (utf8) + (chicken irregex) + (chicken port) + (chicken string)) + + +;;; Configuration + +(define site-config + (make-parameter `((base-url . "https://www.example.com") + ;; These default directories aren't .. great. + (source-dir . "src") + (output-dir . "out") + (transformers . ,(list commonmark->html + wikify-links)) + (filename-transform + . (lambda (fname) + (md->index-html fname))) + (page-environment + . ((title + . ,(lambda (page) + (cdr (assq 'title (page-meta page))))) + (body + . ,(lambda (page) + (page-body page))) + (last_updated + . ,(lambda (page) + (cdr (assq 'last-updated (page-meta page)))))))))) + +(define (config-get x) + (if (assq x (site-config)) + (cdr (assq x (site-config))) + #f)) + + +;;; 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)))))) + + +;;; 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 (md->index-html filename) + ;;; Transform a FILENAME of the form dir/name.md to dir/name/index.html. + ;; Uses source + ) + + +;;; 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 body origin destination meta) + page? + (source page-source ; source markup + (setter page-source)) + (body page-body ; rendered page body + (setter page-source)) + (origin page-origin ; file containing the markup + (setter page-origin)) + (destination page-destination ; destination file + (setter page-destination)) + (meta page-meta ; alist of metadata tags + (setter page-meta))) + +(define (page-meta-ref key page) + ;;; Get metadata KEY from PAGE. + (cdr (assq key (page-meta page)))) + +(define (file->page file + #!key + (transformers (config-get 'transformers)) + (destination )) + ;;; Create a from FILE. + ;; Wraps make-page for easier use. + + ) + + +;;; Writing files + +(define (publish file config) + ;;; Publish FILE, using CONFIG. + ;; CONFIG should be a configuration alist, which see above. + #f) -- cgit 1.4.1-21-gabe81