;;; (boudin types) --- pages, indeces, and static files
;;
;; All paths are relative to the site directory unless otherwise noted

;;; Pages

(define-record-type page
  (make-page path                       ; Input path
             dest                       ; Output path (rel. to output directory)
             text                       ; Input text
             sxml                       ; Rendered sxml
             meta                       ; Metadata (title, etc.)
             )
  page?
  (path page-path)
  (dest page-dest set-page-dest!)
  (text page-text set-page-text!)
  (sxml page-sxml set-page-sxml!)
  (meta page-meta set-page-meta!))

(define (page-ref pg key)
  (assoc-ref key (page-meta pg) (lambda _ #f)))

(define (page-set! pg key val)
  (set-page-meta! pg (cons (cons key val)
                           (page-meta pg))))

(define (extract-metadata sxml)
  (let loop ((tree sxml)
             (acc '()))
    (cond
     ((not (pair? tree))
      (reverse acc))
     ((and (list? (car tree))
           (eq? (caar tree) '*COMMENT*))
      (loop (cdr tree)
            (map (lambda (ln)
                   (let ((kv (string-split ln ":" 'infix 1)))
                     (cons (string-trim-both (car kv))
                           (string-trim (cdr kv)))))
                 (string-split (cadar tree) "\n"))))
     ((list? (car tree))
      (loop (cdr tree)
            (let ((subtree (loop (car tree) '())))
              (if (null? subtree)
                  acc
                  (cons subtree acc)))))
     (else (loop (cdr tree) acc)))))

(define (*urlify path)
  (normalize-pathname
   (make-pathname (list (site-url)
                        (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-path pg))))
        (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-path pg)))
    (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
             (find (lambda (fmt) (string->time meta-date fmt))
                   (page-date-formats)))
        (*page-mtime pg)
        (build-time))))

(define (read-page path)
  (let ((pg (make-page path #f #f #f #f)))
    (set-page-dest! pg ((apply o (page-path-transformers)) path))
    (set-page-text! pg (with-input-from-file path slurp))
    (set-page-sxml! pg ((apply o (page-text-transformers)) (page-text pg)))
    (set-page-meta! pg (extract-metadata (page-sxml pg)))
    pg))

(define write-page
  (case-lambda
    ((pg) (call-with-output-file (page-dest pg)
            (lambda (port) (write-page pg port))))
    ((pg port)
     (sxml-display-as-html ((eval/q (page-template)) pg) port))))


;;; Indeces
;; These are generated pages from collections of other pages.  Think index.html,
;; feed.xml, possibly tag indeces and the like.  These pages don't have a source
;; file, but they have a destination and a template.  Because there are
;; different file formats here and ... stuff, there's also a slot for the index
;; writer function.  Finally, pages and meta are the pages and various other
;; metadata of the index.

(define-record-type index
  (make-index dest                      ; Relative to (site-dest)
              template                  ; Template to put pages in
              writer                    ; Proc to write sxml out to a file
              pages                     ; Input pages
              meta                      ; Various other metadata
              )
  index?
  (dest index-dest set-index-dest!)
  (template index-template set-index-template!)
  (writer index-writer set-index-writer!)
  (pages index-pages set-index-pages!)
  (meta index-meta set-index-meta!))

(define (index-ref idx key)
  (assoc-ref key (index-meta idx) (lambda _ #f)))

(define (index-set! idx key val)
  (set-index-meta! idx (cons (cons key val)
                             (index-meta idx))))

(define (index-push! idx pg)
  (set-index-pages! idx (cons pg (index-pages idx))))

(define (index-for-each idx proc)
  (for-each proc (index-pages idx)))

(define write-index
  (case-lambda
    ((idx) (call-with-output-file (index-dest idx)
             (lambda (port) (write-index idx (current-output-port)))))
    ((idx port)
     ((index-writer idx) ((index-template idx) (index-pages idx)) port))))


;;; Static files
;; These are simply copied from the input to the output, possibly with a changed
;; path.  Because these are just files, we don't need a record type.

(define (static-copy path)
  (copy-file path
              (make-pathname (site-dest) path)
              'clobber))