Initialize Repository

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

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