diff options
| author | David Thompson <dthompson2@worcester.edu> | 2023-12-27 09:44:44 -0500 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2023-12-27 09:45:51 -0500 |
| commit | 04a0bab716edc23f6f7fc4f7d7ef002e8381892b (patch) | |
| tree | 36f4858f723f779dce58a524a80c4be47abb45f7 | |
| parent | 1bfbe7c86e26a7599d13e807d0d8af2a18699d19 (diff) | |
builder: blog: Only render pages for posts in collections.
Thanks to Skyler Ferris for pointing out this longstanding bug with
multi-blog configurations.
| -rw-r--r-- | haunt/builder/blog.scm | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm index 5087885..7a1be52 100644 --- a/haunt/builder/blog.scm +++ b/haunt/builder/blog.scm @@ -179,7 +179,7 @@ to POSTS-PER-PAGE posts on each page." (define collection->page (match-lambda - ((title file-name filter) + ((title file-name filtered-posts) ;; Earlier versions of Haunt, which did not have collection ;; pagination, told users to include a full file name, not ;; just a base name, so we continue to honor that style of @@ -187,8 +187,7 @@ to POSTS-PER-PAGE posts on each page." (let ((base-name (if (string-suffix? ".html" file-name) (string-take file-name (- (string-length file-name) 5)) - file-name)) - (filtered-posts (filter posts))) + file-name))) (define (make-collection-page current-page prev-page next-page) (match current-page ((file-name posts) @@ -223,5 +222,19 @@ to POSTS-PER-PAGE posts on each page." filtered-posts prefix)) sxml->html))))))) - (append (map post->page posts) - (append-map collection->page collections)))) + ;; Produce a new collections lists, but with the filters applied + ;; to the actual posts. + (define collections* + (map (match-lambda + ((title file-name filter) + (list title file-name (filter posts)))) + collections)) + + ;; Collect the subset of posts that belong to this blog. Those + ;; are the only posts that will have dedicated pages rendered. + (define posts* + (delete-duplicates + (append-map (match-lambda ((_ _ posts) posts)) collections*))) + + (append (map post->page posts*) + (append-map collection->page collections*)))) |