~aasg/haunted-blog

ref: 0825fe249b3becebc9cdcb52f36c4c1ef3d0794b haunted-blog/haunt.scm -rw-r--r-- 5.5 KiB
0825fe24 — Aluísio Augusto Silva Gonçalves Replace email icon with one in the public domain 1 year, 5 months ago
                                                                                
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(use-modules (haunt asset)
             (haunt builder blog)
             (haunt builder atom)
             (haunt builder assets)
             (haunt html)
             (haunt reader commonmark)
             (haunt page)
             (haunt post)
             (haunt site)
             (ice-9 match)
             (ice-9 textual-ports)
             (srfi srfi-1)
             (srfi srfi-19)
             (sxml match)
             (sxml simple)
             (sxml transform))

(define %site-root "/")

(define (read-asset path)
  (call-with-input-file path get-string-all))

(define (h-link name uri)
  `(a (@ (href ,uri)) ,name))

(define (h-icon name)
  (let ((icon-path (string-append "assets/icons/" name ".svg")))
    `(raw ,(read-asset icon-path))))

(define (h-icon-link icon-name uri)
  `(a (@ (href ,uri)
          (class "icon"))
       ,(h-icon icon-name)))

(define (first-paragraph post)
  (let loop ((sxml (post-sxml post))
             (result '()))
    (match sxml
           (() (reverse result))
           ((or (('p ...) _ ...) (paragraph _ ...))
            (reverse (cons paragraph result)))
           ((head . tail)
            (loop tail (cons head result))))))

(define aasg-theme
  (theme #:name "aasg"
         #:layout
         (lambda (site title body)
           `((doctype "html")
             (head
               (meta (@ (charset "utf-8")))
               (meta (@ (name "viewport")
                        (content "width=device-width, initial-scale=1")))
               (title ,(string-append title " — " (site-title site)))
               (link (@ (rel "stylesheet")
                        (href "https://unpkg.com/@fraction/base16-css@1.1.0/src/base16-default-dark.css")))
               (link (@ (rel "stylesheet")
                        (href ,(string-append %site-root "css/a11y.css"))))
               (link (@ (rel "stylesheet")
                        (href ,(string-append %site-root "css/classless.css"))))
               (link (@ (rel "stylesheet")
                        (href ,(string-append %site-root "css/site.css")))))
             (body
                   (header
                     (nav (@ (class "links"))
                          (ul
                            (li ,(h-icon-link "signature" %site-root))
                            (li ,(h-icon-link "email" "mailto:aluisio@aasg.name"))
                            (li ,(h-icon-link "matrix" "https://matrix.to/#/@aasg:aasg.name"))
                            (li ,(h-icon-link "github" "https://github.com/AluisioASG"))
                            (li ,(h-icon-link "gitlab" "https://gitlab.com/AluisioASG"))
                            (li ,(h-icon-link "linkedin" "https://www.linkedin.com/in/aasg/")))))
                   ,body
                   (footer (p
                             (a (@ (rel "license")
                                   (href "https://creativecommons.org/licenses/by-sa/4.0/")
                                   (title "CC-BY-SA 4.0"))
			        "\U01F16D\U01F16F\U01F10E")
                             " Aluísio Augusto Silva Gonçalves. "
                             ,(about-site-page-link "About this site."))))))
         #:post-template
         (lambda (post)
           `((time ,(date->string (post-date post) "~1"))
             (h1 (@ (class "title"))
                 ,(post-ref post 'title))
             (div (@ (class "post"))
                  ,(post-sxml post))))
         #:collection-template
         (lambda (site title posts prefix)
           (define (post-uri post)
             (string-append %site-root (or prefix "")
                            (site-post-slug site post) ".html"))
           `((h1, "Hi!")
             (h1 ,title)
             ,(map (lambda (post)
                     `(article
                        (h2 ,(h-link (post-ref post 'title) (post-uri post)))
                        (time ,(date->string (post-date post) "~1"))
                        ,(first-paragraph post)
                        ,(h-link "continue…" (post-uri post))))
                   posts)))))

(define (static-page file-name title body)
  (lambda (site posts)
    (make-page file-name
               (with-layout aasg-theme site title body)
               sxml->html)))

(define (about-site-page-link text)
  (h-link text (string-append %site-root "about-site.html")))
(define about-site-page
  (static-page
    "about-site.html"
    "About this site"
    `((h1 "About this site")
      (section (@ (id "license"))
               (h2 "License")
               (p "The text and images in this website are, unless indicated otherwise, licensed under the "
                  ,(h-link "Creative Commons Attribution-ShareAlike 4.0 International" "https://creativecommons.org/licenses/by-sa/4.0/")
                  ".")
               (p "Unless otherwise indicated, specifically for code snippets in this website that are not part of another body of work, all copyright and related or neighbouring rights are waived, as specified by the "
                  ,(h-link "CC0 1.0 Universal Public Domain Dedication" "https://creativecommons.org/publicdomain/zero/1.0/")
                  ".")))))

(site #:title "aasg's most experimental weblog"
      #:domain "aasg.name"
      #:default-metadata
      '((author . "Aluísio Augusto Silva Gonçalves"))
      #:readers (list commonmark-reader)
      #:builders (list (blog #:theme aasg-theme)
                       (atom-feed)
                       about-site-page
                       (static-directory "static/css" "css")
                       (static-directory "static/fonts" "fonts")))