update the update script to use git

[clinton/website/site-support.git] / books.lisp

;; (((author name as symbols)
;;   "description"
;;   ("book name" :fiction-or-nonfiction rating/10 "description")))

(asdf:oos 'asdf:load-op :split-sequence)
(asdf:oos 'asdf:load-op :html-template)

(in-package :cl-user)

(defparameter *book-pathname*
  #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")

(defparameter *template-pathname*
  #p"/home/clinton/html/muse/site-support/templates/book-list.template")

(defparameter *muse-pathname*
  #p"/home/clinton/html/muse/site/unknownlamer.org-repo/Book List.muse")

;; need to collapse whitespace in descriptions

;; (defun collapse-whitespace (string)
;;   (format nil "~{~A ~}"
;; 	  (split-sequence:split-sequence-if
;; 	   (lambda (char) (member char '(#\space #\newline))) string
;; 	   :remove-empty-subseqs t)))

(defun collapse-whitespace (string)
  string)

(defun book-entry-vars (book)
  (destructuring-bind (title fiction? &optional rating description)
      book
    `(:title ,title
      :ratingp ,rating
      :rating-good ,rating
      :rating-bad ,(if rating (- 10 rating))
      :classification ,(case fiction?
			     (:fiction "Fiction")
			     (:nonfiction "Nonfiction"))
      :description ,(collapse-whitespace description))))

(defun author-vars (author)
  (destructuring-bind (name description &rest books)
      author
    `(:name ,(format nil "~{~A ~}" name)
      :description ,description
      :books ,(mapcar #'book-entry-vars books))))

(defun book-database-vars (book-database)
  `(:authors ,(mapcar #'author-vars book-database)))

(defun dump-muse-books-file (&key (muse-path *muse-pathname*)
			          (book-path *book-pathname*)
			          (template-path *template-pathname*)
			          (force nil))
  (when (or force
	    (> (file-write-date book-path) (file-write-date muse-path))
	    (> (file-write-date template-path) (file-write-date muse-path)))
    (with-open-file (muse-stream muse-path
				 :direction :output
				 :element-type 'extended-char
				 :if-exists :supersede
				 :if-does-not-exist :create)
      (let ((html-template:*string-modifier* #'identity)
	    (html-template:*template-start-marker* "<<")
	    (html-template:*template-end-marker* ">>"))
	(html-template:fill-and-print-template
	 template-path
	 (book-database-vars
	  (sort (copy-list (with-open-file
			       (book-stream book-path :element-type 'extended-char)
			     (read book-stream)))
		(lambda (e1 e2)
		  (let ((se1 (string-upcase (symbol-name (car (last e1)))))
			(se2 (string-upcase (symbol-name (car (last e2))))))
		    (string< se1 se2)))
		:key #'car))
	 :stream muse-stream)))))