blob: 0c00354da65083048bc40aa7066196c18fa221fb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
(define-module (dnw tags)
#:use-module (dnw theme)
#:use-module (haunt post)
#:use-module (srfi srfi-1)
#:use-module (haunt html)
#:use-module (haunt post)
#:use-module (haunt page)
#:use-module (haunt utils)
#:use-module (ice-9 match)
#:export (group-by-tag
count-tags
tag-uri
tags->page
tag-description
desc-alist))
(define (group-by-tag posts)
"Given a lisp of haunt posts generate a list grouping tags with the
posts associated with it."
(let ((table (make-hash-table)))
(for-each (lambda (post)
(let ((tags (post-ref post 'tags)))
(for-each (lambda (tag)
(let ((current (hash-ref table tag)))
(if current
(hash-set! table tag (cons post current))
(hash-set! table tag (list post)))))
tags)))
posts)
(hash-fold alist-cons '() table)))
(define (count-tags posts)
"Return a list of tags associated with their count in descending
order."
(sort (map (lambda (tag)
(list (car tag) (length (cdr tag))))
(group-by-tag posts))
(lambda (a b) (> (cadr a) (cadr b)))))
(define (tag-uri tag)
"Given a TAG return the page that contains only posts associated
with that TAG."
(string-append "/posts/tag/" tag ".html"))
(define (tags->page site posts)
(flat-map (match-lambda
((tag . posts)
(make-page (tag-uri tag)
(base-template site (tags-template site posts #:title tag)
#:title tag)
sxml->html)))
(group-by-tag posts)))
(define (tag-description tag descalist)
(let ((desc (assoc tag descalist)))
(if desc
`(p ,(cdr desc))
'(p "No description."))))
(define desc-alist
'(("Test" . "This is a test of the tag description feature.")))
|
