95 lines
3.2 KiB
Common Lisp
95 lines
3.2 KiB
Common Lisp
|
;;;; Simple CD Database program:
|
||
|
|
(defvar *cd-database* nil "The current state of the CD database.")
|
||
|
|
|
||
|
|
(defun make-cd (title artist rating ripped)
|
||
|
|
"Creates a CD record."
|
||
|
|
(list :title title :artist artist :rating rating :ripped ripped))
|
||
|
|
|
||
|
|
(defun add-cd (cd)
|
||
|
|
"Adds a CD record to the database."
|
||
|
|
(push cd *cd-database*) (setf *cd-database* (sort *cd-database* #'cd-sort-by-title)))
|
||
|
|
|
||
|
|
(defun print-cd-database (&optional database)
|
||
|
|
"Prints the current CD database, or, optionally, a passed in database."
|
||
|
|
(if database
|
||
|
|
(dolist (cd database)
|
||
|
|
(format t "~{~a: ~10t~a~%~}~%" cd))
|
||
|
|
(dolist (cd *cd-database*)
|
||
|
|
(format t "~{~a: ~10t~a~%~}~%" cd))))
|
||
|
|
|
||
|
|
(defun prompt-read (prompt)
|
||
|
|
"Prompts for a single line of user input."
|
||
|
|
(format *query-io* "~a: " prompt)
|
||
|
|
(force-output *query-io*)
|
||
|
|
(read-line *query-io*))
|
||
|
|
|
||
|
|
(defun prompt-for-cd ()
|
||
|
|
"Creates a CD record using user input."
|
||
|
|
(make-cd
|
||
|
|
(prompt-read "Title")
|
||
|
|
(prompt-read "Artist")
|
||
|
|
(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
|
||
|
|
(y-or-n-p "Ripped [y/n]: ")))
|
||
|
|
|
||
|
|
(defun add-cds ()
|
||
|
|
"Adds one or more CDs to the database with user input."
|
||
|
|
(loop (add-cd (prompt-for-cd))
|
||
|
|
(if (not (y-or-n-p "Another? [y/n]: ")) (return))))
|
||
|
|
|
||
|
|
(defun cd-sort-by-title (a b)
|
||
|
|
"Sorts two CD records alphabetically."
|
||
|
|
(string< (getf a :title) (getf b :title)))
|
||
|
|
|
||
|
|
(defun save-cds (filename)
|
||
|
|
"Saves the CD database to a file."
|
||
|
|
(with-open-file
|
||
|
|
(file-output filename
|
||
|
|
:direction :output
|
||
|
|
:if-exists :supersede)
|
||
|
|
(with-standard-io-syntax
|
||
|
|
(print *cd-database* file-output))))
|
||
|
|
|
||
|
|
(defun read-cds (filename)
|
||
|
|
"Loads a CD database from a file."
|
||
|
|
(with-open-file
|
||
|
|
(file-input filename)
|
||
|
|
(with-standard-io-syntax
|
||
|
|
(print-cd-database (setf *cd-database* (read file-input))))))
|
||
|
|
|
||
|
|
(defun delete-cds (selector-function)
|
||
|
|
"Deletes CD records according to a selector function."
|
||
|
|
(print-cd-database (setq *cd-database* (remove-if selector-function *cd-database*))))
|
||
|
|
|
||
|
|
(defun select (selector-function)
|
||
|
|
"Select records from a database based on a selector function."
|
||
|
|
(print-cd-database (remove-if-not selector-function *cd-database*)))
|
||
|
|
|
||
|
|
(defun update (selector-function &key title artist rating (ripped nil ripped-p))
|
||
|
|
"Update selected records in a database."
|
||
|
|
(setf *cd-database*
|
||
|
|
(mapcar
|
||
|
|
#'(lambda (row)
|
||
|
|
(when (funcall selector-function row)
|
||
|
|
(if title (setf (getf row :title) title))
|
||
|
|
(if artist (setf (getf row :artist) artist))
|
||
|
|
(if rating (setf (getf row :rating) rating))
|
||
|
|
(if ripped-p (setf (getf row :ripped) ripped)))
|
||
|
|
row) *cd-database*)))
|
||
|
|
|
||
|
|
(defun make-comparison-expression (field value)
|
||
|
|
"Create a comparison function for a field and a value in a plist."
|
||
|
|
`(equal (getf cd ,field) ,value))
|
||
|
|
|
||
|
|
(defun make-comparisons-list (fields)
|
||
|
|
"Create a list of plist comparison functions."
|
||
|
|
(loop while fields
|
||
|
|
collecting (make-comparison-expression (pop fields) (pop fields))))
|
||
|
|
|
||
|
|
(defmacro where (&rest clauses)
|
||
|
|
"Create an expression where all plist comparisons must be true."
|
||
|
|
`#'(lambda (row) (and ,@(make-comparisons-list clauses))))
|
||
|
|
|
||
|
|
;; Load up the CD database on startup:
|
||
|
|
(read-cds "~/.cds.db")
|
||
|
|
(print-cd-database)
|