skribe-utils.scm

   1 (define-module (skribe-utils)
   2   #:use-module (ice-9 match)  ; match-lambda
   3   #:use-module (srfi srfi-1)  ; list stuff
   4   #:export (email
   5             ~
   6             ---
   7             table
   8             lyrics
   9             ref
  10             figure
  11             wide-img))
  12
  13 (define (email address)
  14   "Obfuscate a given email ADDRESS."
  15   `(span (@ (class "obfuscated"))
  16          ,(string-map (lambda (c) (integer->char (+ 1 (char->integer c))))
  17                       address)))
  18
  19 (define (~)
  20   "Non-breaking space."
  21   (string #\240))
  22
  23 (define (---)
  24   "Em dash." "—")
  25
  26 (define* (table #:key (align '()) headers rows)
  27   "Build HTML tables more easily."
  28   (let ((alignment (append align
  29                            (make-list (- (length headers)
  30                                          (length align))
  31                                       "left"))))
  32     (define (make-row fields)
  33       `(tr ,(map (match-lambda
  34                   ((field alignment)
  35                    `(td (@ (align ,alignment)) ,field)))
  36                  (zip fields alignment))))
  37     (define (make-header fields)
  38       `(tr (@ (class "header"))
  39            ,(map (match-lambda
  40                   ((field alignment)
  41                    `(th (@ (align ,alignment)) ,field)))
  42                  (zip fields alignment))))
  43     `(table
  44       (thead ,(make-header headers))
  45       (tbody ,(map make-row rows)))))
  46
  47 (define (lyrics . contents)
  48   `(pre (@ (class "lyrics")) ,contents))
  49
  50 (define (ref url text)
  51   `(a (@ (href ,url)) ,text))
  52
  53 (define (figure file caption)
  54   `(div (@ (class "figure"))
  55         (img (@ (src ,(if (string-prefix? "/" file)
  56                           file
  57                           (string-append "/images/posts/" file)))
  58                 (alt ,caption)))
  59         (p (@ (class "caption")) ,caption)))
  60
  61 (define (wide-img file alt)
  62   `(img (@ (class "full stretch")
  63            (src ,(if (string-prefix? "/" file)
  64                      file
  65                      (string-append "/images/posts/" file)))
  66            (alt ,alt))))