(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)))))