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

Tree @master (Download .tar.gz)

generate.scm @master

7d6ea4c
 
 
 
 
97df62c
714c590
97df62c
56dbaec
2423dca
 
7d6ea4c
 
 
 
 
97df62c
7d6ea4c
 
 
 
 
a71ca6b
 
 
7d6ea4c
 
 
 
 
 
a71ca6b
7d6ea4c
a71ca6b
7d6ea4c
 
 
 
 
97df62c
 
 
 
 
 
7d6ea4c
a71ca6b
 
7d6ea4c
61f1f1e
7d6ea4c
 
a71ca6b
 
97df62c
 
58b4ba4
 
 
 
 
 
 
 
 
 
 
94f7f33
58b4ba4
 
 
 
 
 
7d6ea4c
 
97df62c
 
7d6ea4c
97df62c
7d6ea4c
97df62c
7d6ea4c
97df62c
7d6ea4c
97df62c
 
 
7d6ea4c
de0b055
97df62c
 
 
 
7d6ea4c
97df62c
a71ca6b
97df62c
7d6ea4c
97df62c
 
 
7d6ea4c
97df62c
 
 
 
7d6ea4c
97df62c
 
de0b055
7d6ea4c
de0b055
97df62c
 
 
 
 
 
 
 
7d6ea4c
 
 
 
 
 
 
97df62c
a71ca6b
 
 
97df62c
7d6ea4c
97df62c
a71ca6b
 
 
97df62c
 
 
a71ca6b
58b4ba4
a71ca6b
 
 
 
7d6ea4c
97df62c
2423dca
7d6ea4c
 
d674c01
 
 
 
97df62c
7d6ea4c
a71ca6b
 
 
 
 
 
 
7d6ea4c
 
97df62c
7f314bf
7d6ea4c
de0b055
7d6ea4c
a71ca6b
7d6ea4c
 
 
a71ca6b
 
f0c34d6
97df62c
 
 
 
(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)))))