books.lisp

   1 ;; (((author name as symbols)
   2 ;;   "description"
   3 ;;   ("book name" :fiction-or-nonfiction rating/10 "description")))
   4
   5 (asdf:oos 'asdf:load-op :split-sequence)
   6 (asdf:oos 'asdf:load-op :html-template)
   7
   8 (in-package :cl-user)
   9
  10 (defparameter *book-pathname*
  11   #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
  12
  13 (defparameter *template-pathname*
  14   #p"/home/clinton/html/muse/site-support/templates/book-list.template")
  15
  16 (defparameter *muse-pathname*
  17   #p"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")
  18
  19 ;; need to collapse whitespace in descriptions
  20
  21 ;; (defun collapse-whitespace (string)
  22 ;;   (format nil "~{~A ~}"
  23 ;;        (split-sequence:split-sequence-if
  24 ;;         (lambda (char) (member char '(#\space #\newline))) string
  25 ;;         :remove-empty-subseqs t)))
  26
  27 (defun collapse-whitespace (string)
  28   string)
  29
  30 (defun book-entry-vars (book)
  31   (destructuring-bind (title fiction? &optional rating description)
  32       book
  33     `(:title ,title
  34       :ratingp ,rating
  35       :rating-good ,rating
  36       :rating-bad ,(if rating (- 10 rating))
  37       :classification ,(case fiction?
  38                              (:fiction "Fiction")
  39                              (:nonfiction "Nonfiction"))
  40       :description ,(collapse-whitespace description))))
  41
  42 (defun author-vars (author)
  43   (destructuring-bind (name description &rest books)
  44       author
  45     `(:name ,(format nil "~{~A ~}" name)
  46       :description ,description
  47       :books ,(mapcar #'book-entry-vars books))))
  48
  49 (defun book-database-vars (book-database)
  50   `(:authors ,(mapcar #'author-vars book-database)))
  51
  52 (defun dump-muse-books-file (&key (muse-path *muse-pathname*)
  53                                   (book-path *book-pathname*)
  54                                   (template-path *template-pathname*)
  55                                   (force nil))
  56   (when (or force
  57             (> (file-write-date book-path) (file-write-date muse-path))
  58             (> (file-write-date template-path) (file-write-date muse-path)))
  59     (with-open-file (muse-stream muse-path
  60                                  :direction :output
  61                                  :element-type 'extended-char
  62                                  :if-exists :supersede
  63                                  :if-does-not-exist :create)
  64       (html-template:fill-and-print-template
  65        template-path
  66        (book-database-vars
  67         (with-open-file (book-stream book-path :element-type 'extended-char)
  68           (read book-stream)))
  69        :stream muse-stream))))