haunt.scm 4.12 KB
Newer Older
Ludovic Courtès's avatar
Ludovic Courtès committed
1 2 3 4 5 6 7 8 9 10 11
;;; This module is part of Guix-HPC and is licensed under the same terms,
;;; those of the GNU GPL version 3 or (at your option) any later version.
;;;
;;; Copyright © 2017 Inria

;; This is a build file for Haunt.  Run 'haunt build' to build the web site,
;; and 'haunt serve' to serve it locally.  Alternatively, you can run
;; 'guix build -f guix.scm' to have everything built in the store.
(use-modules (haunt site)
             (haunt reader)
             (haunt reader commonmark)
Roel Janssen's avatar
Roel Janssen committed
12
             (haunt post)
Ludovic Courtès's avatar
Ludovic Courtès committed
13 14 15 16 17 18 19
             (haunt page)
             (haunt html)
             (haunt utils)
             (haunt builder assets)
             (haunt builder blog)
             (ice-9 match)
             (srfi srfi-1)
Roel Janssen's avatar
Roel Janssen committed
20
             (srfi srfi-19)
21
             (srfi srfi-26)
Ludovic Courtès's avatar
Ludovic Courtès committed
22 23
             (guix-hpc))

Ludovic Courtès's avatar
Ludovic Courtès committed
24 25 26
(define %web-site-title
  "Guix-HPC — Reproducible software deployment for high-performance computing")

27 28 29 30 31 32 33 34 35
(define (summarize-post post uri)
  (match (post-sxml post)
    ((('p paragraph ...) _ ...)
     `((p ,@paragraph)
       (p (a (@ (href ,uri)) "Continue reading…"))))
    (body
     body)))

(define* (post->sxml post #:key post-uri summarize?)
Roel Janssen's avatar
Roel Janssen committed
36
  "Return the SXML for POST."
37 38 39 40 41
  (define post-body*
    (if summarize?
        (cut summarize-post <> post-uri)
        post-sxml))

Roel Janssen's avatar
Roel Janssen committed
42
  `(div (@ (class "post"))
43
        (h1 (@ (class "title"))
Roel Janssen's avatar
Roel Janssen committed
44 45 46 47 48 49 50 51 52
            ,(if post-uri
                 `(a (@ (href ,post-uri))
                     ,(post-ref post 'title))
                 (post-ref post 'title)))
        (div (@ (class "post-about"))
             ,(post-ref post 'author)
             " — " ,(date->string (post-date post) "~B ~e, ~Y"))
        (hr)
        (div (@ (class "post-body"))
53
             ,(syntax-highlight (post-body* post)))))
Roel Janssen's avatar
Roel Janssen committed
54 55 56 57 58 59

(define (page->sxml site title posts prefix)
  "Return the SXML for the news page of SITE, containing POSTS."
  `((div (@ (class "header"))
         (div (@ (class "post-list"))
              ,@(map (lambda (post)
60 61
                       (post->sxml post #:post-uri (post-url post site)
                                   #:summarize? #t))
Roel Janssen's avatar
Roel Janssen committed
62 63
                     posts)))))

64 65 66 67 68
(define (post->page post site)
  (make-page (string-append (post-url post site) "/index.html")
             (render-post %hpc-haunt-theme site post)
             sxml->html))

Roel Janssen's avatar
Roel Janssen committed
69 70
(define %hpc-haunt-theme
  ;; Theme for the rendering of the news pages.
Ludovic Courtès's avatar
Ludovic Courtès committed
71
  (theme #:name "Guix-HPC"
Roel Janssen's avatar
Roel Janssen committed
72
         #:layout (lambda (site title body)
Ludovic Courtès's avatar
Ludovic Courtès committed
73 74 75
                    (base-layout body
                                 #:title (string-append "Guix-HPC — "
                                                        title)))
Roel Janssen's avatar
Roel Janssen committed
76 77 78
         #:post-template post->sxml
         #:collection-template page->sxml))

Ludovic Courtès's avatar
Ludovic Courtès committed
79 80 81 82 83 84 85 86
(define %local-test?
  ;; True when we're testing locally, as opposed to producing things to
  ;; install to gnu.org.
  (or (getenv "WEB_SITE_LOCAL")
      (member "serve" (command-line))))           ;'haunt serve' command

(when %local-test?
  ;; The URLs produced in these pages are only meant for local consumption.
Roel Janssen's avatar
Roel Janssen committed
87
  (format #t "~%Producing Web pages for local tests *only*!~%~%"))
Ludovic Courtès's avatar
Ludovic Courtès committed
88

Ludovic Courtès's avatar
Ludovic Courtès committed
89
(site #:title %web-site-title
Ludovic Courtès's avatar
Ludovic Courtès committed
90 91 92 93 94 95
      #:domain "//hpc.guixsd.org/"
      #:default-metadata
      '((author . "Guix-HPC Contributors")
        (email  . "guix-devel@gnu.org"))
      #:readers (list commonmark-reader)
      #:builders
96 97 98 99 100 101 102 103 104
      (cons* (lambda (site posts)
               ;; Pages for each post.
               (map (cut post->page <> site) posts))

             (lambda (site posts)
               ;; The main collection.
               (make-page
                "/blog/index.html"
                (render-collection %hpc-haunt-theme site
Ludovic Courtès's avatar
Ludovic Courtès committed
105 106
                                   "Reproducible software \
deployment for high-performance computing — Blog"         ;title
107 108
                                   (posts/reverse-chronological posts)
                                   "/blog")
109
                sxml->html))
Ludovic Courtès's avatar
Ludovic Courtès committed
110 111 112

             ;; Apparently the <link> tags of Atom entries must be absolute URLs,
             ;; hence this #:blog-prefix.
113
             (atom-feed #:file-name "blog/feed.xml"
114
                        #:blog-prefix "https://hpc.guixsd.org/blog")
Ludovic Courtès's avatar
Ludovic Courtès committed
115

Roel Janssen's avatar
Roel Janssen committed
116
             (static-directory "static")
Ludovic Courtès's avatar
Ludovic Courtès committed
117

118
             (static-pages)))