stlog/haunt.scm

;;; Test site
(use-modules (ice-9 match)
             (srfi srfi-19)
             (srfi srfi-26)
             (haunt asset)
             (haunt site)
             (haunt page)
             (haunt post)
             (haunt html)
             (haunt utils)
             (haunt builder blog)
             (haunt builder atom)
             (haunt builder assets)
             (haunt reader)
             (haunt reader skribe)
             (syntax-highlight)
             (syntax-highlight scheme))

;;; Utilities

(define %site-prefix (make-parameter ""))

(define (prefix-url url)
  (string-append (%site-prefix) url))

;;; Templates 

(define (stylesheet name)
  `(link (@ (rel "stylesheet")
            (href ,(prefix-url (string-append "/css/" name ".css"))))))

(define (base-image image alt)
  `(img (@ (src ,(prefix-url (string-append "/images/" image)))
           (alt ,alt))))

(define* (base-layout site body #:key title)
  `((doctype "html")
    (head
     (meta (@ (charset "utf-8")))
     (title ,(if title title
                 (site-title site))))
     ;; css
     (link (@ (rel "stylesheet")
              (href ,(prefix-url "/css/main.css"))))
     (link (@ (rel "stylesheet")
              (href ,(prefix-url "/css/code.css"))))
    (body
     (div (@ (class "main-wrapper"))
          (div (@ (class "site-main-content"))
               ,body))
     (div (@ (class "footer"))
          (a (@ (href "https://notabug.org/sapientech/stlog"))
             "Site contents")
          " dual licensed under "
          (a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
             "Creative Commons 4.0 International")
          " and "
          (a (@ (href "http://www.gnu.org/licenses/gpl-3.0.en.html"))
             "the GNU GPL, version 3 or any later version")
          ". Images by "
          (a (@ (href "https://snapjudgemints.wordpress.com/"))
             "tea4tori")
          ",  Powered by "
          (a (@ (href "http://haunt.dthompson.us/"))
             "Haunt")
          "."))))

(define (banner-content)
  `(div (@ (class "banner-wrapper"))
        (center (a (@ (href ,(prefix-url "/"))
                      (class "stlog-banner"))
                   ,(base-image "banner.png"
                                "stlog banner")))))

(define (post-template post)
  `((a (@(href ,(prefix-url "/"))) "top")
    (center (h2 ,(post-ref post 'title)))
    (center (h4 ,(date->string* (post-date post))))
    (div ,(post-sxml post))))

(define (collection-template site title posts prefix)
  (define (post-uri post)
    (string-append (or prefix "") "/"
                   (site-post-slug site post) ".html"))
  `(,(banner-content)
    (div (@ (class "posts-header"))
         (h1 "Recent posts:"))
    (ul
     ,@(map (lambda (post)
              `(li
                (a (@ (href ,(post-uri post)))
                   ,(post-ref post 'title)
                   " — "
                   ,(date->string* (post-date post)))))
            posts))))

(define stlog-theme
  (theme #:name "stlog"
         #:layout
         (lambda (site title body)
           (base-layout site body
                        #:title "stlog"))
         #:post-template post-template
         #:collection-template collection-template))

(site #:title "stlog"
      #:domain "stlog.sapientech.guile.cc"
      #:default-metadata
      '((author . "Dylan Jeffers")
        (email  . "sapientech@openmailbox.org"))
      #:readers (list (make-skribe-reader
                       #:modules '((haunt skribe utils)
                                   (skribe-utils))))
      #:builders (list (blog #:theme stlog-theme)
                       (atom-feed)
                       (atom-feeds-by-tag)
                       (static-directory "static/images" "images")
                       (static-directory "static/css" "css")))