summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>2019-05-10 19:07:03 -0400
committerJakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>2019-05-10 19:07:03 -0400
commiteceaf45e8c353c8cfd2ae88f39f523f028509a0c (patch)
treec62dfee90df4e31b0a8ded6662cdd1a512d382d5
parent2eec3c376a72c7edf8ae363cc11c8abe0d118b35 (diff)
Create a page listing all tags
-rw-r--r--haunt/custom/tag.scm27
-rw-r--r--haunt/custom/theme.scm2
-rw-r--r--haunt/haunt.scm1
3 files changed, 28 insertions, 2 deletions
diff --git a/haunt/custom/tag.scm b/haunt/custom/tag.scm
index abac1b5..c8a0337 100644
--- a/haunt/custom/tag.scm
+++ b/haunt/custom/tag.scm
@@ -20,7 +20,32 @@
#:use-module (haunt html)
#:use-module (haunt page)
#:use-module (haunt post)
- #:export (sort-by-tag))
+ #:export (all-tags
+ sort-by-tag))
+
+(define (tag-counts posts)
+ "Return an alist of every tag used in POSTS paired with the number of times it
+is used."
+ (sort (map (lambda (tag) (cons (car tag) (length (cdr tag))))
+ (posts/group-by-tag posts))
+ (lambda (a b) (> (cdr a) (cdr b)))))
+
+(define (format-tag pair)
+ "Return an SXML expression for the tag-count pair."
+ (let* ((tag (car pair))
+ (count (cdr pair))
+ (target (format #f "/tag-~a.html" tag)))
+ `(p (a (@ (href ,target)) ,tag)
+ ,(format #f " (~a)" count))))
+
+(define (all-tags)
+ "Return a procedure creating a page listing all of the tags used in the blog."
+ (lambda (site posts)
+ (let ((body (append `((h1 "All Tags"))
+ (map format-tag (tag-counts posts)))))
+ (make-page "tags.html"
+ (with-layout jakob-theme site "All Tags" body)
+ sxml->html))))
(define (sort-by-tag)
"Return a procedure that transforms a list of posts into pages containing only
diff --git a/haunt/custom/theme.scm b/haunt/custom/theme.scm
index 692ce1a..b9edaa8 100644
--- a/haunt/custom/theme.scm
+++ b/haunt/custom/theme.scm
@@ -86,8 +86,8 @@
(ul (li ,(link "Jakob L. Kreuze" "/"))
(li (@ (class "fade-text")) " ")
(li ,(link "About" "/about.html"))
- (li ,(link "Blog" "/index.html"))
(li ,(link "Projects" "/projects.html"))
+ (li ,(link "Tags" "/tags.html"))
(li ,(link "Atom" "/atom.xml"))))
,body
(footer (@ (class "text-center"))
diff --git a/haunt/haunt.scm b/haunt/haunt.scm
index fc22f1e..b5b85d3 100644
--- a/haunt/haunt.scm
+++ b/haunt/haunt.scm
@@ -122,6 +122,7 @@
#:builders (list (blog #:theme jakob-theme #:collections %collections)
(article-aliases %aliases)
(atom-feed #:file-name "atom.xml")
+ (all-tags)
(sort-by-tag)
(static-page "About Me" "about")
(static-page "Projects" "projects")