gdritter repos when-computer / master generator / generate.scm
master

Tree @master (Download .tar.gz)

generate.scm @masterraw · history · blame

(include "types.scm")
(include "telml.scm")
(include "libs.scm")
(include "templates.scm")

(use-modules (srfi srfi-1))
(use-modules (ice-9 match))
(use-modules (ice-9 ftw))



;; Create a folder if it doesn't exist. (There does not
;; appear to be a Guile binding to mkdir -p.)
(define (ensure-folder f)
  (if (not (file-exists? f))
      (mkdir f)))

;; create an output filename from a set of path components,
;; creating the necessary folders if needed, as well.
(define (outfile chunks)
  (define (go rest so-far)
    (ensure-folder so-far)
    (match rest
      (() (++ so-far "/index.html"))
      ((x . xs) (go xs (++ so-far "/" (as-string x))))))
  (go chunks "output"))

;; create a URL from a set of path components
(define (url chunks)
  (define (go rest so-far)
    (match rest
       (()       (++ so-far "/"))
       ((x . xs) (go xs (++ so-far "/" (as-string x))))))
  (go chunks ""))

;; Grab all the posts and their metadata from the posts folder,
;; sorted by creation time. This does unnecessary work right
;; now; parsing all of them just to get the first metadata tag
;; out of them.
(define (get-all-posts)
  (let* ((files (cddr (file-system-tree "posts")))
         (files-sorted (sort files (lambda (x y)
                                     (> (stat:mtime (cadr x))
                                        (stat:mtime (cadr y)))))))
    (map (lambda (file-entry)
           (let* ((filename (string-append "posts/" (car file-entry)))
                  (telml (translate-file filename))
                  (metadata (telml-meta telml)))
             (make-post filename
                        (localtime (meta-date metadata))
                        (meta-slug metadata)
                        (meta-title metadata)
                        (meta-tags metadata)
                        (telml-content telml))))
         files-sorted)))

;; This should be factored out better, but for now... eh...
(define (get-all-feed-posts)
  (let* ((files (cddr (file-system-tree "posts")))
         (files-sorted (sort files (lambda (x y)
                                     (> (stat:mtime (cadr x))
                                        (stat:mtime (cadr y)))))))
    (map (lambda (file-entry)
           (let* ((filename (string-append "posts/" (car file-entry)))
                  (telml (translate-feed-file filename))
                  (metadata (telml-meta telml)))
             (make-post filename
                        (localtime (meta-date metadata))
                        (meta-slug metadata)
                        (meta-title metadata)
                        (meta-tags metadata)
                        (telml-content telml))))
         files-sorted)))

;; Turn a post into an <li> element with appropriate
;; link and date.
(define (post->list-elem post)
  (let* ((date (date->string (post-time post)))
         (href (post-url post))
         (title (post-title post)))
    `(li ,(++ date ": ") (a (@ (href ,href)) ,title))))

;; Turn a tag into an <li> element with the appropriate link
(define (tag->list-elem tag)
  (let ((url (url (list 'tag tag))))
    `(li (@ (class tag-entry))
         (a (@ (href ,url)) ,tag))))

;; Generate the archive page
(define (archive)
  (let* ((posts (get-all-posts))
         (list `(div (@ (class archive-list))
                     (ul
                      ,(map post->list-elem posts)))))
    (with-output-to-file (outfile '(archive))
      (lambda ()
        (display (sxml->html5 (page (url '(archive)) "archive" list)))))))

;; Flatten a list
(define (concat list)
  (apply append list))

;; Get the list of all tags
(define (get-tag-list posts)
  (let ((c (concat (map post-tags posts))))
    (delete-duplicates (sort c string<?))))

;; Get the list of all posts that are tagged with a given tag
(define (get-posts-with-tag tag posts)
  (filter (lambda (post) (member tag (post-tags post))) posts))

;; Generate all tag-related pages
(define (tags)
  (let* ((posts (get-all-posts))
         (tags (get-tag-list posts))
         (tag-list `(div (@ (class archive-list))
                         (ul
                          ,(map tag->list-elem tags)))))

    (define (mk-tag-page tag)
      (let* ((ps (get-posts-with-tag tag posts))
             (content `(div (@ (class archive-list))
                            "pages tagged "
                            (span (@ (class tag)) ,tag)
                            ":"
                            (ul
                             ,(map post->list-elem ps)))))
        (with-output-to-file (outfile (list 'tag tag))
          (lambda ()
            (display (sxml->html5 (page (url (list 'tag tag))
                                        tag
                                        content)))))))

    (with-output-to-file (outfile '(tags))
      (lambda ()
        (display (sxml->html5 (page (url '(tags))
                                    "tags"
                                    tag-list)))))

    (map mk-tag-page tags)))

(define (feed)
  (let ((posts (get-all-feed-posts)))
    (with-output-to-file "output/feed.xml"
      (lambda ()
        (display (serialize-sxml (atom-feed posts)))))))

;; Load a telml page and turn it into an html page
(define (main pg file out)
  (let* ((page-source (translate-file file))
         (telml   (telml-content page-source))
         (meta    (telml-meta page-source))
         (date    (localtime
                   (or (and meta
                            (meta-date meta))
                      (stat:mtime (stat file)))))
         (ndate   (date->string date))
         (title   (if meta (meta-title meta) pg))
         (target  (outfile (if out out
                               (list ndate (meta-slug meta)))))
         (url     (url (if out out
                           (list ndate (meta-slug meta)))))
         (display (sxml->html5 (page url
                                     title
                                     (add-tags telml (meta-tags meta))))))
    (format #t "printing to ~a\n" target)
    (with-output-to-file target
      (lambda () (format #t "~a\n" display)))))

;; Figure out which page is supposed to be generated
(define (dispatch pg files)
  (match pg
     ("index"   (main "index" (car files) '()))
     ("post"    (map (lambda (f) (main "post" f #f)) files))
     ("archive" (archive))
     ("tags"    (tags))
     ("about"   (main "about" "pages/about.telml" '(about)))
     ("feed"    (feed))))

(let ((args (cdr (command-line))))
  (cond ((= (length args) 0)
         (format #t "Usage: generate [page] [files]\n"))
        (else (dispatch (car args) (cdr args)))))