Simple database: Difference between revisions

Content added Content deleted
(Undo revision 126706 by EMBee (talk) (some) does not work here)
(→‎{{header|Common Lisp}}: use structs instead of alists. use struct specific print-function to produce output)
Line 38: Line 38:
<lang lisp>(defvar *db* nil)
<lang lisp>(defvar *db* nil)


(defstruct series description tags episodes)
(defun get-value (key alist)
(cdr (assoc key alist)))


(defun make-episode (&key series title season episode date tags)
(defstruct (episode (:print-function print-episode-struct))
`((series . ,series) (season . ,season) (episode . ,episode) (title . ,title) (date . ,date) (tags . ,tags)))
series title season episode date tags)


(defun print-episode (episode)
(defun print-episode-struct (ep stream level)
(let ((*print-pretty* nil))
⚫
(format t " ~30a ~@[~a-~]~a~40T~@[~a~]~@[ ~70T(~{~a~^.~})~]~@[ (~{~a~^ ~})~]~%"
(format stream (if *print-escape*
(get-value 'series episode)
(get-value 'season episode)
"#s(episode~@{~*~@[ :~1:*~a ~s~]~})"
⚫
" ~*~30a ~*~@[~a-~]~*~a~40T~*~@[~a~]~*~@[ ~70T(~{~a~^.~})~]~*~@[ (~{~a~^ ~})~]")
(get-value 'episode episode)
(get-value 'title episode)
:series (episode-series ep)
(reverse (get-value 'date episode))
:season (episode-season ep)
(get-value 'tags episode)))
:episode (episode-episode ep)
⚫
:title (episode-title ep)
:date (if *print-escape*
(episode-date ep)
(reverse (episode-date ep)))
:tags (episode-tags ep))))


(defun print-episodes (episodes series)
(defun get-value (key alist)
(or (null episodes)
(cdr (assoc key alist)))
(print-episode (acons 'series-name series (car episodes)))
(print-episodes (cdr episodes) series)))


(defun get-latest (database)
(defun get-latest (database)
(when database
(when database
(cons (car (get-value 'episodes (cdar database))) (get-latest (cdr database)))))
(cons (car (series-episodes (cdar database))) (get-latest (cdr database)))))


(defun get-all (database)
(defun get-all (database)
(when database
(when database
(append (get-value 'episodes (cdar database)) (get-all (cdr database)))))
(append (series-episodes (cdar database)) (get-all (cdr database)))))


(defun compare-date (a b)
(defun compare-date (a b)
Line 74: Line 76:


(defun compare-by-date (a b)
(defun compare-by-date (a b)
(compare-date (get-value 'date a) (get-value 'date b)))
(compare-date (episode-date a) (episode-date b)))


(defun prompt-read (prompt &optional default)
(defun prompt-read (prompt &optional default)
Line 111: Line 113:
(defun prompt-for-episode (&optional last)
(defun prompt-for-episode (&optional last)
(make-episode
(make-episode
:series (prompt-read "Series Title" (get-value 'series last))
:series (prompt-read "Series Title" (episode-series last))
:title (prompt-read "Title")
:title (prompt-read "Title")
:season (parse-number (prompt-read "Season" (get-value 'season last)))
:season (parse-number (prompt-read "Season" (episode-season last)))
:episode (parse-number (prompt-read "Episode" (1+ (or (get-value 'episode last) 0))))
:episode (parse-number (prompt-read "Episode" (1+ (or (episode-episode last) 0))))
:date (parse-date (prompt-read "Date watched" (format-ymd)))
:date (parse-date (prompt-read "Date watched" (format-ymd)))
:tags (parse-tags (prompt-read "Tags"))))
:tags (parse-tags (prompt-read "Tags"))))
Line 140: Line 142:


(defun get-episode-list (series database)
(defun get-episode-list (series database)
(get-value 'episodes (get-series series database)))
(series-episodes (get-series series database)))


(defun print-series (series)
(defun print-series (series)
(format t "~30a ~@[ (~{~a~^ ~})~]~%" (get-value 'series series) (get-value 'tags series))
(format t "~30a ~a ~@[ (~{~a~^ ~})~]~%"
(mapcar #'print-episode (get-value 'episodes series)))
(car series) (series-description (cdr series)) (series-tags (cdr series)))
⚫
(format t "~{~a~%~}" (series-episodes series)))


(defun watch-series (title)
(defun watch-series (title)
(let ((series (get-series title *db*)))
(let ((series (get-series title *db*)))
(format t "~30a ~@[ (~{~a~^ ~})~]~%" (get-value 'series series) (get-value 'tags series))
(format t "~30a ~@[ (~{~a~^ ~})~]~% ~a~%" title (series-tags series)
(mapcar #'print-episode (reverse (get-value 'episodes series)))))
(series-description series))
(format t "~{~a~%~}" (reverse (series-episodes series)))))


(defun dump-db (database)
(defun dump-db (database)
Line 156: Line 160:


(defun watch-latest ()
(defun watch-latest ()
(mapcar #'print-episode (sort (get-latest *db*) #'compare-by-date)))
(format t "~{~a~%~}" (sort (get-latest *db*) #'compare-by-date)))


(defun watch-all ()
(defun watch-all ()
(mapcar #'print-episode (sort (get-all *db*) #'compare-by-date)))
(format t "~{~a~%~}" (sort (get-all *db*) #'compare-by-date)))


(defun watch-new-series (&key name description tags)
(defun watch-new-series (&key name description tags)
(cdar (push `(,name (description . ,description) (tags . ,tags) (episodes)) *db*)))
(cdar (push (cons name (make-series :description description :tags tags)) *db*)))


(defun get-or-add-series (name database)
(defun get-or-add-series (name database)
Line 175: Line 179:
(defun watch-add ()
(defun watch-add ()
(let* ((series (loop thereis (get-or-add-series (prompt-read "Series") *db*)))
(let* ((series (loop thereis (get-or-add-series (prompt-read "Series") *db*)))
(episodes (get-value 'episodes series))
(episode (prompt-for-episode (car (series-episodes series)))))
(episode (prompt-for-episode (car episodes))))
(push episode (series-episodes series))))
⚫
(rplacd (assoc 'episodes series)
⚫
(cons episode episodes))))


(defun watch-series-names ()
(defun watch-series-names ()
(format T "~{~a~%~}"
(format T "~{~a~%~}"
(sort (mapcar #'car *db*)
(sort (mapcar #'car *db*)
#'(lambda (series1 series2)
(lambda (series1 series2)
(compare-by-date (car (get-value 'episodes (get-value series1 *db*)))
(compare-by-date (car (series-episodes (get-value series1 *db*)))
(car (get-value 'episodes (get-value series2 *db*))))))))
(car (series-episodes (get-value series2 *db*))))))))


(defun watch-load (dbfile)
(defun watch-load (dbfile)
Retrieved from "https://rosettacode.org/wiki/Simple_database"