git.shemshak.org - ~bandali/bndl.org/blob - bandali/theme.scm

   1 ;;; Copyright © 2019 Amin Bandali <bandali@gnu.org>
   2 ;;;
   3 ;;; This program is free software; you can redistribute it and/or
   4 ;;; modify it under the terms of the GNU General Public License as
   5 ;;; published by the Free Software Foundation; either version 3 of the
   6 ;;; License, or (at your option) any later version.
   7 ;;;
   8 ;;; This program is distributed in the hope that it will be useful,
   9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  11 ;;; General Public License for more details.
  12 ;;;
  13 ;;; You should have received a copy of the GNU General Public License
  14 ;;; along with this program. If not, see
  15 ;;; <http://www.gnu.org/licenses/>.
  16
  17 (define-module (bandali theme)
  18   #:use-module (bandali prefs)          ; my-*
  19   #:use-module (bandali tags)           ; tag-*
  20   #:use-module (bandali utils)
  21   #:use-module (haunt builder blog)     ; theme
  22   #:use-module (haunt post)             ; post-*
  23   #:use-module (haunt site)             ; site-*
  24   #:use-module (haunt utils)            ; string->date*
  25   #:use-module (srfi srfi-19)
  26   #:export (base-layout
  27             post-uri
  28             post-list-table
  29             bandali-theme))
  30
  31 (define* (base-layout site body #:key title copy license-page?)
  32   `((doctype "html")
  33     (html
  34      (head
  35       (meta (@ (charset "utf-8")))
  36       (meta (@ (name "viewport")
  37                (content "width=device-width, initial-scale=1")))
  38       (title ,(if title (string-append title " — " (site-title site))
  39                   "Amin Bandali’s Personal Site"))
  40       (link (@ (rel "icon")
  41                (href "/gnu.ico")))
  42       ,(stylesheet "reset")
  43       ,(stylesheet "style"))
  44      (body
  45       (main ,body)
  46       (footer
  47        (p "Copyright © "
  48           ,(if copy copy "2016–2019")
  49           " Amin Bandali.  See "
  50           ,(if license-page? "the above"
  51                (aa "license.html" "/license.html"))
  52           " for license conditions.  Please copy and share."))))))
  53
  54 (define* (post-uri site post #:optional prefix)
  55   (string-append (or prefix "") "/"
  56                  (site-post-slug site post) ".html"))
  57
  58 (define* (post-list-table site posts #:optional prefix)
  59   `((table
  60      (@ (class "post-list"))
  61      (tbody
  62       ,@(map
  63          (lambda (post)
  64            `(tr
  65              (td ,(aa (post-ref post 'title)
  66                       (post-uri site post prefix)))
  67              (td (small (@ (title
  68                             ,(date->string (post-date post)
  69                                            my-secondary-date-format)))
  70                         ,(date->string (post-date post)
  71                                        my-primary-date-format)))))
  72          posts)))))
  73
  74 (define (my-post-template post)
  75   `((header
  76      (h1 ,(post-ref post 'title))
  77      (address "By " ,(aa (post-ref post 'author) "/")
  78               " <" ,(post-ref post 'email) ">")
  79      (p (@ (class "date"))
  80         (span (@ (title ,(date->string (post-date post)
  81                                        my-secondary-date-format)))
  82               ,(date->string (post-date post)
  83                              my-primary-date-format))
  84         ,(if (post-ref post 'updated)
  85              `(" (updated on "
  86                (span (@ (title
  87                          ,(date->string (post-ref post 'updated)
  88                                         my-secondary-date-format)))
  89                      ,(date->string (post-ref post 'updated)
  90                                     my-primary-date-format))
  91                ")") '()))
  92      ,(if (post-ref post 'tags)
  93           `(p (@ (class "tags"))
  94               "Tagged "
  95               ,@(intersperse
  96                  (map (lambda (tag)
  97                         (aa tag (tag-uri my-tag-prefix tag)))
  98                       (post-ref post 'tags))
  99                  ", "))
 100           '()))
 101     ,(post-sxml post)
 102     (p (@ (class "muted inbox"))
 103        "Have a question or comment?  Start a discussion in my "
 104        ,(aa "public inbox" "https://lists.sr.ht/~bandali/public-inbox")
 105        " by sending an email to "
 106        ,(aa "~bandali/public-inbox@lists.sr.ht"
 107             "mailto:~bandali/public-inbox@lists.sr.ht")
 108        (small
 109         " [" ,(aa "mailing list etiquette"
 110                   "https://man.sr.ht/lists.sr.ht/etiquette.md") "]")
 111        ".")))
 112
 113 (define* (my-collection-template site title posts prefix
 114                                  #:optional all-posts tag)
 115   `((h2 ,title
 116         ,(if tag
 117              (aa `(img (@ (class "feed-icon-h2")
 118                           (src "/icon-16px.png")
 119                           (alt "subscribe to atom feed")))
 120                  (tag-uri my-tag-prefix tag ".xml"))
 121              '()))
 122     ,(post-list-table site posts prefix)
 123     (h2 (@ (id "tags")) "Tags")
 124     ,(tag-links (or all-posts posts))
 125     ,(if tag
 126          '(a (@ (href "/notes.html"))
 127              "← all notes")
 128          '())))
 129
 130 (define bandali-theme
 131   (theme #:name "bandali"
 132          #:layout
 133          (lambda (site title body)
 134            (base-layout site body
 135                         #:title title))
 136          #:post-template my-post-template
 137          #:collection-template my-collection-template))
 138
 139 (module-define!
 140  (resolve-module '(haunt builder blog))
 141  'render-post
 142  (lambda (theme site post)
 143    (let ((title (post-ref post 'title))
 144          (body ((theme-post-template theme) post))
 145          (copy (post-ref post 'copyright)))
 146      (base-layout site body #:title title #:copy copy))))
 147
 148 (register-metadata-parser! 'updated string->date*)