dustycloud/flat-files.scm

;;; Spritely Institute website
;;; Copyright © 2022 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;;
;;; Site code and contents dual licensed under CC BY 4.0 and Apache v2.

(define-module (flat-files)
  #:use-module (ice-9 control)
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (haunt html)
  #:use-module (haunt site)
  #:use-module (haunt reader)
  #:use-module (haunt artifact)
  #:export (flat-files))

;; For storing intermediate data while walking the tree
(define-record-type <walked>
  (make-walked dir entries)
  walked?
  (dir walked-dir)
  (entries walked-entries))

(define (default-template site posts body metadata)
  (define title (assoc-ref metadata 'title))
  `((doctype "html")
    (html
     (head
      (meta (@ (charset "utf-8")))
      (title ,(if title
                  (string-append title " — " (site-title site))
                  (site-title site))))
     (body ,body))))

(define default-templates
  `((default . ,default-template)))

(define* (flat-files directory 
                     #:key
                     (templates default-templates)
                     (default-metadata '())
                     (skip-unrecognized? #t))
  (lambda (site posts)
    (define (flat-file->sxml path return-early)
      (define reader
        (or (find (lambda (reader)
                    (reader-match? reader path))
                  (site-readers site))
            ;; escape early if nothing found... files we don't have
            ;; readers for are skipped
            (if skip-unrecognized?
                (return-early)
                (error "No reader for file:" path))))
      (define-values (file-metadata file-sxml)
        ((reader-proc reader) path))
      (define metadata
        (append file-metadata default-metadata))
      (define template-name
        (or (and=> (assoc-ref metadata 'template) string->symbol)
            'default))
      (define template
        (or (assoc-ref templates template-name)
            (error "No such template: " template-name)))
      (template site posts file-sxml metadata))
    (define enter? (const #t))       ; enter all subdirectories
    (define (leaf path stat result)  ; render a file
      (call/ec
       (lambda (return)
         (define (return-early)
           (return result))
         (match result
           (($ <walked> dir entries)
            (let* ((in-basename (basename path))
                   (out-filename
                    (cond
                     ;; If the file (sans extension suffix) ends with __index,
                     ;; then the user wants us to put this under <foo>/index.html
                     ((string-match "^(.+)__index\\..+$" in-basename)
                      =>
                      (lambda (sm)
                        (regexp-substitute #f sm
                                           1 file-name-separator-string
                                           "index.html")))
                     ;; Otherwise, just write this as <foo>.html
                     (else
                      (regexp-substitute #f (string-match "^(.+)\\..+$"
                                                          in-basename)
                                         1 ".html"))))
                   (out-filename-with-path
                    (string-join (cdr (reverse (cons out-filename dir)))
                                 file-name-separator-string))
                   (contents (flat-file->sxml path return-early))
                   (entry (serialized-artifact out-filename-with-path
                                               contents
                                               sxml->html)))
              (make-walked dir (cons entry entries))))))))
    ;; keep track of the current subdirectory we're in
    (define (down path stat result)  ; add to current-dir stack
      (match result
        (($ <walked> dir entries)
         (make-walked (cons (basename path) dir)
                      entries))))
    (define (up path stat result)    ; pop from current-dir stack
      (match result
        (($ <walked> dir entries)
         (make-walked (cdr dir)
                      entries))))
    (define (skip path stat result) result)    ; no-op
    (define (err file-name stat errno result)
      (error "file processing failed with errno: " file-name errno))
    (walked-entries
     (file-system-fold enter? leaf down up skip err
                       (make-walked '() '()) directory))))