generate.lisp @ 14a9e325836e lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload (list :alexandria :iterate :losh :local-time
                      :cl-who :3bmd :3bmd-ext-code-blocks)
                :silent t))

(defpackage :stevelosh.com
  (:use :cl :iterate :losh)
  (:import-from :cl-who
    :with-html-output :htm :str)
  (:export :toplevel))

(in-package :stevelosh.com)

;;;; State and Configuration --------------------------------------------------
(setf (cl-who:html-mode) :html5
      3bmd-code-blocks:*code-blocks* t)


;;;; Utilities ----------------------------------------------------------------
(defun human-date (timestamp)
  (check-type timestamp local-time:timestamp)
  (local-time:format-timestring
    nil timestamp
    :format `(:long-month " " :ordinal-day ", " :year)))

(defmacro who (&body body)
  `(with-html-output (*standard-output*) ,@body))

(defmacro delay (&body body)
  `(let (result done)
     (lambda ()
       (if done
         result
         (setf done t result (progn ,@body))))))

(defun force (delay)
  (funcall delay))

(defun cat (&rest strings)
  (apply #'concatenate 'string strings))


;;;; Content ------------------------------------------------------------------
(defclass* content ()
  (input-path output-path date modified-timestamp body
   url title draft gallery snip
   (mathjax :initform nil)))

(defun parse-markdown (path)
  (with-open-file (stream path :direction :input)
    (read stream) ; discard metadata this time
    (with-output-to-string (string)
      (3bmd:parse-string-and-print-to-stream
        (alexandria:read-stream-content-into-string stream)
        string))))

(defun read-content (path)
  (with-open-file (s path :direction :input)
    (let ((metadata (if (string= #\left_parenthesis (peek-char nil s))
                      (read s)
                      (return-from read-content nil))))
      (callf (getf metadata :date) #'local-time:parse-rfc3339-timestring)
      (apply
        #'make-instance 'content
        :input-path path
        :output-path (ppcre:regex-replace "content/(.*)\\.markdown" path "build/\\1/index.html")
        :url (ppcre:regex-replace "content/(.*)\\.markdown" path "/\\1/")
        :modified-timestamp (file-write-date path)
        :body (delay (parse-markdown path))
        metadata))))

(defun walk (path)
  (-<> (sh (list "find" path "-name" "*.markdown") :result-type 'list)
    (mapcar #'read-content <>)
    (remove nil <>)
    (sort <> #'local-time:timestamp> :key #'date)))

(defun gallery-photos (gallery)
  (let* ((slug (gallery gallery))
         (photo-path (cat "static/images/photography/photos/" slug))
         (thumb-path (cat "static/images/photography/thumbnails/" slug))
         (files (sh (list "ls" "-1" photo-path) :result-type 'list)))
    (loop :for file :in files
          :collect (cons (cat "/" photo-path "/" file)
                         (cat "/" thumb-path "/" file)))))


;;;; Base Templates -----------------------------------------------------------
(defun t/header ()
  (who
    (:header
     (:a :id "logo" :href "/" "Steve Losh")
     (:nav
      (:a :href "/blog/" "Blog")
      " - " (:a :href "/projects/" "Projects")
      " - " (:a :href "/photography/" "Photography")
      " - " (:a :href "/links/" "Links")
      " - " (:a :href "/feed/" "Feed")))))

(defun t/footer ()
  (who
    (:footer
     (:nav
      (:a :href "https://meta.sr.ht/~sjl/" "Source Hut")
      " ・ " (:a :href "https://github.com/sjl/" "GitHub")
      " ・ " (:a :href "https://twitter.com/stevelosh/" "Twitter")
      " ・ " (:a :href "https://instagram.com/thirtytwobirds/" "Instagram")
      " ・ " (:a :href "https://hg.sr.ht/~sjl/.plan/" ".plan")))))

(defun t/base (title page-id body)
  (who
    (:html :lang "en"
     (:head
      (:meta :charset "utf-8")
      (:link :href "/static/style.css" :rel "stylesheet")
      (:title (str (if title
                     (format nil "~A / Steve Losh" title)
                     "Steve Losh"))))
     (:body
      (t/header)
      (:hr :class "main-separator")
      (:main :id (format nil "page-~A" page-id)
       (funcall body))
      (:hr :class "main-separator")
      (t/footer)))))

(defmacro with-base ((page-class &optional title) &body body)
  `(t/base ,title ,page-class (lambda () ,@body)))


;;;; Page Templates -----------------------------------------------------------
(defun t/mathjax ()
  (who (str "<script type=\"text/javascript\" async
                     src=\"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML\"></script>")))


(defun t/index-item (item)
  (who
    (:li :class "item"
     (:a :href (url item) (str (title item)))
     (:p :class "date" (str (human-date (date item))))
     (:p :class "snippet" (str (snip item))))))

(defun t/index (items)
  (who (:ol :class "index" (map nil #'t/index-item items))))


(defun t/blog/index (entries)
  (with-base ("blog-index" "Blog")
    (t/index entries)))

(defun t/blog/entry (entry)
  (with-base ("blog-entry" (title entry))
    (who
      (:article
       (when (mathjax entry) (t/mathjax))
       (:h1 (:a :href (url entry) (str (title entry))))
       (:p :class "date"
        "Posted on " (str (human-date (date entry))) ".")
       (str (force (body entry)))))))


(defun t/photography/index (galleries)
  (with-base ("photography-index" "Photography")
    (t/index galleries)))


(defun t/photography/gallery/photo (photo)
  (destructuring-bind (photo . thumb) photo
    (who (:li (:a :href photo (:img :src thumb))))))

(defun t/photography/gallery (gallery)
  (with-base ("photography-gallery" (title gallery))
    (who
      (:article
       (:h1 (:a :href (url gallery) (str (title gallery))))
       (:p :class "date"
        "Last updated on " (str (human-date (date gallery))) ".")
       (str (force (body gallery)))
       (:ul
        (map nil #'t/photography/gallery/photo (gallery-photos gallery)))))))


(defun t/simple (content)
  (with-base ("simple" (title content))
    (who
      (:article
       (:h1 (:a :href (url content) (str (title content))))
       (:p :class "date"
        "Last updated on " (str (human-date (date content))) ".")
       (str (force (body content)))))))

(defun t/home ()
  (with-base ("home")
    (who
      (:p "Hello, I'm Steve.")
      (:p "I'm a photographer, programmer, dancer, and bassist currently living in "
       (:a :href "https://rochestermade.com/" "Rochester, New York")
       ".")
      (:p "If you want to get in touch with me, "
       (:a :href "mailto:steve@stevelosh.com" "email")
       " is best."))))

(defun t/404 ()
  (with-base ("not-found")
    (who
      (:h1 "404 Not Fount")
      (:p "If you followed a link to get here, it's bad."))))


;;;; Generation ---------------------------------------------------------------
(defparameter *generate-timestamp* (file-write-date "generate.lisp"))

(defun needs-render-p (path times)
  (or (null (probe-file path))
      (let ((prev (file-write-date path)))
        (or (> *generate-timestamp* prev)
            (some (lambda (time) (> time prev))
                  (alexandria:ensure-list times))))))

(defun render% (path times thunk)
  (if (needs-render-p path times)
    (progn
      (format t "Rendering ~S~%" path)
      (ensure-directories-exist path)
      (with-open-file (*standard-output* path
                                         :direction :output
                                         :if-exists :supersede)
        (with-html-output (*standard-output* nil :prologue t)
          (funcall thunk))))
    #+no (format t "Skipping ~S, file is up to date.~%" path)))

(defmacro render (path &optional times &body body)
  `(render% ,path ,times (lambda () ,@body)))

(defun page/home ()
  (render "build/index.html" nil
    (t/home)))

(defun page/404 ()
  (render "build/404.html" nil
    (t/404)))

(defun page/blog/index (entries)
  (render "build/blog/index.html" (mapcar #'modified-timestamp entries)
    (t/blog/index entries)))

(defun page/photography/index (galleries)
  (render "build/photography/index.html" (mapcar #'modified-timestamp galleries)
    (t/photography/index galleries)))

(defun page/blog/entries (entries)
  (dolist (entry entries)
    (render (output-path entry) (modified-timestamp entry)
      (t/blog/entry entry))))

(defun page/photography/galleries (galleries)
  (dolist (gallery galleries)
    (render (output-path gallery) (modified-timestamp gallery)
      (t/photography/gallery gallery))))

(defun page/simple (content)
  (render (output-path content) (modified-timestamp content)
    (t/simple content)))


;;;; Toplevel -----------------------------------------------------------------
(defun toplevel ()
  (let ((blog-entries (walk "content/blog"))
        (photo-galleries (walk "content/photography"))
        (links (read-content "content/links.markdown"))
        (projects (read-content "content/projects.markdown")))
    (page/home)
    (page/404)
    (page/blog/index blog-entries)
    (page/blog/entries blog-entries)
    (page/photography/index photo-galleries)
    (page/photography/galleries photo-galleries)
    (page/simple links)
    (page/simple projects)))


#; Scratch --------------------------------------------------------------------
(defparameter *blog-entries*
  (walk "content/blog"))