generate.lisp @ d20bad4b886f lisp

(ql:quickload (list :alexandria :iterate :losh :local-time
                    :cl-who :3bmd :3bmd-ext-code-blocks))

(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))


;;;; 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/blog/index/item (entry)
  (who
    (:li
     (:a :href (getf entry :url) (str (getf entry :title)))
     (:p :class "entry-date" (str (human-date (getf entry :date))))
     (:p :class "snippet" (str (getf entry :snip))))))

(defun t/blog/index (entries)
  (with-base ("blog-index" "Blog")
    (who
      (:ul (map nil #'t/blog/index/item entries)))))

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

(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."))))


;;;; Markdown -----------------------------------------------------------------
(defun parse-markdown-stream (stream)
  (with-output-to-string (s)
    (3bmd:parse-string-and-print-to-stream
     (alexandria:read-stream-content-into-string stream)
     s)))

(defun read-markdown-file (path)
  (with-open-file (s path :direction :input)
    (let ((metadata (if (string= #\left_parenthesis (peek-char nil s))
                      (read s)
                      (return-from read-markdown-file nil)))
          (body (parse-markdown-stream s)))
      (append
        (list :body body
              :input-path path
              :date (when-let ((d (getf metadata :date)))
                      (local-time:parse-rfc3339-timestring d))
              :output-path (ppcre:regex-replace "content/(.*)\\.markdown" path "build/\\1/index.html")
              :url (ppcre:regex-replace "content/(.*)\\.markdown" path "/\\1/"))
        metadata))))


;;;; Data ---------------------------------------------------------------------
(defun walk (path)
  (-<> (sh (list "find" path "-name" "*.markdown") :result-type 'list)
    (sort <> #'string>)
    (mapcar #'read-markdown-file <>)
    (remove nil <>)))


;;;; Generation ---------------------------------------------------------------
(defmacro render (path &body body)
  `(progn
     (ensure-directories-exist ,path)
     (with-open-file (*standard-output* ,path
                                        :direction :output
                                        :if-exists :supersede)
       (with-html-output (*standard-output* nil :prologue t)
         ,@body))))

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

(defparameter *blog-entries*
  (walk "content/blog"))

(defun page/blog/index ()
  (render "build/blog/index.html" (t/blog/index *blog-entries*)))

(defun page/blog/entries ()
  (dolist (entry *blog-entries*)
    (render (getf entry :output-path) (t/blog/entry entry))))


;;;; Toplevel -----------------------------------------------------------------
(defun toplevel ()
  (page/home)
  (page/blog/index)
  (page/blog/entries)
  )


#; Scratch --------------------------------------------------------------------