;;; practicalCommonLisp_simpleDB_inElisp.el ---  SQL example to illustrate lisp macros   -*- lexical-binding: t -*-
;;
;; Original Author: Peter Seibel;  of the common lisp code this elisp port is based on.
;; Maintainer: Paul Horton
;; Created: 2022;  the elisp port.
;; Updated: 20240516
;; Version: 0.0
;; Keywords: lisp macros, SQL
;;; Commentary:

;; elisp port of Peter Seibel common lisp code in chapter 3
;; of his book Practical Common Lisp "https://gigamonkeys.com/book/"
;; with some elisp specific adaptations.

;;; Change Log:

;;; Code:


(require 'cl-format)


(defun pcl/make-cd (title artist rating ripped)
  (list :title title :artist artist :rating rating :ripped ripped))

(defvar pcl/*db* nil)

(defun pcl/add-record (cd) (push cd pcl/*db*))


(defvar pcl/db-display-buffer-name
  "*pcl/db-displace-buffer*"
  "Name of buffer used to display pcl database entries."
  )

(defun pcl/db-display-buffer ()
  "Return buffer used to display pcl database entries"
  (get-buffer-create pcl/db-display-buffer-name)
  )

(defun pcl/display-entries (db-entries)
  "Show contents of database DB-ENTRIES in pcl/db-display buffer"
  (if (not db-entries)
      (message "No entries to show.")
    (pop-to-buffer (pcl/db-display-buffer))
    (let  (buffer-read-only)   ;; temporarily set buffer-read-only to nil.
      (erase-buffer)
      (cl-format (pcl/db-display-buffer) "~{~{~a:~10t~a~%~}~%~}" db-entries)
      (goto-char (point-min))
      )
    (special-mode)
    (view-mode 1)
  ))

(defun pcl/display-db ()
  "Display CD database in a display buffer."
  (interactive)
  (pcl/display-entries pcl/*db*)
  )


(defun pcl/prompt-for-cd ()
  "Prompt user for CD info:  title, artist, rating, and ripped?"
  (pcl/make-cd
   (read-string "title: ")
   (read-string "artist: ")
   (read-number "rating: ")
   (y-or-n-p "ripped? (y/n)")
   ))

(defun pcl/add-cds ()
  "Add one or more CDs to database."
  (interactive)
  (pcl/add-record (pcl/prompt-for-cd))
  (while (progn (sleep-for 0.2);  Pause at end of record input.
                (y-or-n-p "Enter another cd? (y/n)"))
    (pcl/add-record (pcl/prompt-for-cd))
    ))


(defun pcl/save-db (filename)
  (interactive "FDatabase filename: ")
  (with-temp-file filename
      (print pcl/*db* (current-buffer))
      ))


(defun pcl/load-db (filename)
  (interactive "fDatabase filename: ")
  (with-temp-buffer
    (insert-file-contents filename)
    (setq pcl/*db* (read (current-buffer)))
    ))


(defun pcl/select (selector-fn)
  (cl-remove-if-not selector-fn pcl/*db*)
  )

(defun pcl/select-by-artist (artist)
  (cl-remove-if-not
   (lambda (cd) (equal (cl-getf cd :artist) artist))
   pcl/*db*
   ))

(defun pcl/artist-selector (artist)
  #'(lambda (cd) (equal (cl-getf cd :artist) artist))
  )

(cl-defun pcl/where/ifs (&key title artist rating (ripped nil ripped-p))
  #'(lambda (cd)
     (and
      (if title    (equal (cl-getf cd :title)  title)  t)
      (if artist   (equal (cl-getf cd :artist) artist) t)
      (if rating   (equal (cl-getf cd :rating) rating) t)
      (if ripped-p (equal (cl-getf cd :ripped) ripped) t)
      )))


(cl-defun pcl/update (selector-fn &key title artist rating (ripped nil ripped-p))
  "Update given fields of entries in database selected by SELECTED-FN function."
  (setq pcl/*db*
        (mapcar
         #'(lambda (row)
            (when (funcall selector-fn row)
              (if title    (setf (cl-getf row :title)  title))   ;; These three if expressions follow a pattern
              (if artist   (setf (cl-getf row :artist) artist))  ;; and could also be generated on the fly
              (if rating   (setf (cl-getf row :rating) rating))  ;; with a macro if desired.
              (if ripped-p (setf (cl-getf row :ripped) ripped))  ;; This one follows a different pattern.
              )
             row
             )
         pcl/*db*
         )))


(defun pcl/delete-rows (selector-fn)
  (setq pcl/*db* (cl-remove-if selector-fn pcl/*db*))
  )

(defun pcl/make-comparison-expr (field value)
  `(equal (cl-getf cd ,field) ,value)
  )


(defun pcl/make-comparisons-list (clauses)
  (let (acc)
    (while clauses
      (push
       (pcl/make-comparison-expr (pop clauses) (pop clauses))
       acc
       )
      )
     (reverse acc);; By habit. Reversing not really necessary in this case.
    ))


(defmacro pcl/where/macro (&rest clauses)
  "SQL WHERE-like function to select records in a property list based database

CLAUSES is a list of pairs   :field-name  value
"
  `#'(lambda (cd) (and ,@(pcl/make-comparisons-list clauses))
       ))



;; Code snippets using the definitions above
;; placed in vector [] to avoid evaluating when loading.
[
 (progn
  (pcl/add-record (pcl/make-cd "Roses" "Kathy Mattea" 5 t))
  (pcl/add-record (pcl/make-cd "Fly"  "Dixie Chicks" 6 t))
  (pcl/add-record (pcl/make-cd "Home" "Dixie Chicks" 7 t))
  (pcl/add-record (pcl/make-cd "Give Us a Break" "Limpopo" 10 t))
  (pcl/add-record (pcl/make-cd "玻璃心" "黃明志 ＆ 陳芳語" 9 t))
  )

 (pcl/display-db)

 (macroexpand-1 '(pcl/where/macro :title "Dark side of the moon" :ripped t))

 (pcl/display-entries
  (pcl/select (pcl/where/macro :rating 7 :ripped t :title "Home"))
  )
]


;;; practicalCommonLisp_simpleDB_inElisp.el ends here