-;; (((author name as symbols)
-;; "description"
-;; ("book name" :fiction-or-nonfiction rating/10 "description")))
-
-(asdf:oos 'asdf:load-op :split-sequence)
-
-(in-package :cl-user)
-
-(defparameter *book-pathname*
- #p"/home/clinton/html/muse/src/unknownlamer.org/book-list.lisp")
-
-(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 print-book-entry (book &optional (stream t))
- (labels ((ratings-stars (rating)
- (labels ((stars (rating)
- (if (> rating 0)
- (make-string rating :initial-element #\bullet)
- nil)))
- (when rating
- (format nil "<class name=\"rating-good\">~A</class>~@[<class name=\"rating-bad\">~A</class>~] (~A)"
- (stars rating) (stars (- 10 rating)) rating)))))
- (destructuring-bind (title fiction? rating description)
- book
- (format stream "** ~A~%~%~@[*Rating:* ~A / ~]*~A*~%~%~A~%~%"
- title
- (ratings-stars rating)
- (case fiction?
- (:fiction "Fiction")
- (:nonfiction "Nonfiction"))
- (collapse-whitespace description)))))
-
-(defun print-author-entry (entry &optional (stream t))
- (destructuring-bind (author description &rest books)
- entry
- (format stream "* ~{~A ~}~%~%~A~%~%"
- author (collapse-whitespace description))
- (mapc (lambda (book) (print-book-entry book stream)) books)))
-
-(defun print-book-database (all-books &optional (stream t))
- (format stream "#title A Not So Fancy Listing of Books~%~%")
- (mapc (lambda (author) (print-author-entry author stream))
- all-books))
-
-(defun print-sorted-book-database (all-books &optional (stream t))
- (print-book-database (sort (copy-list all-books)
- (lambda (name-1 name-2)
- ;; obviously fails to sort properly
- ;; when two authors have the same last
- ;; name
- (string< (symbol-name name-1)
- (symbol-name name-2)))
- :key (lambda (entry) (car (last (car entry)))))
- stream))
-
-(defun dump-muse-books-file (&optional (muse-path *muse-pathname*)
- (book-path *book-pathname*))
- (with-open-file (muse-stream muse-path
- :direction :output
- :element-type 'extended-char
- :if-exists :overwrite
- :if-does-not-exist :create)
- (print-sorted-book-database
- (with-open-file (book-stream book-path :element-type 'extended-char)
- (read book-stream))
- muse-stream)))
\ No newline at end of file
+;; (((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)))))
HCoop / clinton / website / site-support.git / blobdiff