summary refs log tree commit diff stats
path: root/boudin.page.write.scm
blob: eb719b7357d34cf347b6ce4814c60943c11895f0 (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
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
(declare (module (boudin page write))
         (export feed-template
                 feed-writer
                 html-head
                 index-template
                 index-writer
                 post-template
                 post-writer
                 write-page))

(import (atom)
        (boudin page)
        (boudin site)
        (chicken file)
        (chicken pathname)
        (html-parser)
        (sxml-serializer))

(define (write-page pg)
  (let ((outfile (page-output pg)))
    (create-directory (pathname-directory outfile)
                      'parents)
    (with-output-to-file outfile
      (lambda ()
        ((page-writer pg)
         ((page-template pg)
          pg))))))

(define html-head
  (make-parameter
   `((meta (@ (charset "utf-8")))
     (meta (@ (name "viewport")
              (content "initial-scale=1.0")))
     (link (@ (href "/style.css")
              (rel "stylesheet"))))))

(define post-writer
  (make-parameter
   sxml-display-as-html))

(define post-template
  (make-parameter
   (lambda (pg)
     (let ((title (page-ref pg "title")))
       `(html (@ (lang "en-us"))
              (head ,@(html-head)
                    (title ,(or title "[untitled]")))
              (body ,(if title `(h1 ,title) "")
                    ,@(cdr (page-content pg))))))))

(define index-writer
  (make-parameter
   sxml-display-as-html))

(define index-template
  (make-parameter
   (lambda (pgs)
     `(html (@ (lang "en-us"))
            (head ,@(html-head)
                  (title ,(site-name)))
            (body (h1 ,(site-name))
                  (ul ,@(map (lambda (pg)
                               `(li (a (@ (href ,(page-slug pg)))
                                       ,(or (page-ref pg "title")
                                            (page-slug pg)))))
                             ((site-sort) pgs))))))))

(define feed-writer
  (make-parameter
   (lambda (sxml)
     (serialize-sxml sxml
                     output: (current-output-port)
                     cdata-section-elements: '(atom:content)
                     ns-prefixes:
                     `((*default* . "http://www.w3.org/2005/Atom")
                       (*default* . "http://www.w3.org/1999/xhtml")
                       ,@(atom-ns-prefixes))
                     allow-prefix-redeclarations: #t))))

(define feed-template
  (make-parameter
   (lambda (pgs)
     (make-atom-doc
      (make-feed
       title: (make-title (site-name))
       id: (site-host)
       updated: (site-build-time)
       authors: (list (make-author name: (site-author)
                                   uri: (site-host)))
       links: (list (make-link type: 'html
                               uri-language: "en"
                               uri: (site-host))
                    (make-link relation: "self"
                               type: "application/atom+xml"
                               uri: (make-pathname
                                     (site-host) "feed" "xml")))
       rights: (make-rights (force (site-rights)))
       generator: (make-generator "Boudin"
                                  uri: "https://git.acdw.net/boudin"
                                  version: "rice")
       entries: (map (lambda (pg)
                       (make-entry
                        title: (make-title
                                (or (page-ref pg "title") "[untitled]"))
                        links: (list (make-link type: 'html
                                                uri: (page-url pg)))
                        id: (page-url pg)
                        updated: (page-updated pg)
                        ;;published:
                        content: (make-content
                                  (sxml->html
                                   (page-content pg))
                                  type: 'html)))
                     ((site-sort) pgs)))))))