;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.

(use-modules (custom alias)
             (custom tag)
             (custom theme)
             (haunt builder atom)
             (haunt builder assets)
             (haunt builder blog)
             (haunt html)
             (haunt page)
             (haunt post)
             (haunt reader)
             (haunt site)
             (sxml simple)
             (srfi srfi-19)
             (srfi srfi-26)
             (ice-9 match))

;; Use a temporary reader until my patch makes it into an upstream release.
(define (read-html-post-prime port)
  (values (read-metadata-headers port)
          (let loop ((ret '()))
            (catch 'parser-error
              (lambda ()
                (match (xml->sxml port)
                  (('*TOP* sxml) (loop (cons sxml ret)))))
              (lambda (key . parameters)
                (reverse ret))))))

(define html-reader-prime
  (make-reader (make-file-extension-matcher "html")
               (cut call-with-input-file <> read-html-post-prime)))

;; Replace Haunt's default 'string->date* function with one that recognizes the
;; date format that Org uses.
(define (org-string->date str)
  "Convert STR, a string in Org format, into a SRFI-19 date object."
  (string->date str "<~Y-~m-~d ~a>"))

(register-metadata-parser! 'date org-string->date)

(define (static-page title slug)
  (lambda (site posts)
    (let ((file-name (format #f "~a.html" slug))
          (body (load (format #f "~a.scm" slug))))
      (make-page file-name
                 (with-layout jakob-theme site title body)
                 sxml->html))))

(define %collections
  `(("Recent Posts" "index.html" ,posts/reverse-chronological)))

(define %aliases
  '(("blog/post/Bad BEHAVIOR" . "/reverse-engineering-babbys-first-archive-format.html")))

(site #:title "Jakob's Personal Webpage"
      #:domain "jakob.space"
      #:default-metadata
      '((author . "Jakob L. Kreuze")
        (email  . "zerodaysfordays@sdf.lonestar.org"))
      #:make-slug (lambda (post)
                    (let* ((file-name (post-file-name post))
                           (splice-start (+ (string-rindex file-name
                                                           (cut char=? <> #\/))
                                            1))
                           (splice-end (string-rindex file-name
                                                      (cut char=? <> #\.))))
                      (substring file-name splice-start splice-end)))
      #:readers (list html-reader-prime)
      #:builders (list (blog #:theme jakob-theme #:collections %collections)
                       (article-aliases %aliases)
                       (atom-feed)
                       (sort-by-tag)
                       (static-page "About Me" "about")
                       (static-page "Projects" "projects")
                       (static-directory "css")
                       (static-directory "fonts")
                       (static-directory "images")))