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-impl.scm | 290 --------------------------------------------------------- 1 file changed, 290 deletions(-) delete mode 100644 wikme-impl.scm (limited to 'wikme-impl.scm') diff --git a/wikme-impl.scm b/wikme-impl.scm deleted file mode 100644 index 2097af7..0000000 --- a/wikme-impl.scm +++ /dev/null @@ -1,290 +0,0 @@ -;;; Wikme --- convert a directory of markdown files into a static wiki - -(import (chicken file) - (chicken file posix) - (chicken format) - (chicken io) - (chicken irregex) - (chicken pathname) - (chicken port) - (chicken process) - (chicken process-context) - (chicken string) - (chicken time posix) - (cmark) - (regex) ; XXX: deprecated upstream - (srfi-13)) - -;;; 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]]. - '(: "[[" - (submatch-named pname (+ (~ "|"))) - (? (submatch "|" (submatch-named ptitle (*? nonl)))) - "]]")) - -(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))))) - -(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 #\/)))))) - -;;; 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 (path-relativize (page-origin page) - (wiki-origin-dir (page-wiki 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)))))) - -- cgit 1.4.1-21-gabe81