diff options
| -rw-r--r-- | haunt/builder/atom.scm | 7 | ||||
| -rw-r--r-- | haunt/builder/blog.scm | 10 | ||||
| -rw-r--r-- | haunt/site.scm | 14 |
3 files changed, 22 insertions, 9 deletions
diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm index 12b0df5..339c5ef 100644 --- a/haunt/builder/atom.scm +++ b/haunt/builder/atom.scm @@ -24,6 +24,7 @@ (define-module (haunt builder atom) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (sxml simple) #:use-module (haunt site) @@ -43,7 +44,7 @@ "Convert date to ISO-8601 formatted string." (date->string date "~4")) -(define (post->atom-entry post) +(define (post->atom-entry site post) "Convert POST into an Atom <entry> XML node." `(entry (title ,(post-ref post 'title)) @@ -52,7 +53,7 @@ ,(let ((email (post-ref post 'email))) (if email `(email ,email) '()))) (updated ,(date->string* (post-date post))) - (link (@ (href ,(string-append "/" (post-slug post) ".html")) + (link (@ (href ,(string-append "/" (site-post-slug site post) ".html")) (rel "alternate"))) (summary (@ (type "html")) ,(sxml->html-string (post-sxml post))))) @@ -78,7 +79,7 @@ MAX-ENTRIES: The maximum number of posts to render in the feed" (link (@ (href ,(string-append "/" file-name)) (rel "self"))) (link (@ (href ,(site-domain site)))) - ,@(map post->atom-entry + ,@(map (cut post->atom-entry site <>) (take-up-to max-entries (filter posts)))) sxml->xml*))) diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm index f738a09..f2c9a92 100644 --- a/haunt/builder/blog.scm +++ b/haunt/builder/blog.scm @@ -63,7 +63,7 @@ (with-layout theme site title body))) (define (render-list theme site title posts prefix) - (let ((body ((theme-list-template theme) title posts prefix))) + (let ((body ((theme-list-template theme) site title posts prefix))) (with-layout theme site title body))) (define (date->string* date) @@ -88,9 +88,10 @@ " — " ,(date->string* (post-date post))) (div ,(post-sxml post)))) #:list-template - (lambda (title posts prefix) + (lambda (site title posts prefix) (define (post-uri post) - (string-append "/" (or prefix "") (post-slug post) ".html")) + (string-append "/" (or prefix "") + (site-post-slug site post) ".html")) `((h3 ,title) (ul @@ -112,7 +113,8 @@ decorated by THEME, whose URLs start with PREFIX." (lambda (site posts) (define (post->page post) - (let ((base-name (string-append (post-slug post) ".html"))) + (let ((base-name (string-append (site-post-slug site post) + ".html"))) (make-page (make-file-name base-name) (render-post theme site post) sxml->html))) diff --git a/haunt/site.scm b/haunt/site.scm index b1aff44..0ef67ac 100644 --- a/haunt/site.scm +++ b/haunt/site.scm @@ -29,6 +29,7 @@ #:use-module (haunt utils) #:use-module (haunt reader) #:use-module (haunt page) + #:use-module (haunt post) #:use-module (haunt asset) #:export (site site? @@ -37,19 +38,22 @@ site-posts-directory site-build-directory site-default-metadata + site-make-slug site-readers site-builders + site-post-slug build-site)) (define-record-type <site> (make-site title domain posts-directory build-directory - default-metadata readers builders) + default-metadata make-slug readers builders) site? (title site-title) (domain site-domain) (posts-directory site-posts-directory) (build-directory site-build-directory) (default-metadata site-default-metadata) + (make-slug site-make-slug) (readers site-readers) (builders site-builders)) @@ -59,6 +63,7 @@ (posts-directory "posts") (build-directory "site") (default-metadata '()) + (make-slug post-slug) (readers '()) (builders '())) "Create a new site object. All arguments are optional: @@ -68,10 +73,15 @@ POSTS-DIRECTORY: The directory where posts are found BUILD-DIRECTORY: The directory that generated pages are stored in DEFAULT-METADATA: An alist of arbitrary default metadata for posts whose keys are symbols +POST-SLUG: A procedure generating a file name slug from a post READERS: A list of reader objects for processing posts BUILDERS: A list of procedures for building pages from posts" (make-site title domain posts-directory build-directory - default-metadata readers builders)) + default-metadata make-slug readers builders)) + +(define (site-post-slug site post) + "Return a slug string for POST using the slug generator for SITE." + ((site-make-slug site) post)) (define (build-site site) "Build SITE in the appropriate build directory." |