1828bc6f2eedfd49a95ae41e031fd86ff79ac67d
[blog.git] / haunt.scm
1 (use-modules (haunt asset)
2              (haunt builder blog)
3              (haunt builder atom)
4              (haunt builder assets)
5              (haunt html)
6              (haunt page)
7              (haunt reader)
8              (haunt reader texinfo)
9              (haunt site)
10              (haunt post)
11              (srfi srfi-1)
12              (srfi srfi-19))
13
14 (define (stylesheet name)
15   `(link (@ (rel "stylesheet")
16             (href ,(string-append "css/" name ".css")))))
17
18 (define (static-page title file-name body)
19   (lambda (site posts)
20     (make-page file-name
21                (with-layout flex-theme site title body)
22                sxml->html)))
23
24 (define (get-tags post)
25   (or (assoc-ref (post-metadata post) 'tags) '()))
26
27 (define (post-date-and-tags date tags)
28   (let ((div `(div (@ (class "date-and-tags"))
29                    (time (@ (datetime ,(date->string date "~Y-~m-~dT~H:~M:~S")))
30                          ,(date->string date "~Y-~m-~d")))))
31     (cond ((> (length tags) 0)
32            (append div
33                    `(" "
34                      (span (@ (style "margin: 0 3px")) ÔŽ┐)
35                      (span (@ (class "tags"))
36                            ,@(drop-right
37                               (apply
38                                append
39                                (map (lambda (tag)
40                                       `((a (@ (href ,(format #f "tags/~a.html" tag))) ,tag) ", "))
41                                     tags))
42                               1)))))
43           (else
44            div))))
45
46 (define flex-theme
47   (theme #:name "Flex"
48          #:layout
49          (lambda (site title body)
50            `((doctype "html")
51              (html
52               (head
53                (meta (@ (charset "utf-8")))
54                (title ,(string-append title " - " (site-title site)))
55                (link (@ (rel "stylesheet") (href "https://fonts.googleapis.com/css?family=Merriweather+Sans:400,300,300italic,400italic,700,700italic,800,800italic|Merriweather:400,300,300italic,400italic,700,700italic,900,900italic|Source+Code+Pro:200,300,400,500,600,700,900")))
56                ,(stylesheet "application.min")
57                ,(stylesheet "pygments.min")
58                ,(stylesheet "custom")
59                (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0"))))
60               (body
61                ,(let ((metadata (site-default-metadata site)))
62                   `(div (@ (id "page-content"))
63                         (header
64                          (nav (@ (role "navigation") (class "navigation-bar"))
65                               (ul (@ (class "navigation-items left"))
66                                   (li (@ (id "blog-title-header"))
67                                       (a (@ (href "index.html"))
68                                          (h1 ,(assoc-ref metadata 'author)))))
69                               (ul (@ (class "navigation-items center")))
70                               (ul (@ (class "navigation-items right"))
71                                   ,@(map (lambda (page)
72                                            `(li (a (@ (href ,(cdr page))) ,(car page))))
73                                          (assoc-ref metadata 'pages)))))
74                         (section (@ (role "main"))
75                                  (div (@ (class "content") (class "col-md-12")) ,body))))))))
76
77          #:post-template
78          (lambda (post)
79            `((article (@ (class "inline"))
80                       (header
81                        (h1 (@ (class "title")) ,(post-ref post 'title))
82                        ,(post-date-and-tags (post-date post) (get-tags post)))
83                       ,(post-sxml post))))
84
85          #:collection-template
86          (lambda (site title posts prefix)
87            (define (post-uri post)
88              (string-append (or prefix "")
89                             (site-post-slug site post) ".html"))
90
91            (define (get-paragraphs sxml count)
92              (define (getp sxml count res)
93                (cond ((or (= count 0) (null? sxml))
94                       res)
95                      ((and (pair? (car sxml)) (eq? (caar sxml) 'p))
96                       (getp (cdr sxml) (- count 1) (cons (car sxml) res)))
97                      ((and (pair? (car sxml)) (eq? (caar sxml) 'a))
98                       (getp (cdr sxml) count (cons (car sxml) res)))
99                      (else
100                       (getp (cdr sxml) count res))))
101              (reverse (getp sxml count '())))
102                      
103            (define (post-summary post)
104              (or (post-ref post 'summary)
105                  (get-paragraphs (cdr (post-sxml post)) 3)))
106
107            `(
108              ,@(map (lambda (post)
109                       `(article (@ (class "inline"))
110                                 (header
111                                  (h2 (@ (class "title"))
112                                      (a (@ (href ,(post-uri post)))
113                                         ,(post-ref post 'title)))
114                                  ,(post-date-and-tags (post-date post) (get-tags post)))
115                                 ,(post-summary post)
116                                 (footer (@ (class "read-more"))
117                                            (a (@ (href ,(post-uri post))) "...read more..."))))
118                     (posts/reverse-chronological posts))))))
119
120 (define about-page
121   (static-page
122    "About me"
123    "about.html"
124    `((h2 "hi."))))
125
126 (define %collections
127   `(("Home" "index.html" ,posts/reverse-chronological)))
128
129 (site #:title "Javier Sancho"
130       #:domain "jsancho.org"
131       #:default-metadata
132       '((author . "Javier Sancho")
133         (description . "Free Software Evangelist - Programmer")
134         (email . "jsf@jsancho.org")
135         (picture . "images/jsancho.jpg")
136         (pages . (("projects" . "http://git.jsancho.org/")
137                   ("about me" . "about.html"))))
138       #:readers (list sxml-reader html-reader)
139       #:builders (list (blog #:theme flex-theme #:collections %collections)
140                        (atom-feed)
141                        (atom-feeds-by-tag)
142                        about-page
143                        (static-directory "images")
144                        (static-directory "fonts")
145                        (static-directory "css")))