From 246b99687121b3863a931945aa2f3b259adb905a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 29 Mar 2023 23:18:06 -0500 Subject: Begin on executable --- src/wikme.scm | 276 +++++++++++++++++++++++++++++++++++++++------------------- wikme.scm | 39 +++++++++ 2 files changed, 224 insertions(+), 91 deletions(-) create mode 100644 wikme.scm diff --git a/src/wikme.scm b/src/wikme.scm index 187864e..2d476ca 100644 --- a/src/wikme.scm +++ b/src/wikme.scm @@ -1,69 +1,150 @@ -;;; wikme --- build a static wiki out of a folder of markdown files +;;;; 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 string)) + (chicken process) + (chicken process-context) + (chicken string) + (chicken time posix)) -;;; 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)) +;;; 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 + (extension "md") + (base-url "https://www.example.com") + (destination-directory (make-pathname directory "out")) + (page-template (make-pathname directory "template.html")) + (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 + file-transformers + transformers + '())) + + (set! wiki-pages (map (lambda (f) (file->page f wiki)) + (glob (make-pathname directory "*.md")))) + + wiki) -;;; Templates +;;; Pages -(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-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 (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 (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 @@ -130,48 +211,61 @@ (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 - ) +(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))))) -;;; Pages +;;; Templates -(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 (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 (file->page file - #!key - (transformers (config-get 'transformers)) - (destination )) - ;;; Create a from FILE. - ;; Wraps make-page for easier use. +(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 + ))) -;;; Writing files +;;; Wikify -(define (publish file config) - ;;; Publish FILE, using CONFIG. - ;; CONFIG should be a configuration alist, which see above. - #f) +(define (render-wiki wiki) + ;;; Render the files in WIKI to disk. + (for-each (lambda (page) + (with-output-to-file (page-destination page) + (lambda () + (write-string (render-page (wiki-page-template wiki) page))))) + (wiki-pages wiki))) diff --git a/wikme.scm b/wikme.scm new file mode 100644 index 0000000..7f992a3 --- /dev/null +++ b/wikme.scm @@ -0,0 +1,39 @@ +;;; wikme.scm --- build a wiki from a folder of markdown --- executable + +(import (args) + (chicken process-context) + (chicken port)) + +(include "src/wikme") + + + + ;; (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 + ;; ) + + +(define options + (list (args:make-option ))) + + + +(define (usage) + (with-output-to-port (current-error-port) + (lambda () + (print "Usage: " (car (argv)) " [options...] [directory]") + (newline) + (print (args:usage options)))) + (exit 1)) + +(define (main args) + (receive (options operands) + (args:parse args options) + #f)) + +(main (command-line-arguments)) -- cgit 1.4.1-21-gabe81