(declare (module (boudin page))
         (export make-page page?
                 page-content page-output page-template page-writer
                 page-meta page-meta-set! page-ref page-set!
                 page-slug page-updated page-url))

(import (boudin site)
        (boudin util)
        (chicken file posix)
        (chicken file)
        (chicken pathname)
        (chicken time posix)
        (srfi 1))

(define-record-type page
  (make-page content output template writer meta)
  page?
  (content page-content)
  (output page-output)
  (template page-template)
  (writer page-writer)
  (meta page-meta page-meta-set!))

(define (page-ref pg k)
  (assoc-ref k (or (page-meta pg) '())))

(define (page-set! pg k v)
  (page-meta-set! pg (cons (cons k v)
                           (page-meta pg))))

(define (*urlify path)
  (normalize-pathname
   (make-pathname (list (string-append "https://" (site-host))
                        (pathname-strip-extension path))
                  "index.html")))

(define (page-url pg)             ; foo.html => http://site.com/foo/index.html
  (or (page-ref pg "url")         ; memoization
      (let ((url (*urlify (page-ref pg "source"))))
        (page-set! pg "url" url)
        url)))

(define (*slugify url)                  ; I don't love how this is written..
  (let-values (((_ _ dirs) (decompose-directory url)))
    (let loop ((this (car dirs))
               (rest (cdr dirs)))
      (if (null? (cdr rest))
          (make-pathname (list "/" this) #f)
          (loop (car rest)
                (cdr rest))))))

(define (page-slug pg)               ; http://site.com/foo/index.html => /foo/
  (or (page-ref pg "slug")           ; memoization
      (let ((slug (*slugify (page-url pg))))
        (page-set! pg "slug" slug)
        slug)))

(define (*page-mtime pg)
  (let ((file (page-ref pg "source")))
    (and file
         (file-exists? file)
         (time->string (seconds->utc-time (file-modification-time file))))))

(define (page-updated pg)
  (let ((meta-date (page-ref pg "date")))
    (or (and meta-date                ; memoization
             (find (lambda (fmt) (string->time meta-date fmt))
                   (site-date-formats)))
        (*page-mtime pg)
        (site-build-time))))