;;; Copyright © 2018 David Thompson <davet@gnu.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(use-modules (haunt asset)
             (haunt builder blog)
             (haunt builder atom)
             (haunt builder assets)
             (haunt html)
             (haunt page)
             (haunt post)
             (haunt reader)
             (haunt site)
             (haunt utils)
             (sxml match)
             (sxml transform)
             (srfi srfi-1)
             (srfi srfi-19)
             (ice-9 rdelim)
             (ice-9 regex)
             (ice-9 match)
             (web uri))

(define (date year month day)
  "Create a SRFI-19 date for the given YEAR, MONTH, DAY"
  (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time))))))
    (make-date 0 0 0 0 day month year tzoffset)))

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

(define* (anchor content #:optional (uri content))
  `(a (@ (href ,uri)) ,content))

(define %cc-by-sa-link
  '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
      "Creative Commons Attribution Share-Alike 4.0 International"))

(define %cc-by-sa-button
  '(a (@ (class "cc-button")
         (href "https://creativecommons.org/licenses/by-sa/4.0/"))
      (img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png")))))

(define (link name uri)
  `(a (@ (href ,uri)) ,name))

(define* (centered-image url #:optional alt)
  `(img (@ (class "centered-image")
           (src ,url)
           ,@(if alt
                 `((alt ,alt))
                 '()))))

(define (first-paragraph post)
  (let loop ((sxml (post-sxml post))
             (result '()))
    (match sxml
      (() (reverse result))
      ((or (('p ...) _ ...) (paragraph _ ...))
       (reverse (cons paragraph result)))
      ((head . tail)
       (loop tail (cons head result))))))

(define %collections
  `(("Recent Blog Posts" "index.html" ,posts/reverse-chronological)))

(define (static-page title file-name body)
  (lambda (site posts)
    (make-page file-name
               (with-layout jakob-theme site title body)
               sxml->html)))

(define jakob-theme
  (theme #:name "jakob"
         #:layout
         (lambda (site title body)
           `((doctype "html")
             (html
              (head
               (meta (@ (charset "utf-8")))
               (title ,(string-append title " — " (site-title site)))
               ,(stylesheet "fonts")
               ,(stylesheet "highlight")
               ,(stylesheet "jakob")
               (script (@ (src "/js/highlight.pack.js")))
               (script "hljs.initHighlightingOnLoad()"))
              (body
               (div (@ (class "container"))
                    (div (@ (class "nav"))
                         (ul (li ,(link "Jakob L. Kreuze" "/"))
                             (li (@ (class "fade-text")) " ")
                             (li ,(link "About" "/about.html"))
                             (li ,(link "Blog" "/index.html"))
                             (li ,(link "Projects" "/projects.html"))))
                    ,body
                    (footer (@ (class "text-center"))
                            (p (@ (class "copyright"))
                               "© 2019 Jakob L. Kreuze"
                               ,%cc-by-sa-button)
                            (p "The text and images on this site are
free culture works available under the " ,%cc-by-sa-link " license.")
                            (p "This website is built with "
                               (a (@ (href "http://haunt.dthompson.us"))
                                  "Haunt")
                               ", a static site generator written in "
                               (a (@ (href "https://gnu.org/software/guile"))
                                  "Guile Scheme")
                               ".")))))))
         #:post-template
         (lambda (post)
           `((h1 (@ (class "title")),(post-ref post 'title))
             (div (@ (class "date"))
                  ,(date->string (post-date post)
                                 "~B ~d, ~Y"))
             (div (@ (class "post"))
                  ,(post-sxml post))))
         #:collection-template
         (lambda (site title posts prefix)
           (define (post-uri post)
             (string-append "/" (or prefix "")
                            (site-post-slug site post) ".html"))

           `((h1 ,title)
             ,(map (lambda (post)
                     (let ((uri (string-append "/"
                                               (site-post-slug site post)
                                               ".html")))
                       `(div (@ (class "summary"))
                             (h2 (a (@ (href ,uri))
                                    ,(post-ref post 'title)))
                             (div (@ (class "date"))
                                  ,(date->string (post-date post)
                                                 "~B ~d, ~Y"))
                             (div (@ (class "post"))
                                  ,(first-paragraph post))
                             (a (@ (href ,uri)) "read more ➔"))))
                   posts)))))

(define about-page
  (static-page
   "About Me"
   "about.html"
   `((h2 "Hi."))))

(define projects-page
  (static-page
   "Projects"
   "projects.html"
   `((h1 "Projects"))))

(site #:title "Jakob's Personal Webpage"
      #:domain "jakob.space"
      #:default-metadata
      '((author . "Jakob L. Kreuze")
        (email  . "zerodaysfordays@sdf.lonestar.org"))
      #:readers (list html-reader)
      #:builders (list (blog #:theme jakob-theme #:collections %collections)
                       (atom-feed)
                       (atom-feeds-by-tag)
                       about-page
                       projects-page
                       (static-directory "css")
                       (static-directory "js")
                       (static-directory "fonts")
                       (static-directory "images")))