(define-module (dustycloud templates)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-19)       ; dates
  #:use-module (haunt site)
  #:use-module (haunt post)
  #:use-module (haunt utils)
  #:use-module (haunt builder blog)
  #:export (base-tmpl
            post-tmpl
            collection-tmpl
            pagination-tmpl
            archive-tmpl

            flat-templates))

(define (tag-feed-url tag)
  (string-append "/feeds/tags/" tag ".xml"))

(define (tag-summary-url tag)
  (string-append "/tags/" tag "/"))

(define (post-uri site post)
  (string-append "/blog/" (post-slug post) "/"))


(define header-button
  (match-lambda
    ((link name)
     `(li (@ (class "button"))
          (a (@ (class "button")
                (href ,link))
             (img (@ (src ,(string-append "/etc/images/" name "_button.png"))
                     (alt ,name))))))))

(define top-buttonbar
  `(ul (@ (id "site_buttonbox"))
       ,@(map header-button
              '(("/blog/" "blog")
                ;; ("/art/" "http://mediagoblin.com/u/cwebber/")
                ;; ("/writing/" "writing")
                ("/contact/" "contact")))))

(define* (base-tmpl site body #:key title)
  `((doctype "html")
    (html
     (head
      (meta (@ (charset "utf-8")))
      (title ,(if title
                  (string-append title " -- " (site-title site))
                  (site-title site)))
      ;; css
      (link (@ (rel "stylesheet")
               (type "text/css")
               (href "/etc/css/base.css")
               (title "default")))
      (link (@ (rel "stylesheet")
               (type "text/css")
               (href "/etc/css/code.css")))
      (script (@ (type "text/javascript")
                 (src "/etc/js/resize.js")))
      ;; atom feed
      (link (@ (rel "alternate")
               (title (site-title site))
               (type "application/atom+xml")
               (href "/feed.xml"))))
     (body
      ;; header
      (div (@ (id "site_header"))
           (div (@ (id "site_logo"))
                (a (@ (href "/"))
                   (img (@ (class "site_logo")
                           (src "/etc/images/logo.png")))))
           ,top-buttonbar)
      ;; body
      (div (@ (id "site_content"))
           ,body)
      ;; footer
      (div (@ (id "site_footer"))
           (a (@ (rel "license")
                 (href "http://creativecommons.org/licenses/by-sa/4.0/"))
              (img (@ (alt "CC BY-SA 4.0")
                      (style "border-width: 0")
                      (src "http://i.creativecommons.org/l/by-sa/4.0/80x15.png")))
              " by "
              (a (@ (xmlns:cc "http://creativecommons.org/ns#")
                    (property "cc:attributionName")
                    (rel "cc:attributionURL")
                    (href "http://dustycloud.org"))
                 "Christine Lemmer-Webber")))))))

(define (post-meta-tmpl post)
  (define author (post-ref post 'author))
  (define date (post-ref post 'date))
  `(p (@ (class "meta"))
      "By "
      ,(post-ref post 'author)
      " on "
      (abbr (@ (class "published")
               (title ,(date->string date "~Y-~m-~dT~H:~M:~SZ")))
            ,(date->string* date))))

(define* (post-tmpl post #:key post-link
                    preview?)
  (define tags (post-ref post 'tags))
  `(div (@ (class "entry"))
        (h2 (@ (class "entry_title"))
            (a (@ (href ,post-link)
                  (rel "bookmark"))
               ,(post-ref post 'title)))
        ,(post-meta-tmpl post)
        (div (@ (class "text"))
             ,(if preview?
                  (first-paragraph post)
                  (post-sxml post)))
        ,@(if preview?
              `((div (@ (style "text-align: center;"))
                     (a (@ (href ,post-link))
                        "[... Read more ...]")))
              '())
        ,@(if tags
              `((p (@ (class "related"))
                   (b "Tags: ")
                   ,@(map (lambda (tag)
                            `(a (@ (href ,(tag-summary-url tag)))
                                ,tag))
                          (post-ref post 'tags))))
              '())))

(define (collection-tmpl site title posts prefix)
  `((div (@ (class "post-list"))
         ,@(map
            (lambda (post)
              (post-tmpl post #:post-link (post-uri site post)
                         ;; #:preview? #t
                         ))
            posts))))

(define (pagination-tmpl site body previous-page next-page)
  (define pagination
    `(div (@ (class "pagination"))
          ,(if previous-page
               `(a (@ (href ,previous-page)) "[<-Previous]")
               "[<-Previous]")
          " "
          (a (@ (href "/blog/"))
             "[--latest--]")
          " "
          (a (@ (href "/archive/"))
             "[--archive--]")
          " "
          ,(if next-page
               `(a (@ (href ,next-page)) "[Next->]")
               "Next->")))
  `(,pagination
    ,@body
    ,pagination))

;; Borrowed from davexunit's blog
(define (first-paragraph post)
  (let loop ((sxml (post-sxml post))
             (result '()))
    (match sxml
      (() (reverse result))
      ((or ((and ('p ...) paragraph) _ ...) (paragraph _ ...))
       (reverse (cons paragraph result)))
      ((head . tail)
       (loop tail (cons head result))))))

(define (post-preview post site)
  `(li (a (@ (href ,(post-uri site post)))
          (h2 (@ (style "text-align: left; margin: .3em;"))
              ,(post-ref post 'title)))
       (div (@ (class "news-feed-content"))
            (div (@ (class "news-feed-item-date"))
                 ,(date->string* (post-date post)))
            ,(first-paragraph post)
            (div (@ (class "consume-more-buttons"))
                 (a (@ (href ,(post-uri site post)))
                    "[Read more ==>]")))))

(define (archive-tmpl site posts)
  (define posts-by-year
    (let ((ht (make-hash-table)))      ; hash table we're building up
      (do ((posts posts (cdr posts)))  ; iterate over all posts
          ((null? posts) ht)           ; until we're out of posts
        (let* ((post (car posts))                   ; put this post in year bucket
               (year (date-year (post-date post)))
               (year-entries (hash-ref ht year '())))
          (hash-set! ht year (cons post year-entries))))))
  (define sorted-years
    (sort (hash-map->list (lambda (k v) k) posts-by-year) >))
  (define (year-content year)
    `(div (@ (style "margin-bottom: 10px;"))
          (h3 ,year)
          (ul ,@(map post-content
                     (posts/reverse-chronological
                      (hash-ref posts-by-year year))))))
  (define (post-content post)
    `(li
      (a (@ (href ,(post-uri site post)))
         ,(post-ref post 'title))))
  (define content
    `(div (@ (class "entry"))
          (h2 "Blog archive (by year)")
          (ul ,@(map year-content sorted-years))))
  (base-tmpl site content))


;;; Flat pages templates
;;; ====================

(define (default-flat-template site posts content metadata)
  (define title (assoc-ref metadata 'title))
  (base-tmpl site
             `(div (@ (class "plain_content"))
                   ,@(if (assoc-ref metadata 'title)
                         `((h1 ,title))
                         '())
                   ,content)
             #:title title))

(define (raw-flat-template site posts content metadata)
  (base-tmpl site
             content
             #:title (assoc-ref metadata 'title)))

(define (home-flat-template site posts content metadata)
  (define recent-posts
    `(div (@ (class "plain_content")
             (style "margin-left: 20px; margin-right: 20px;"))
          (h1 "Recent blogposts")
          (ul ,@(map (lambda (post)
                       #;(post-preview post site)
                       `(li
                         (a (@ (href ,(post-uri site post)))
                            ,(post-ref post 'title))
                         " -- "
                         ,(date->string* (post-date post))))
                     (take-up-to 10 (posts/reverse-chronological posts))))
          (p (@ (style "text-align: center"))
             (a (@ (href "/blog/"))
                "[--latest--]")
             " "
             (a (@ (href "/archive/"))
                "[--archive--]"))))
  (base-tmpl site
             `(div
               ,content
               (p (@ (style "text-align: center;"))
                  (img (@ (src "/etc/images/fleur_separator.png")
                          (alt ""))))
               ,recent-posts)
             #:title (assoc-ref metadata 'title)))

(define flat-templates
  `((default . ,default-flat-template)
    (raw . ,raw-flat-template)
    (home . ,home-flat-template)))
