From 42474bb6c851314d804c89b1501b49eed0e6005f Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 3 Apr 2023 08:57:02 -0500 Subject: It builds now --- .dir-locals.el | 4 + .gitignore | 3 +- Makefile | 15 ++- README.txt | 5 +- main.scm | 8 ++ test/birds.md | 5 + test/template.html | 6 ++ wikme-impl.scm | 290 +++++++++++++++++++++++++++++++++++++++++++++++++++++ wikme-module.scm | 275 -------------------------------------------------- wikme.scm | 56 +---------- 10 files changed, 335 insertions(+), 332 deletions(-) create mode 100644 .dir-locals.el create mode 100644 main.scm create mode 100644 test/birds.md create mode 100644 test/template.html create mode 100644 wikme-impl.scm delete mode 100644 wikme-module.scm diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..9c78ce8 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,4 @@ +;;; Directory Local Variables -*- no-byte-compile: t -*- +;;; For more information see (info "(emacs) Directory Variables") + +((scheme-mode . ((geiser-scheme-implementation . chicken)))) diff --git a/.gitignore b/.gitignore index 8270092..637f6da 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ wikme -ref/ +*.so +*.o diff --git a/Makefile b/Makefile index 7b5b337..506d366 100644 --- a/Makefile +++ b/Makefile @@ -1,11 +1,20 @@ # wikme PREFIX = /usr/bin +CSC = csc -I$(PWD) -wikme: wikme.scm wikme-module.scm - csc -o $@ wikme.scm +OBJ = wikme.scm.o -.PHONY: install +wikme: main.scm $(OBJ) + $(CSC) -o $@ $(OBJ) -uses wikme main.scm + +$(OBJ): wikme.scm wikme-impl.scm + $(CSC) -c -J wikme.scm -unit wikme -o $@ + +.PHONY: install clean install: wikme install -Dt $(DESTDIR)$(PREFIX)/$@ $< + +clean: + rm -f *.import.scm *.so *.o diff --git a/README.txt b/README.txt index 8fd6f44..ed0c990 100644 --- a/README.txt +++ b/README.txt @@ -7,13 +7,16 @@ requirements: - cmark - chicken scheme with the following eggs: - cmark + - regex + - srfi-13 - srfi-152 - utf8 build: +- ./bootstrap - make install: -- make install +- make install diff --git a/main.scm b/main.scm new file mode 100644 index 0000000..c3e4554 --- /dev/null +++ b/main.scm @@ -0,0 +1,8 @@ +(import wikme + (chicken process-context)) + +(define (main args) + (display (wikify-links "Hi from [[wikme]]!")) + (newline)) + +(main (command-line-arguments)) diff --git a/test/birds.md b/test/birds.md new file mode 100644 index 0000000..0a02800 --- /dev/null +++ b/test/birds.md @@ -0,0 +1,5 @@ +# Birds! + +Birds are pretty cool, you know. It's true. + +Let's test a link to [[lions]] now. diff --git a/test/template.html b/test/template.html new file mode 100644 index 0000000..3de5bf2 --- /dev/null +++ b/test/template.html @@ -0,0 +1,6 @@ + +{{ title }} + + + {{body}} + diff --git a/wikme-impl.scm b/wikme-impl.scm new file mode 100644 index 0000000..2097af7 --- /dev/null +++ b/wikme-impl.scm @@ -0,0 +1,290 @@ +;;; 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)))))) + diff --git a/wikme-module.scm b/wikme-module.scm deleted file mode 100644 index 14167d6..0000000 --- a/wikme-module.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))) diff --git a/wikme.scm b/wikme.scm index b0a5177..10b1a1a 100644 --- a/wikme.scm +++ b/wikme.scm @@ -1,52 +1,4 @@ -;;; wikme.scm --- build a wiki from a folder of markdown --- executable - -(import (args) - (chicken pathname) - (chicken process-context) - (chicken port)) - -(include "wikme-module") - - - -(define +opts+ - (list (args:make-option - (u base-url) (optional: "URL") - "Base URL for the generated Wiki.") - (args:make-option - (s source) (optional: "DIRECTORY") - "Directory containing source files (default: PWD).") - (args:make-option - (o out) (optional: "DIRECTORY") - "Directory in which to place rendered files (default: PWD/out).") - (args:make-option - (t template) (optional: "FILE") - "Template file for wiki pages (default: PWD/template.html)."))) - - - -(define (usage) - (with-output-to-port (current-error-port) - (lambda () - (print "Usage: " (car (argv)) " [options...]") - (newline) - (print (args:usage +opts+)))) - (exit 1)) - -(define (main args) - (receive (options operands) - (args:parse args +opts+) - (render-wiki - (directory->wiki - (or (alist-ref 'source options) - (current-directory)) - #:base-url (or (alist-ref 'base-url options) - "https://www.example.com") - #:destination-directory (or (alist-ref 'out options) - (make-pathname - (current-directory) "out")) - #:page-template (or (alist-ref 'template options) - (make-pathname - (current-directory) "template.html")))))) - -(main (command-line-arguments)) +(module wikme * + (import scheme + (chicken base)) + (include "wikme-impl.scm")) -- cgit 1.4.1-21-gabe81