Created
July 15, 2020 16:52
-
-
Save jlouiss/ff66f04101ceed79d42699b4b923db8f to your computer and use it in GitHub Desktop.
Credit: Practical Common Lisp
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
(in-package :com.gigamonkeys.simple-db) | |
(defvar *db* nil) | |
(defun make-cd (title artist rating ripped) | |
(list :title title :artist artist :rating rating :ripped ripped)) | |
(defun add-record (cd) (push cd *db*)) | |
(defun dump-db () | |
(dolist (cd *db*) | |
(format t "~{~a:~10t~a~%~}~%" cd))) | |
(defun prompt-read (prompt) | |
(format *query-io* "~a: " prompt) | |
(force-output *query-io*) | |
(read-line *query-io*)) | |
(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 clear-db () (setq *db* nil)) | |
(defun select (selector-fn) | |
(remove-if-not selector-fn *db*)) | |
(defmacro where (&rest clauses) | |
`#'(lambda (cd) (and ,@(make-comparisons-list clauses)))) | |
(defun make-comparisons-list (fields) | |
(loop while fields | |
collecting (make-comparison-expr (pop fields) (pop fields)))) | |
(defun make-comparison-expr (field value) | |
`(equal (getf cd ,field) ,value)) | |
(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 delete-rows (selector-fn) | |
(setf *db* (remove-if selector-fn *db*))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment