Last active
July 24, 2017 07:59
-
-
Save z3t0/608f84bf9c0e1ec86845a0b6ece23529 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun make-cd (title artist rating ripped) (list :title title :artist artist :rating rating :ripped ripped)) | |
(defvar *db* nil) | |
(defun add-record (cd) (push cd *db*)) | |
(defun dump-db () (format t "~{~{~a~10t~a~%~}~%~}" *db*)) | |
(defun prompt-read (prompt) | |
(format *query-io* "~a: " prompt) | |
(force-output *query-io*) | |
(read-line *query-io*)) | |
; BUG: adds a new line after asking for the rating | |
(defun prompt-for-cd () | |
(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 () | |
(loop (add-record (prompt-for-cd)) | |
(if (not (y-or-n-p "Another [y/n]:")) (return)))) | |
(defun save-db (filename) | |
(with-open-file (out filename | |
:direction :output | |
:if-exists :supersede) | |
(with-standard-io-syntax | |
(print *db* out)))) | |
(defun load-db (filename) | |
(with-open-file (in filename) | |
(with-standard-io-syntax | |
(setf *db* (read in))))) | |
(defun select (selector-fn) | |
(remove-if-not selector-fn *db*)) | |
(defmacro where (&rest clauses) | |
`#'(lambda (cd) (and ,@(make-comparisons-list clauses)))) | |
(defun update (selector-fn &key title artist rating (ripped nil ripped-p)) | |
(setf *db* | |
(mapcar | |
#'(lambda (row) | |
(when (funcall selector-fn 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) *db*))) | |
(defun make-comparison-expr (field value) | |
`(equal (getf cd ,field) ,value)) | |
(defun make-comparisons-list (&rest fields) | |
(loop while fields | |
collecting (make-comparison-expr (pop fields) (pop fields)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment