(define-module (src theme)
  #:use-module (srfi srfi-19)
  #:use-module (haunt post)
  #:use-module (haunt site)
  #:use-module (haunt builder blog)
  #:use-module (src urls)
  #:use-module (src date-utils)
  #:export (weekly-news-theme))

(define (weekly-news-layout site title body)
  `((doctype "html")

    (html
     (@ (lang "en"))

     (head
      ,(if (null? title)
           `(title "Guix Weekly News")
           `(title ,(string-append title " — Guix Weekly News")))
      (meta (@ (charset "UTF-8")))
      (meta (@ (name "viewport")
               (content "width=device-width, initial-scale=1.0")))
      ;; Base CSS.
      (link (@ (rel "stylesheet") (href "/static/css/base.css")))
      ;; Feeds.
      (link (@ (type "application/atom+xml") (rel "alternate")
               (title "GNU Guix — Activity Feed")
               (href "feeds/blog.atom")))
      (link (@ (rel "icon") (type "image/png")
               (href "/static/img/icon.png")))
      (link (@ (rel "icon") (type "image/svg+xml") (sizes "any")
               (href "/static/img/icon.svg"))))

     (body
      (header
       (a (@ (href "/"))
          (h2
           (@ (style "color: white; margin: 0.4em; font-size: 2em;"))
           (img (@ (style "height: 1.1em;")
                   (src "/static/img/guix-logo.png")))
           "Guix Weekly News")))
      (main
       (article
        (@ (class "page centered-block limit-width"))
        ,body))
      (footer
       "Made with " (span (@ (class "metta")) "♥")
       " by humans and powered by "
       (a (@ (class "link-yellow") (href ,(gnu-url "software/guile/")))
          "GNU Guile") ".  "
          (a
           (@ (class "link-yellow")
              (href "https://git.cbaines.net/guix/weekly-news/"))
           "Source code")
          " under the "
          (a
           (@ (class "link-yellow")
              (href ,(gnu-url "licenses/agpl-3.0.html")))
           "GNU AGPL") ".")))))

(define (is-year-and-week-a-draft? year week)
  (time>? (date->time-utc
           (lookup-end-date-for-week year week))
          (current-time)))

(define (weekly-news-post-template post)
  (let ((year (post-ref post 'year))
        (week (post-ref post 'week)))
    `((div
       ,@(or (and=>
              (previous-week-with-year year week)
              (lambda (previous-week-and-year)
                `((a (@ (href ,(apply weekly-news-post-url
                                      previous-week-and-year)))
                     (span (@ (id "left-nav"))
                           "Previous week")))))
             '())
       (h1 (@ (id "center"))
           ,(post-ref post 'title))
       ,@(or (and=>
              (and (and=> (next-week-with-year year week)
                          (lambda (next-week-and-year)
                            (not (apply is-year-and-week-a-draft?
                                        next-week-and-year))))
                   (next-week-with-year year week))
              (lambda (next-week-and-year)
                `((a (@ (href ,(apply weekly-news-post-url
                                      next-week-and-year)))
                     (span (@ (id "right-nav"))
                           "Next week")))))
             '()))
      (div
       (@ (style "text-align: center;"))
       ,(date->string (post-ref post 'start-date) "~1")
       " to "
       ,(date->string (post-ref post 'end-date) "~1"))
      (br)
      ,(post-sxml post))))

(define (weekly-news-collection-template site title posts prefix)
  (define (post-uri post)
    (string-append (or prefix "") "/"
                   (site-post-slug site post) ".html"))

  (define (date->string* date)
    (date->string date "~a ~d ~b"))

  `((ul
     (@ (id "post-list"))
     ,@(map (lambda (post)
              (let ((draft
                     (time>? (date->time-utc
                              (post-ref post 'end-date))
                             (current-time))))
                `(li
                  (@ (class ,(if draft "draft-post" "")))
                  ,(if draft
                       `((time
                          "Week " ,(post-ref post 'week)
                          (div
                           (@ (style "font-size: small;"))
                           "Beginning "
                           ,(date->string*
                             (post-ref post 'start-date))))
                         ,(string-append
                           "Will be published on "
                           (date->string (move-date-by-days
                                          (post-ref post 'start-date)
                                          7)
                                         "~A (~1)")))
                       `(a (@ (href ,(post-uri post)))
                           (time
                            "Week " ,(post-ref post 'week)
                            (div
                             (@ (style "font-size: small;"))
                             "Beginning "
                             ,(date->string*
                               (post-ref post 'start-date))))
                           ,(post-ref post 'synopsis))))))
            posts)
     ,@(if (string=? title "Recent posts")
           '((li
              (a (@ (style "margin-bottom: 1em;")
                    (href "/all.html"))
                 "All posts")))
           '()))))

(define weekly-news-theme
  (theme #:name "Weekly news"
         #:layout weekly-news-layout
         #:post-template weekly-news-post-template
         #:collection-template weekly-news-collection-template))