haunt.scm

   1 (use-modules (haunt asset)
   2              (haunt builder blog)
   3              (haunt builder atom)
   4              (haunt builder assets)
   5              (haunt html)
   6              (haunt page)
   7              (haunt reader)
   8              (haunt reader texinfo)
   9              (haunt site)
  10              (haunt post)
  11              (srfi srfi-1)
  12              (srfi srfi-19))
  13
  14 (define (stylesheet name)
  15   `(link (@ (rel "stylesheet")
  16             (href ,(string-append "css/" name ".css")))))
  17
  18 (define (static-page title file-name body)
  19   (lambda (site posts)
  20     (make-page file-name
  21                (with-layout flex-theme site title body)
  22                sxml->html)))
  23
  24 (define flex-theme
  25   (theme #:name "Flex"
  26          #:layout
  27          (lambda (site title body)
  28            `((doctype "html")
  29              (html
  30               (head
  31                (meta (@ (charset "utf-8")))
  32                (title ,(string-append title " - " (site-title site)))
  33                (link (@ (rel "stylesheet") (href "//fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,700,400italic")))
  34                ,(stylesheet "style.min")
  35                ,(stylesheet "monokai.min")
  36                ,(stylesheet "font-awesome.min")
  37                ,(stylesheet "custom")
  38                (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0"))))
  39               (body
  40                ,(let ((metadata (site-default-metadata site)))
  41                   `(aside
  42                     (div
  43                      (a (@ (href "index.html")) (img (@ (src ,(assoc-ref metadata 'picture)))))
  44                      (h1 (a (@ (href "index.html")) ,(assoc-ref metadata 'author)))
  45                      (p ,(assoc-ref metadata 'description))
  46                      (nav
  47                       (ul (@ (class "list"))
  48                           ,@(map (lambda (page)
  49                                    `(li (a (@ (href ,(cdr page))) ,(car page))))
  50                                  (assoc-ref metadata 'pages))))
  51                      (ul (@ (class "social"))
  52                          (li (a (@ (class "sc-bitbucket") (target "_blank") (href "https://bitbucket.org/jsancho_gpl/")) (i (@ (class "fa fa-bitbucket")))))
  53                          " "
  54                          (li (a (@ (class "sc-github") (target "_blank") (href "https://github.com/jsancho-gpl")) (i (@ (class "fa fa-github")))))
  55                          " "
  56                          (li (a (@ (class "sc-twitter") (target "_blank") (href "https://twitter.com/jsancho_gpl")) (i (@ (class "fa fa-twitter")))))
  57                          " "
  58                          (li (a (@ (class "sc-rss") (target "_blank") (href "feed.xml")) (i (@ (class "fa fa-rss")))))))))
  59                (main ,body)))))
  60
  61          #:post-template
  62          (lambda (post)
  63            (define (get-tags post)
  64              (or (assoc-ref (post-metadata post) 'tags) '()))
  65
  66            `((article (@ (class "single"))
  67                       (header
  68                        (h1 ,(post-ref post 'title))
  69                        (p "Posted on " ,(date->string (post-date post) "~B ~d, ~Y")))
  70                       ,(post-sxml post)
  71                       (div (@ (class "tag-cloud"))
  72                            (p
  73                             ,@(map (lambda (tag)
  74                                      `((a (@ (href "")) ,tag) " "))
  75                                    (get-tags post)))))))
  76
  77          #:collection-template
  78          (lambda (site title posts prefix)
  79            (define (post-uri post)
  80              (string-append (or prefix "")
  81                             (site-post-slug site post) ".html"))
  82
  83            (define (get-paragraphs sxml count)
  84              (let ((pars (filter
  85                           (lambda (e) (and (pair? e) (eq? (car e) 'p)))
  86                           sxml)))
  87                (list-head pars (min count (length pars)))))
  88
  89            (define (post-summary post)
  90              (or (post-ref post 'summary)
  91                  (get-paragraphs (cdr (post-sxml post)) 3)))
  92
  93            `(
  94              ,@(map (lambda (post)
  95                       `(article
  96                         (header
  97                          (h2
  98                           (a (@ (href ,(post-uri post)))
  99                              ,(post-ref post 'title)))
 100                          (p "Posted on " ,(date->string (post-date post) "~B ~d, ~Y")))
 101                         (div ,(post-summary post)
 102                              (br)
 103                              (a (@ (class "btn") (href ,(post-uri post))) " Continue reading "))
 104                         (hr)))
 105                     (posts/reverse-chronological posts))))))
 106
 107 (define about-page
 108   (static-page
 109    "About me"
 110    "about.html"
 111    `((h2 "hi."))))
 112
 113 (define %collections
 114   `(("Home" "index.html" ,posts/reverse-chronological)))
 115
 116 (site #:title "Javier Sancho"
 117       #:domain "jsancho.org"
 118       #:default-metadata
 119       '((author . "Javier Sancho")
 120         (description . "Free Software Evangelist - Programmer")
 121         (email . "jsf@jsancho.org")
 122         (picture . "images/jsancho.jpg")
 123         (pages . (("about" . "about.html")
 124                   ("projects" . "http://git.jsancho.org/"))))
 125       #:readers (list sxml-reader html-reader)
 126       #:builders (list (blog #:theme flex-theme #:collections %collections)
 127                        (atom-feed)
 128                        (atom-feeds-by-tag)
 129                        about-page
 130                        (static-directory "images")
 131                        (static-directory "fonts")
 132                        (static-directory "css")))