kaka.farm

Unnamed repository; edit this file 'description' to name the repository.
git clone https://kaka.farm/~git/kaka.farm
Log | Files | Refs | README

haunt.scm (7963B)


      1 (import (srfi srfi-1)
      2 
      3         (ice-9 pretty-print)
      4         (ice-9 regex)
      5 
      6         (sxml simple)
      7 
      8         (haunt artifact)
      9         (haunt asset)
     10         (haunt builder assets)
     11         (haunt builder atom)
     12         (haunt builder blog)
     13         (haunt html)
     14         (haunt page)
     15         (haunt post)
     16         (haunt reader commonmark)
     17         (haunt reader)
     18         (haunt site)
     19 
     20         (json)
     21 
     22         (prefix (kakafarm index) kakafarm:index:)
     23         (prefix (kakafarm software clipboard-speaker) kakafarm:software:clipboard-speaker:)
     24         (prefix (kakafarm software diceware) kakafarm:software:diceware:)
     25         (prefix (kakafarm software) kakafarm:software:))
     26 
     27 (define (dp a) (pretty-print a) a)
     28 
     29 (define (pp attribute record)
     30   (pretty-print (list attribute (attribute record))))
     31 
     32 (define site-title-prefix "💩 Kaka Farm! 💩")
     33 
     34 (define site-header
     35   `(h1 (img (@ (src "/images/logo.png")
     36                (alt "A superflat vector drawing of a ceramic throne.")))
     37        "Kaka Farm!"))
     38 
     39 (define haunt-footer
     40   '(p "Built with "
     41       (a (@ (href "https://dthompson.us/projects/haunt.html"))
     42          "David Thompson's Haunt")
     43       ", a "
     44       (a (@ (href "https://www.gnu.org/software/guile/"))
     45          "GNU Guile")
     46       " Static Site Generator.  Source code for the site can be found in my "
     47       (a (@ (href "https://kaka.farm/~stagit/kaka.farm/log.html"))
     48          "Stagit")
     49       ", "
     50       (a (@ (href "https://codeberg.org/kakafarm/kaka.farm"))
     51          "Codeberg")
     52       ", or "
     53       (a (@ (href "https://git.sr.ht/~kakafarm/kaka.farm/"))
     54          "Source Hut")
     55       ".  Find more sites written with Haunt at "
     56       (a (@ (href "https://awesome.haunt.page/"))
     57          "Awesome Haunt") "!"))
     58 
     59 (define (make-favicon-asset)
     60   (make-asset "assets/logo.png" "/favicon.ico"))
     61 
     62 (define (post->sxml-link post)
     63   `(li (a (@ (href ,(regexp-substitute
     64                      #f
     65                      (regexp-exec extension-regexp
     66                                   (post-file-name post))
     67                      'pre ".html")))
     68           ,(date->string* (post-date post))
     69           " - "
     70           ,(cdr (assoc 'title (post-metadata post))))))
     71 
     72 (define extension-regexp (make-regexp "(\\.\\w+)$"))
     73 
     74 (define* (make-haunt-blog-index-sxml #:key posts)
     75   (let ((five-last-posts  (take (posts/reverse-chronological posts)
     76                                 (min (length posts)
     77                                      5))))
     78     `(div (h2 "Kakafarm's Haunt")
     79           (ul (li (a (@ (href "/haunt/posts/"))
     80                      "posts"))
     81               (li (a (@ (href "/haunt/feed.xml"))
     82                      "atom feed")))
     83           #;
     84           ((h2 "Latest posts:")
     85           (div (@ (class "latest-posts"))
     86           (ul ,(map post->sxml-link five-last-posts)))))))
     87 
     88 (define* (page-builder #:key destination make-sxml theme)
     89   (lambda (site posts)
     90     (serialized-artifact
     91      destination
     92      ((theme-layout theme)
     93       ""
     94       site-title-prefix
     95       (make-sxml #:posts posts))
     96      sxml->html)))
     97 
     98 (define* (json-page-builder #:key destination make-scm)
     99   (lambda (site posts)
    100     (serialized-artifact
    101      destination
    102      (make-scm)
    103      scm->json)))
    104 
    105 (define creative-commons-copyright-notice
    106   '(p (@ (xmlns:cc "http://creativecommons.org/ns#")
    107          (xmlns:dct "http://purl.org/dc/terms/"))
    108       (a (@ (property "dct:title")
    109             (rel "cc:attributionURL")
    110             (href "https://kaka.farm/"))
    111          "Kaka Farm")
    112       " by "
    113       (a (@ (rel "cc:attributionURL dct:creator")
    114             (property "cc:attributionName")
    115             (href "https://kaka.farm/"))
    116          "Yuval Langer")
    117       " is licensed under "
    118       (a (@ (href "http://creativecommons.org/licenses/by-sa/4.0/?ref=chooser-v1")
    119             (target "_blank")
    120             (rel "license noopener noreferrer")
    121             (style "display:inline-block;"))
    122          " Attribution-ShareAlike 4.0 International "
    123          (img (@ (style "height:22px!important;margin-left:3px;vertical-align:text-bottom;")
    124                  (src "https://mirrors.creativecommons.org/presskit/icons/cc.svg?ref=chooser-v1")
    125                  (alt "")))
    126          (img (@ (style "height:22px!important;margin-left:3px;vertical-align:text-bottom;")
    127                  (src "https://mirrors.creativecommons.org/presskit/icons/by.svg?ref=chooser-v1")
    128                  (alt "")))
    129          (img (@ (style "height:22px!important;margin-left:3px;vertical-align:text-bottom;")
    130                  (src "https://mirrors.creativecommons.org/presskit/icons/sa.svg?ref=chooser-v1")
    131                  (alt ""))))))
    132 
    133 (define (make-page an-sxml-tree title)
    134   `((doctype "html")
    135     (html (@ (lang "en"))
    136           (head (meta (@ (charset "UTF-8")))
    137                 (link (@ (rel "stylesheet")
    138                          (type "text/css")
    139                          (href "/assets/index.css")))
    140                 (title ,title))
    141           (body (div (@ (id "topmostdiv"))
    142                      ,site-header
    143                      ,an-sxml-tree
    144                      ,haunt-footer
    145                      ,creative-commons-copyright-notice)))))
    146 
    147 
    148 (define (blog-layout a-site a-page-title-string an-sxml-tree)
    149   (make-page an-sxml-tree
    150              (string-append site-title-prefix
    151                             " -- "
    152                             a-page-title-string)))
    153 
    154 (define blog-theme
    155   (theme #:name "blog-theme"
    156          #:layout blog-layout))
    157 
    158 (define (topsite-layout a-site a-page-title-string an-sxml-tree)
    159   (make-page an-sxml-tree
    160              site-title-prefix))
    161 
    162 (define topsite-theme
    163   (theme #:name "topsite-theme"
    164          #:layout topsite-layout))
    165 
    166 (define (make-contribute.json-scm)
    167   '((name . "Kaka Farm")
    168     (description . "Personal site.")
    169     (repository . ((url . "https://codeberg.org/kakafarm/kaka.farm/")
    170                    (license . "AGPLv3+")))
    171     (keywords . #(guile haunt))
    172     (irc . "irc://irc.libera.chat/#kakafarm")
    173     (irc-contacts . #("cow_2001"))))
    174 
    175 (site #:title site-title-prefix
    176       #:domain "kaka.farm"
    177       #:default-metadata '((author . "Yuval Langer")
    178                            (email . "yuval.langer@gmail.com"))
    179       #:readers (list commonmark-reader
    180                       sxml-reader)
    181       #:builders (list (blog #:prefix "/haunt/posts"
    182                              #:theme blog-theme)
    183                        (page-builder #:destination "/haunt/index.html"
    184                                      #:make-sxml make-haunt-blog-index-sxml
    185                                      #:theme blog-theme)
    186                        (page-builder #:destination "/index.html"
    187                                      #:make-sxml kakafarm:index:make-index-sxml
    188                                      #:theme topsite-theme)
    189                        (page-builder #:destination "/software/index.html"
    190                                      #:make-sxml kakafarm:software:make-sxml
    191                                      #:theme topsite-theme)
    192                        (page-builder #:destination "/software/diceware.html"
    193                                      #:make-sxml kakafarm:software:diceware:make-sxml
    194                                      #:theme topsite-theme)
    195                        (page-builder #:destination "/software/clipboard-speaker.html"
    196                                      #:make-sxml kakafarm:software:clipboard-speaker:make-sxml
    197                                      #:theme topsite-theme)
    198                        (json-page-builder #:destination "/contribute.json"
    199                                           #:make-scm make-contribute.json-scm)
    200                        (atom-feed #:file-name "/haunt/feed.xml"
    201                                   #:blog-prefix "/haunt/posts")
    202                        (atom-feeds-by-tag #:prefix "/haunt/feeds"
    203                                           #:blog-prefix "/haunt/feeds/")
    204                        (static-directory "assets" "assets")
    205                        (static-directory "images" "images")
    206                        (static-directory "dabbling/html" "dabbling")))