(define-module (src html)
  #:use-module (src dates)
  #:use-module (srfi srfi-9)
  #:use-module (sxml simple)
  #:use-module (src mime-types)
  #:export (render
            person
            post
            index
            media
            css
            js))

(define-record-type <index>
  (%make-index title short-description long-description uri atom-feed-uri author posts styles scripts)
  index?
  (title index-title)
  (short-description index-short-description)
  (long-description index-long-description)
  (uri index-uri)
  (atom-feed-uri index-atom-feed-uri)
  (author index-author)
  (posts index-posts)
  (styles index-styles)
  (scripts index-scripts))

(define-record-type <post>
  (%make-post id
              title
              published
              updated
              authors
              summary-html
              content-html
              categories
              contributors
              media)
  post?
  (id post-id)
  (title post-title)
  (published post-published)
  (updated post-updated)
  (authors post-authors)
  (summary-html post-summary-html)
  (content-html post-content-html)
  (categories post-categories)
  (contributors post-contributors)
  (media post-media))

(define-record-type <media>
  (%make-media type uri path)
  media?
  (type media-type)
  (uri media-uri)
  (path media-path))

(define-record-type <person>
  (%make-person name email uri)
  person?
  (name person-name)
  (email person-email)
  (uri person-uri))


(define* (index #:key (title "")
                      (short-description "")
                      (long-description "")
                      (uri "")
                      (atom-feed-uri #f)
                      (author (person ""))
                      (posts '())
                      (styles '())
                      (scripts '())
                #:allow-other-keys)
         (%make-index
           title
           short-description
           long-description
           uri
           atom-feed-uri
           author
           (sort posts (lambda (a b)
                         (date>? (post-published a) (post-published b))))
           styles
           scripts))


(define* (post #:key (id #f)
                     (title "")
                     (published unix-date)
                     (updated unix-date)
                     (authors '())
                     (summary-html '())
                     (content-html '())
                     (categories '())
                     (contributors '())
                     (media '())
              #:allow-other-keys)

  (define (id-from-title title)
    (string-map (lambda (c)
                  (if (char-set-contains? char-set:letter c) c #\-))
                title))
  (%make-post (or id (id-from-title title))
              title
              published
              (find-newest (list published updated))
              authors
              summary-html
              content-html
              categories
              contributors
              media))

(define* (media path #:key (uri   "")
                     #:allow-other-keys)
  (define (type path)
    (let* ((extension (car (last-pair (string-split path #\.))))
           (type (assoc-ref mime-types extension)))
      (if (string? type) type (throw "Unknown mime-type"))))

  (%make-media (type path)
               uri
               path))

(define* (person name #:key (email "")
                            (uri   "")
                      #:allow-other-keys)
  (%make-person name email uri))

; Rendering
(define (render-author author)
  `(address (@(class author))
    (a (@(rel author)) ,(person-name author))))

(define (render-post post)
  `(article (@(class "post")
              (id ,(post-id post))) ;; For anchors
            (h2 ,(post-title post))
            (time (@(datetime ,(date->string/RFC3339 (post-published post)))
                    (pubdate #t))
                  ,(date->string/RFC3339 (post-published post))) ;; TODO make human readable
            ,@(map render-author (post-authors post))
            (section (@(class summary))
                     ,(post-summary-html post))
            (section (@(class content))
                     ,(post-content-html post))))

(define (render-style style)
  (if (media? style)
    `(link (@(rel stylesheet)
             (href ,(media-uri style))))
    `(style ,(lambda () (display style)))))

(define (render-script script)
 (if (media? script)
   `(script (@(src ,(media-uri script))))
   `(script ,(lambda () (display script)))))

(define (render-index index)
  `(html
     (head
       (meta (@(author ,(person-name (index-author index)))))
       (meta (@(charset "utf-8")))
       (meta (@(name "viewport")
               (content "width=device-width, initial-scale=1")))
       (meta (@(name "description")
               (content ,(index-short-description index))))
       ,(if (not (index-atom-feed-uri index))
         `()
         `(link (@(rel "alternate")
                  (type "application/atom+xml")
                  (href ,(index-atom-feed-uri index)))))
       ,@(map render-style (index-styles index)))
     (body
       (h1 (@(class title)) ,(index-title index))
       (section (@(class description)) ,(index-long-description index))
       ,@(map render-post (index-posts index))
       ,@(map render-script (index-scripts index)))))

(define (render index)
  (display "<!DOCTYPE html>")
  (sxml->xml (render-index index)))