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:
<lang lisp>(defvar *db* nil)
 
(defstruct series description tags episodes)
(defun get-value (key alist)
(cdr (assoc key alist)))
 
(defundefstruct make-(episode (&key series title season:print-function print-episode date tags-struct))
`((series .title ,series) (season . ,season) (episode . ,episode) (title . ,title) (date . ,date) (tags . ,tags)))
 
(defun print-episode-struct (episodeep 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 "#s(episode~@{~*~@[ :~1:*~a ~s~]~})"
▲ (format t " ~*~30a ~*~@[~a-~]~*~a~40T~*~@[~a~]~*~@[ ~70T(~{~a~^.~})~]~*~@[ (~{~a~^ ~})~]~%" )
(get-value 'episode episode)
(get-value 'title :series (episode-series ep)
(reverse (get-value 'date:season (episode-season ep))
(get-value 'tags :episode (episode-episode ep)))
:title (cons episode-title episodes)))ep) ▼
:date (if *print-escape*
(episode-date ep)
(reverse (episode-date ep)))
:tags (episode-tags ep))))
 
(defun printget-episodesvalue (episodeskey seriesalist)
(orcdr (nullassoc episodeskey alist)))
(print-episode (acons 'series-name series (car episodes)))
(print-episodes (cdr episodes) series)))
 
(defun get-latest (database)
(when database
(cons (car (getseries-value 'episodes (cdar database))) (get-latest (cdr database)))))
 
(defun get-all (database)
(when database
(append (getseries-value 'episodes (cdar database)) (get-all (cdr database)))))
 
(defun compare-date (a b)
Line 74 ⟶ 76:
 
(defun compare-by-date (a b)
(compare-date (getepisode-value 'date a) (getepisode-value 'date b)))
 
(defun prompt-read (prompt &optional default)
Line 111 ⟶ 113:
(defun prompt-for-episode (&optional last)
(make-episode
:series (prompt-read "Series Title" (getepisode-value 'series last))
:title (prompt-read "Title")
:season (parse-number (prompt-read "Season" (getepisode-value 'season last)))
:episode (parse-number (prompt-read "Episode" (1+ (or (getepisode-value 'episode last) 0))))
:date (parse-date (prompt-read "Date watched" (format-ymd)))
:tags (parse-tags (prompt-read "Tags"))))
Line 140 ⟶ 142:
 
(defun get-episode-list (series database)
(getseries-value 'episodes (get-series series database)))
 
(defun print-series (series)
(format t "~30a ~a ~@[ (~{~a~^ ~})~]~%" (get-value 'series series) (get-value 'tags series))
(mapcarcar #'printseries) (series-episodedescription (getcdr series)) (series-valuetags 'episodes(cdr series)))
(format t (rplacd"~{~a~%~}" (assoc 'series-episodes series)))▼
 
(defun watch-series (title)
(let ((series (get-series title *db*)))
(format t "~30a ~@[ (~{~a~^ ~})~]~%" (get-value 'series series) ~a~%" title (getseries-value 'tags series))
(mapcar #'print-episode (reverse (getseries-value 'episodesdescription series)))))
(format t "~{~a~%~}" (reverse (series-episodes series)))))
 
(defun dump-db (database)
Line 156 ⟶ 160:
 
(defun watch-latest ()
(mapcarformat #'print-episodet "~{~a~%~}" (sort (get-latest *db*) #'compare-by-date)))
 
(defun watch-all ()
(mapcarformat #'print-episodet "~{~a~%~}" (sort (get-all *db*) #'compare-by-date)))
 
(defun watch-new-series (&key name description tags)
(cdar (push `(,cons name (make-series :description . ,description) (:tags . ,tags) (episodes)) *db*)))
 
(defun get-or-add-series (name database)
Line 175 ⟶ 179:
(defun watch-add ()
(let* ((series (loop thereis (get-or-add-series (prompt-read "Series") *db*)))
(episodesepisode (getprompt-valuefor-episode '(car (series-episodes series)))))
(push (episode (promptseries-for-episodeepisodes (car episodesseries))))
▲ (rplacd (assoc 'episodes series)
▲ (cons episode episodes))))
 
(defun watch-series-names ()
(format T "~{~a~%~}"
(sort (mapcar #'car *db*)
#'(lambda (series1 series2)
(compare-by-date (car (getseries-value 'episodes (get-value series1 *db*)))
(car (getseries-value 'episodes (get-value series2 *db*))))))))
 
(defun watch-load (dbfile)
Retrieved from "https://rosettacode.org/wiki/Simple_database"