| 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 | (let ((html-template:*string-modifier* #'identity) |
| 65 | (html-template:*template-start-marker* "<<") |
| 66 | (html-template:*template-end-marker* ">>")) |
| 67 | (html-template:fill-and-print-template |
| 68 | template-path |
| 69 | (book-database-vars |
| 70 | (sort (copy-list (with-open-file |
| 71 | (book-stream book-path :element-type 'extended-char) |
| 72 | (read book-stream))) |
| 73 | (lambda (e1 e2) |
| 74 | (let ((se1 (string-upcase (symbol-name (car (last e1))))) |
| 75 | (se2 (string-upcase (symbol-name (car (last e2)))))) |
| 76 | (string< se1 se2))) |
| 77 | :key #'car)) |
| 78 | :stream muse-stream))))) |