Created
August 20, 2017 12:59
-
-
Save tex2e/d1747d61171b92077b98515ddaff4558 to your computer and use it in GitHub Desktop.
A simple database (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
(defvar *db* nil) | |
(defun dump-db () | |
(dolist (cd *db*) | |
(format t "~{~a:~10t~a~%~}~%" cd))) | |
(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 make-cd (title artist rating ripped) | |
(list :title title :artist artist :rating rating :ripped ripped)) | |
(defun add-record (cd) (push cd *db*)) | |
(defun add-cds () | |
(loop (add-record (prompt-for-cd)) | |
(if (not (y-or-n-p "Another?: ")) (return)))) | |
(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: "))) | |
(defun prompt-read (prompt) | |
(format *query-io* "~a: " prompt) | |
(force-output *query-io*) | |
(read-line *query-io*)) | |
(defun select (selector-fn) | |
(remove-if-not selector-fn *db*)) | |
(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*))) | |
(defmacro where (&rest clauses) | |
`#'(lambda (cd) (and ,@(make-comparison-list clauses)))) | |
(defun make-comparison-list (fields) | |
(loop while fields | |
collecting (make-conparison-expr (pop fields) (pop fields)))) | |
(defun make-conparison-expr (field value) | |
`(equal (getf cd ,field) ,value)) | |
(defun main () | |
(progn | |
(if (probe-file "my-cds.db") | |
(load-db "my-cds.db")) | |
;(add-cds) | |
(dump-db) | |
;(print (select (where :rating 9))) | |
;(update (where :title "Roses") :rating 8) | |
(save-db "my-cds.db"))) | |
(main) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment