(define-module (theme)
  #:use-module (haunt html)
  #:use-module (haunt site)
  #:use-module (haunt post)
  #:use-module (haunt artifact)
  #:use-module (haunt builder blog)
  #:use-module (sxml xpath)
  #:export (hwebs-theme-blog
            hwebs-theme-now
            flat-page-template
            game-page))

(define (post-uri post site prefix)
  (string-append "/" (or prefix "") "/"
                 (site-post-slug site post) ".html"))

;;
;; BLOG
;;

(define layout
  (lambda (site title body)
    `((doctype "html")
      (html
       (@ (lang "en"))
       (head
        (meta (@ (http-equiv "Content-Type")
                 (content "text/html")
                 (charset "utf-8")))
        (meta (@ (name "viewport")
                 (content "width=device-width, initial-scale=1.0")))
        (meta (@ (name "color-scheme")
                 (content "light dark")))
        (link (@ (rel "stylesheet")
                 (href "/style.css")))
        (link (@ (rel "icon")
                 (href "data:,")))
        (title ,(string-append title " — " (site-title site))))
       (body
        (header (span ,(assq-ref (site-default-metadata site) 'author))
                (nav (ul (li (a (@ (href "/")) "Home"))
                         (li (a (@ (href "/now")) "Now"))
                         (li (a (@ (href "/blog")) "Blog"))
                         (li (a (@ (href "/games.html")) "Games")))))
        (main
         ,body))))))


(define hwebs-theme-blog
  (theme #:name "hwebs"
         #:layout layout
         #:post-template
         (lambda (post)
           ;; TODO fill in datetime correctly
           ;; TODO add <author>? (as hidden?)
           `((article (h1 ,(post-title post))
                      (time ,(date->string*(post-date post)))
                      ,(post-sxml post))))
         #:collection-template
         (lambda (site title posts prefix)
           `((h1 ,title)
             (p (a (@ (href "/blog/feed.xml")) "Atom feed."))
             (ul
              ,@(map (lambda (post)
                       `(li (a (@ (href ,(post-uri post site prefix)))
                               ,(post-ref post 'title)
                               " — "
                               ,(date->string* (post-date post)))))
                     posts))))))

(define (flat-page-template site metadata body)
  ((theme-layout hwebs-theme-blog) site (assq-ref metadata 'title) `((h1 ,(assq-ref metadata 'title)) ,body)))

;;
;; NOW
;;

(define (rss-items-template items)
  `(ul
    ,@(map (lambda (item)
             `(li ,item))
           items)))

(define (rss-items post)
  ((sxpath '(rss channel item title *text*)) (post-sxml post)))

(define hwebs-theme-now
  (theme #:name "hwebs-now"
         #:layout layout
         #:post-template
         (compose rss-items-template rss-items)

         #:collection-template
         (lambda (site title posts prefix)
           `((h1 ,title)
             (p "My implementation of the "
                (a (@ (href "https://nownownow.com/about")) "\"now page\" concept by Derek Sivers")
                ".")
             ,@(map (lambda (post)
                      (define items
                        (rss-items post))
                      (if (member "feed" (post-tags post))
                          ;; TODO use dates from the feed for these as well? - most recent pubDate?
                          ;; TODO combine structure between the two types
                          `(section (h2 ,(post-ref post 'title))
                                    ,(rss-items-template
                                      ;; not optimal, btw
                                      (list-head items (min 5 (length items))))
                                    ;; TODO only show if there are more entries than max?
                                    (p (a (@ (href ,(post-uri post site prefix))) "See more.")))
                          `(section (h2 ,(post-ref post 'title))
                                    ;; TODO fill in datetime correctly
                                    ((header "updated " (time ,(date->string*(post-date post))))
                                     ,(post-sxml post)))))
                    posts)))))


;;; GAMES
(define (static-page title file-name body)
  (lambda (site posts)
    (serialized-artifact file-name
                         ;; TODO: simplify this
                         (with-layout hwebs-theme-now site title body)
                         sxml->html)))

(define (game-page name js file-name)
  (define body
    `((h1 ,name)
      (script (@ (src ,js)))
      (div (@ (id "app")))))
  (static-page name (string-append "games/" file-name) body))