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 (get-tags post)
  25   (or (assoc-ref (post-metadata post) 'tags) '()))
  26
  27 (define (post-date-and-tags date tags)
  28   (let ((div `(div (@ (class "date-and-tags"))
  29                    (time (@ (datetime ,(date->string date "~Y-~m-~dT~H:~M:~S")))
  30                          ,(date->string date "~Y-~m-~d")))))
  31     (cond ((> (length tags) 0)
  32            (append div
  33                    `(" "
  34                      (span (@ (style "margin: 0 3px")) ⦿)
  35                      (span (@ (class "tags"))
  36                            ,@(drop-right
  37                               (apply
  38                                append
  39                                (map (lambda (tag)
  40                                       `((a (@ (href ,(format #f "tags/~a.html" tag))) ,tag) ", "))
  41                                     tags))
  42                               1)))))
  43           (else
  44            div))))
  45
  46 (define flex-theme
  47   (theme #:name "Flex"
  48          #:layout
  49          (lambda (site title body)
  50            `((doctype "html")
  51              (html
  52               (head
  53                (meta (@ (charset "utf-8")))
  54                (title ,(string-append title " - " (site-title site)))
  55                (link (@ (rel "stylesheet") (href "https://fonts.googleapis.com/css?family=Merriweather+Sans:400,300,300italic,400italic,700,700italic,800,800italic|Merriweather:400,300,300italic,400italic,700,700italic,900,900italic|Source+Code+Pro:200,300,400,500,600,700,900")))
  56                ,(stylesheet "application.min")
  57                ,(stylesheet "pygments.min")
  58                ,(stylesheet "custom")
  59                (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0"))))
  60               (body
  61                ,(let ((metadata (site-default-metadata site)))
  62                   `(div (@ (id "page-content"))
  63                         (header
  64                          (nav (@ (role "navigation") (class "navigation-bar"))
  65                               (ul (@ (class "navigation-items left"))
  66                                   (li (@ (id "blog-title-header"))
  67                                       (a (@ (href "index.html"))
  68                                          (h1 ,(assoc-ref metadata 'author)))))
  69                               (ul (@ (class "navigation-items center")))
  70                               (ul (@ (class "navigation-items right"))
  71                                   ,@(map (lambda (page)
  72                                            `(li (a (@ (href ,(cdr page))) ,(car page))))
  73                                          (assoc-ref metadata 'pages)))))
  74                         (section (@ (role "main"))
  75                                  (div (@ (class "content") (class "col-md-12")) ,body))))))))
  76
  77          #:post-template
  78          (lambda (post)
  79            `((article (@ (class "inline"))
  80                       (header
  81                        (h1 (@ (class "title")) ,(post-ref post 'title))
  82                        ,(post-date-and-tags (post-date post) (get-tags post)))
  83                       ,(post-sxml post))))
  84
  85          #:collection-template
  86          (lambda (site title posts prefix)
  87            (define (post-uri post)
  88              (string-append (or prefix "")
  89                             (site-post-slug site post) ".html"))
  90
  91            (define (get-paragraphs sxml count)
  92              (define (getp sxml count res)
  93                (cond ((or (= count 0) (null? sxml))
  94                       res)
  95                      ((and (pair? (car sxml)) (eq? (caar sxml) 'p))
  96                       (getp (cdr sxml) (- count 1) (cons (car sxml) res)))
  97                      ((and (pair? (car sxml)) (eq? (caar sxml) 'a))
  98                       (getp (cdr sxml) count (cons (car sxml) res)))
  99                      (else
 100                       (getp (cdr sxml) count res))))
 101              (reverse (getp sxml count '())))
 102
 103            (define (post-summary post)
 104              (or (post-ref post 'summary)
 105                  (get-paragraphs (cdr (post-sxml post)) 3)))
 106
 107            `(
 108              ,@(map (lambda (post)
 109                       `(article (@ (class "inline"))
 110                                 (header
 111                                  (h2 (@ (class "title"))
 112                                      (a (@ (href ,(post-uri post)))
 113                                         ,(post-ref post 'title)))
 114                                  ,(post-date-and-tags (post-date post) (get-tags post)))
 115                                 ,(post-summary post)
 116                                 (footer (@ (class "read-more"))
 117                                            (a (@ (href ,(post-uri post))) "...read more..."))))
 118                     (posts/reverse-chronological posts))))))
 119
 120 (define about-page
 121   (static-page
 122    "About me"
 123    "about.html"
 124    `((h2 "hi."))))
 125
 126 (define %collections
 127   `(("Home" "index.html" ,posts/reverse-chronological)))
 128
 129 (site #:title "Javier Sancho"
 130       #:domain "jsancho.org"
 131       #:default-metadata
 132       '((author . "Javier Sancho")
 133         (description . "Free Software Evangelist - Programmer")
 134         (email . "jsf@jsancho.org")
 135         (picture . "images/jsancho.jpg")
 136         (pages . (("projects" . "http://git.jsancho.org/")
 137                   ("about me" . "about.html"))))
 138       #:readers (list sxml-reader html-reader)
 139       #:builders (list (blog #:theme flex-theme #:collections %collections)
 140                        (atom-feed)
 141                        (atom-feeds-by-tag)
 142                        about-page
 143                        (static-directory "images")
 144                        (static-directory "fonts")
 145                        (static-directory "css")))