(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 description uri author posts styles scripts)
  index?
  (title index-title)
  (description index-description)
  (uri index-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 "")
                      (description "")
                      (uri "")
                      (author (person ""))
                      (posts '())
                      (styles '())
                      (scripts '())
                #:allow-other-keys)
  (make-index title description uri author posts 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-description index))))
       ,@(map render-style (index-styles index)))
     (body
       ,@(map render-post (index-posts index))
       ,@(map render-script (index-scripts index)))))

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