(define my-domain "bandali.eu.org")
(define my-url
(string-append (symbol->string my-scheme) "://" my-domain))
-
-(define my-date-format "~B ~d, ~Y")
-(define license-page-title "Licensing Information")
+(define my-tag-prefix "tags")
+(define my-date-format "~B ~e, ~Y")
(define (stylesheet name)
`(link (@ (rel "stylesheet")
(define* (aa content #:optional (uri content) . title)
`(a (@ (href ,uri) (title ,(apply string-append title))) ,content))
-(define* (base-layout site body #:key title)
+(define* (base-layout site body #:key title copy license-page?)
`((doctype "html")
(html
(head
(body
(main ,body)
(footer
- (p "Copyright © 2016–2019 Amin Bandali. See "
- ,(if (and (string? title)
- (string=? title license-page-title))
- "the above" (aa "license.html" "/license.html"))
+ (p "Copyright © "
+ ,(if copy copy "2016–2019")
+ " Amin Bandali. See "
+ ,(if license-page? "the above"
+ (aa "license.html" "/license.html"))
" for license conditions. Please copy and share."))))))
+(define* (tag-uri prefix tag #:optional (ext ".html"))
+ "Return a URI relative to the site's root for a page listing entries
+in PREFIX that are tagged with TAG."
+ (string-append "/" my-tag-prefix "/" tag ext))
+
+(define* (tag-pages #:key
+ (theme bandali-theme)
+ (prefix "")
+ (filter posts/reverse-chronological))
+ "Return a builder procedure that renders a list page for every tag
+used in a post. All arguments are optional:
+
+PREFIX: The directory in which to write the posts
+FILTER: The procedure called to manipulate the posts list before rendering"
+ (lambda (site posts)
+ (define (tag-list tag posts all-posts)
+ (define (render-list title posts prefix)
+ (let ((body ((theme-collection-template theme)
+ site title posts prefix all-posts tag)))
+ ((theme-layout theme) site title body)))
+ (make-page (tag-uri my-tag-prefix tag)
+ (render-list (string-append "Notes tagged ‘" tag "’")
+ (filter posts)
+ prefix)
+ sxml->html))
+ (let ((tag-groups (posts/group-by-tag posts)))
+ (map (match-lambda
+ ((tag . tagged-posts) (tag-list tag tagged-posts posts)))
+ tag-groups))))
+
+(define (tag-links posts)
+ "Generate an alphabetically sorted list of links to tagged posts.
+The link text consists of the tag name and the number of tagged posts
+in parentheses."
+ `(ul (@ (class "tag-list"))
+ ,(map (match-lambda
+ ((tag . posts)
+ `(li
+ ,(aa (string-append tag
+ " ("
+ (number->string (length posts))
+ ")")
+ (tag-uri my-tag-prefix tag)))))
+ ;; sort by tag
+ (sort (posts/group-by-tag posts)
+ (lambda (a b) (string<? (car a) (car b)))))))
(register-metadata-parser! 'updated string->date*)
+(define (intersperse lst delim)
+ "Return the elements of LST delimited by DELIM, such that the
+resulting list is of an odd length and every second element is DELIM."
+ (if (<= (length lst) 1)
+ lst
+ (cons* (car lst)
+ delim
+ (intersperse (cdr lst) delim))))
+
(define (my-post-template post)
`((header
(h1 ,(post-ref post 'title))
`(p (@ (class "updated"))
"Updated "
,(date->string (post-ref post 'updated)
- my-date-format)) ""))
+ my-date-format)) '())
+ ,(if (post-ref post 'tags)
+ `(p (@ (class "tags"))
+ "Tagged "
+ ,@(intersperse
+ (map (lambda (tag)
+ (aa tag (tag-uri my-tag-prefix tag)))
+ (post-ref post 'tags))
+ ", "))
+ '()))
,(post-sxml post)
(p (@ (class "muted inbox"))
"Have a question or comment? Start a discussion in my "
"https://man.sr.ht/lists.sr.ht/etiquette.md") "]")
".")))
-(define (my-collection-template site title posts prefix)
- (define (post-uri post)
- (string-append (or prefix "") "/"
- (site-post-slug site post) ".html"))
+(define* (post-uri site post #:optional prefix)
+ (string-append (or prefix "") "/"
+ (site-post-slug site post) ".html"))
- `((h2 ,title)
- (table
+(define* (post-list-table site posts #:optional prefix)
+ `((table
(@ (class "post-list"))
(tbody
- ,@(map (lambda (post)
- `(tr
- (td ,(aa (post-ref post 'title) (post-uri post)))
- (td (@ (style "font-size: 0.875em;"))
- ,(date->string (post-date post) my-date-format))))
- posts)))))
+ ,@(map
+ (lambda (post)
+ `(tr
+ (td ,(aa (post-ref post 'title)
+ (post-uri site post prefix)))
+ (td (small ,(date->string (post-date post)
+ my-date-format)))))
+ posts)))))
+
+(define* (my-collection-template site title posts prefix
+ #:optional all-posts tag)
+ `((h2 ,title
+ ,(if tag
+ (aa `(img (@ (class "feed-icon-h2")
+ (src "/icon-16px.png")
+ (alt "subscribe to atom feed")))
+ (tag-uri my-tag-prefix tag ".xml"))
+ '()))
+ ,(post-list-table site posts prefix)
+ (h2 "Tags")
+ ,(tag-links (or all-posts posts))
+ ,(if tag
+ '(a (@ (href "/notes.html"))
+ "← all notes")
+ '())))
(define bandali-theme
(theme #:name "bandali"
#:post-template my-post-template
#:collection-template my-collection-template))
-(define (static-page title file-name body)
+(define* (static-page title file-name body copy #:key license?)
(lambda (site posts)
(make-page file-name
- (with-layout bandali-theme site title body)
+ (base-layout site body #:title title #:copy copy
+ #:license-page? license?)
sxml->html)))
(define (index-material site posts)
"images"))
(h2 (@ (id "notes")) "Notes")
(p "Here are notes about a variety of topics and issues I care "
- "about. They’re also available via " ,(aa "Atom" "feed.atom")
- " and " ,(aa "RSS" "feed.rss") " feeds.")
- (table
- (@ (class "post-list"))
- (tbody
- ,@(map
- (lambda (post)
- (define (post-uri post)
- (string-append "/"
- (site-post-slug site post) ".html"))
- `(tr
- (td ,(aa (post-ref post 'title) (post-uri post)))
- (td (small
- ,(date->string (post-date post) my-date-format)))))
- (take-up-to 10 (posts/reverse-chronological posts)))))))
+ "about. They’re also available via "
+ ,(aa `((img (@ (class "feed-icon")
+ (src "/icon-12px.png")
+ (alt "subscribe to atom feed")))
+ "Atom")
+ "notes.atom")
+ " and "
+ ,(aa `((img (@ (class "feed-icon")
+ (src "/icon-12px.png")
+ (alt "subscribe to rss feed")))
+ "RSS") "notes.rss") " feeds.")
+ ,(post-list-table site posts)))
(define (index-page site posts)
(make-page
(define license-page
(static-page
- license-page-title
+ "Licensing Information"
"license.html"
`((h1 "License information for "
,(aa my-domain my-url))
(li ,(aa "Various Licenses and Comments about Them"
"https://www.gnu.org/licenses/license-list.html"))
(li ,(aa "Proprietary Software Is Often Malware"
- "https://www.gnu.org/proprietary/proprietary.html"))))))
+ "https://www.gnu.org/proprietary/proprietary.html"))))
+ "2019"
+ #:license? #t))
(define contact-page
(static-page
(li (del ,(aa "bandali0" "https://github.com/bandali0")
" on GitHub"))
(li (del ,(aa "bandali0" "https://twitter.com/bandali0")
- " on Twitter"))))))
+ " on Twitter"))))
+ "2019"))
(define cv-page
(static-page
(p "Teaching Assistant")
(p (abbr (@ (title "Net-Centric Introduction to Computing"))
"EECS 1012")
- ": TA in Fall 2017"))))
+ ": TA in Fall 2017"))
+ "2019"))
(define se212-f19-page
(static-page
(li "Tutorial 8: —")
(li "Tutorial 9: —")
(li "Tutorial 10: worked through questions 1–10 of "
- "Homework 10")))))
+ "Homework 10")))
+ "2019"))
+
+(module-define!
+ (resolve-module '(haunt builder blog))
+ 'render-post
+ (lambda (theme site post)
+ (let ((title (post-ref post 'title))
+ (body ((theme-post-template theme) post))
+ (copy (post-ref post 'copyright)))
+ (base-layout site body #:title title #:copy copy))))
(site #:title "Amin Bandali"
;; TODO: uncomment after new haunt release
#:collections
`(("Notes" "notes.html"
,posts/reverse-chronological)))
+ (tag-pages)
index-page
(atom-feed
- #:file-name "feed.atom")
+ #:file-name "notes.atom")
(atom-feeds-by-tag
- #:prefix "tags")
+ #:prefix my-tag-prefix)
(rss-feed
- #:file-name "feed.rss")
+ #:file-name "notes.rss")
contact-page
cv-page
license-page
projects / ~bandali / bndl.org / blobdiff