nani/website/tools/theme.scm

theme.scm

1
;;; Nani Project website
2
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
3
;;;
4
;;; This file is part of the Nani Project website.
5
;;;
6
;;; The Nani Project website is free software; you can redistribute it and/or modify it
7
;;; under the terms of the GNU Affero General Public License as published by
8
;;; the Free Software Foundation; either version 3 of the License, or (at
9
;;; your option) any later version.
10
;;;
11
;;; The Nani Project website is distributed in the hope that it will be useful, but
12
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
;;; GNU Affero General Public License for more details.
15
;;;
16
;;; You should have received a copy of the GNU Affero General Public License
17
;;; along with the Nani Project website.  If not, see <http://www.gnu.org/licenses/>.
18
19
(define-module (tools theme)
20
  #:use-module (haunt builder blog)
21
  #:use-module (haunt post)
22
  #:use-module (haunt site)
23
  #:use-module (tools i18n)
24
  #:use-module (srfi srfi-1)
25
  #:export (nani-theme))
26
27
(define (nani-theme lang page)
28
  (theme #:name "Nani"
29
         #:layout
30
         (lambda (site title body)
31
           (site-locale lang)
32
           `((doctype "html")
33
             (head
34
               (meta (@ (charset "utf-8")))
35
               (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
36
               (title ,(list title " — " (site-title site)))
37
               (link (@ (rel "stylesheet") (href "/css/nani.css")))
38
               (link (@ (rel "stylesheet") (href "/css/device.css"))))
39
             (body (@ (lang ,lang))
40
               (header
41
                 (span (a (@ (href "/")) "何?"))
42
                 (nav (@ (id "main-menu"))
43
                   (label (@ (for "hamburger") (id "hamburger-label"))
44
                     (img (@ (alt "(open the menu)") (src "/images/hamburger.png"))))
45
                   (input (@ (id "hamburger") (type "checkbox")))
46
                   (ul
47
                     (li (a (@ (href "/index.html")) ,(_ "Features")))
48
                     (li (a (@ (href "/documentation.html")) ,(_ "Documentation")))
49
                     (li (a (@ (href "https://framagit.org/nani-project/nani-app"))
50
                            ,(_ "Build it"))))))
51
               (div (@ (id "page"))
52
                 (div (@ (id "content-block")) (div (@ (id "content")) ,body)))
53
               (footer
54
                 (div (@ (class "footer-flex"))
55
                   (p "© Copyright Julien Lepiller 2019")
56
                   (p (a (@ (href "/mentions.html")) ,(_ "Legal notices"))))
57
                 (p ,(_ "The source of this website can be seen at
58
<a href=\"~a\">framagit</a>. This website is free software; you can redistribute
59
it and/or modify it under the terms of the GNU Affero General Public License
60
as published by the Free Software Foundation; either version 3 of the License,
61
or (at your option) any later version."
62
                    "https://framagit.org/nani-project/nani-website"))))))
63
         #:post-template
64
         (lambda (post)
65
           `((article
66
             (h1 ,(post-ref post 'title))
67
             (p (@ (class "date")) ,(_ "by ~a — ~a" (post-ref post 'author) (date->string* (post-date post))))
68
             (div ,(post-sxml post)))))
69
         #:collection-template
70
         (lambda (site title posts prefix)
71
           (define (post-uri post)
72
             (string-append "/" (or prefix "")
73
                            (site-post-slug site post) ".html"))
74
           `(div
75
              (p (a (@ (href "/blog-complete.html")) ,(_ "View posts for every language")))
76
              (div (@ (id "post-list"))
77
                ,@(map (lambda (post)
78
                         (let ((language (fold (lambda (key acc) (if (member key (post-ref post 'tags)) key acc)) "" languages)))
79
                           `(div (@ (class ,(string-append "post " language)))
80
                              (p (@ (class "title"))
81
                                 (a (@ (href ,(post-uri post)))
82
                                    ,(post-ref post 'title)))
83
                              (p (@ (class "post-content"))
84
                                 ,(post-ref post 'summary))
85
                              (p (@ (class "date"))
86
                                 (span
87
                                   (a (@ (href ,(post-uri post)))
88
                                        ,(_ "Read")))
89
                                 (span (@ (class ,language)) ,language)
90
                                 ,(date->string* (post-date post))))))
91
                    posts))))))
92