1 files changed, 185 insertions, 91 deletions

@@ -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 <wiki>
+  ;;; 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 <page>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 <wiki> 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 <page>
+  ;;; 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 <wiki> 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 <page> 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 <page>
-  ;;; 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 <page> 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)))