Simple database: Difference between revisions
Content added Content deleted
No edit summary |
(→{{header|Common Lisp}}: new command options to print all series and timeline of events, some code cleanup) |
||
Line 243: | Line 243: | ||
(defstruct series description tags episodes) |
(defstruct series description tags episodes) |
||
(defstruct (episode (:print-function print-episode-struct)) |
(defstruct (episode (:print-function print-episode-struct)) |
||
series title season episode part date tags) |
series title season episode part date tags) |
||
Line 249: | Line 249: | ||
(format nil "~{~a.~a.~a~}" date)) |
(format nil "~{~a.~a.~a~}" date)) |
||
(defun print-episode-struct (ep stream level) |
(defun print-episode-struct (ep stream level) |
||
(let ((*print-pretty* nil)) |
(let ((*print-pretty* nil)) |
||
(format stream (if *print-escape* |
(format stream (if *print-escape* |
||
"#s(episode~@{~*~@[ :~1:*~a ~s~]~})" |
"#s(episode~@{~*~@[ :~1:*~a ~s~]~})" |
||
"~32<~*~a~; ~*~@[~d-~]~*~d~> ~45<~*~@[~a ~]~*~@[(~a) ~]~;~*~@[(~a)~]~>~*~@[ (~{~a~^ ~})~]") |
"~32<~*~a~; ~*~@[~d-~]~*~d~> ~45<~*~@[~a ~]~*~@[(~a) ~]~;~*~@[(~a)~]~>~*~@[ (~{~a~^ ~})~]") |
||
:series (episode-series ep) |
:series (episode-series ep) |
||
:season (episode-season ep) |
:season (episode-season ep) |
||
:episode (episode-episode ep) |
:episode (episode-episode ep) |
||
:title (episode-title ep) |
:title (episode-title ep) |
||
:part (episode-part ep) |
:part (episode-part ep) |
||
:date (if *print-escape* |
:date (if *print-escape* |
||
(episode-date ep) |
(episode-date ep) |
||
(when (episode-date ep) |
(when (episode-date ep) |
||
(format-ymd (episode-date ep)))) |
|||
:tags (episode-tags ep)))) |
:tags (episode-tags ep)))) |
||
Line 280: | Line 280: | ||
(cond ((not a) t) |
(cond ((not a) t) |
||
((not b) nil) |
((not b) nil) |
||
((= (first a) (first b)) |
((= (first a) (first b)) |
||
(compare-date (rest a) (rest b))) |
(compare-date (rest a) (rest b))) |
||
(t (< (first a) (first b))))) |
(t (< (first a) (first b))))) |
||
Line 291: | Line 291: | ||
(force-output *query-io*) |
(force-output *query-io*) |
||
(let ((answer (read-line *query-io*))) |
(let ((answer (read-line *query-io*))) |
||
(if (string= answer "") |
(if (string= answer "") |
||
default |
default |
||
answer))) |
answer))) |
||
Line 313: | Line 313: | ||
(defun parse-tags (tags) |
(defun parse-tags (tags) |
||
(when (and tags (string-not-equal "" tags)) |
(when (and tags (string-not-equal "" tags)) |
||
(mapcar #'intern (split " " (string-upcase tags))))) |
(mapcar #'intern (split " " (string-upcase tags))))) |
||
(defun parse-number (number) |
(defun parse-number (number) |
||
(if (stringp number) |
(if (stringp number) |
||
(parse-integer number :junk-allowed t) |
(parse-integer number :junk-allowed t) |
||
number)) |
number)) |
||
(defun prompt-for-episode (&optional last) |
(defun prompt-for-episode (&optional last) |
||
(when (not last) |
(when (not last) |
||
(setf last (make-episode))) |
|||
(let* ((series (prompt-read "Series Title" (episode-series last))) |
(let* ((series (prompt-read "Series Title" (episode-series last))) |
||
(title (prompt-read "Title")) |
(title (prompt-read "Title")) |
||
(season (parse-number (prompt-read "Season" (episode-season last)))) |
(season (parse-number (prompt-read "Season" (episode-season last)))) |
||
(episode (parse-number (prompt-read "Episode" |
(episode (parse-number (prompt-read "Episode" |
||
(if (eq (episode-season last) season) |
(if (eq (episode-season last) season) |
||
(1+ (episode-episode last)) |
|||
1)))) |
|||
(part (parse-number (prompt-read "Part" |
(part (parse-number (prompt-read "Part" |
||
(when (and (episode-part last) |
(when (and (episode-part last) |
||
(or (eq (episode-season last) season) |
(or (eq (episode-season last) season) |
||
(eq (episode-part last) 1))) |
(eq (episode-part last) 1))) |
||
Line 352: | Line 352: | ||
(defun get-next-version (basename) |
(defun get-next-version (basename) |
||
(flet ((parse-version (pathname) |
(flet ((parse-version (pathname) |
||
(or (parse-integer-quietly |
|||
(string-left-trim (file-namestring basename) |
|||
(file-namestring pathname)) |
|||
:start 1) 0))) |
|||
(let* ((files (directory (format nil "~A,*" (namestring basename)))) |
(let* ((files (directory (format nil "~A,*" (namestring basename)))) |
||
(max (if files |
(max (if files |
||
(reduce #'max files :key #'parse-version) |
(reduce #'max files :key #'parse-version) |
||
0))) |
0))) |
||
(merge-pathnames (format nil "~a,~d" (file-namestring basename) (1+ max)) |
(merge-pathnames (format nil "~a,~d" (file-namestring basename) (1+ max)) |
||
basename)))) |
|||
(defun save-db (dbfile database) |
(defun save-db (dbfile database) |
||
Line 385: | Line 385: | ||
(series-episodes (get-series series database))) |
(series-episodes (get-series series database))) |
||
(defun print-series (series) |
(defun print-series (title series) |
||
(format t "~30a |
(format t "~&~30a ~@[ (~{~a~^ ~})~]~%~@[ ~a~%~]" title (series-tags series) |
||
(series-description series)) |
|||
(format t "~{~& ~a~%~}" (series-episodes series))) |
(format t "~{~& ~a~%~}" (reverse (series-episodes series)))) |
||
(defun watch-series (title) |
(defun watch-series (title) |
||
(let ((series (get-series title *db*))) |
(let ((series (get-series title *db*))) |
||
⚫ | |||
⚫ | |||
(print-series title series)))) |
|||
⚫ | |||
(defun |
(defun print-all-series (database) |
||
( |
(loop for (title . series) |
||
( |
in (sort database #'(lambda (a b)(compare-by-date (car (series-episodes (cdr a))) |
||
(car (series-episodes (cdr b)))))) |
|||
do (terpri) (print-series title series))) |
|||
(defun watch-all-series () |
|||
(print-all-series *db*)) |
|||
(defun watch-latest () |
(defun watch-latest () |
||
(format t "~{~& ~a~%~}" (sort (get-latest *db*) #'compare-by-date))) |
(format t "~{~& ~a~%~}" (sort (get-latest *db*) #'compare-by-date))) |
||
(defun timeline-all (database) |
|||
⚫ | |||
(max (length all)) |
|||
(count max) |
|||
(all-series-names nil) |
|||
(all-series (make-hash-table :test 'equal))) |
|||
⚫ | |||
⚫ | |||
(setf (gethash (episode-series episode) all-series) |
|||
(make-array max :initial-element nil)) |
|||
(setf all-series-names |
|||
(cons (episode-series episode) all-series-names))) |
|||
(setf (elt (gethash (episode-series episode) all-series) (decf count)) |
|||
⚫ | |||
(values all-series all-series-names max))) |
|||
(defun watch-timeline () |
|||
(multiple-value-bind (all-series all-series-names max) (timeline-all *db*) |
|||
(loop for series in all-series-names |
|||
⚫ | |||
(coerce (subseq (gethash series all-series) (- max 60)) 'list))))) |
|||
(defun watch-timelinec () |
|||
(multiple-value-bind (all-series all-series-names max) (timeline-all *db*) |
|||
(let ((chart (make-array (list (length all-series-names) max) :initial-element nil)) |
|||
(newcol 0) |
|||
(oldrow -1)) |
|||
(loop for oldcol upto (1- max) |
|||
do (loop for series in all-series-names |
|||
for row from 0 upto (length all-series-names) |
|||
do (when (elt (gethash series all-series) oldcol) |
|||
⚫ | |||
(incf newcol)) |
|||
(setf (aref chart row newcol) |
|||
(elt (gethash series all-series) oldcol)) |
|||
(setf oldrow row)))) |
|||
(loop for series in all-series-names |
|||
for i from 0 upto (length all-series-names) |
|||
do (format t "~30a (" series) |
|||
(loop for j from (- newcol 60) upto newcol |
|||
do (format t "~:[ ~;•~]" (aref chart i j)) |
|||
(if (= j newcol) |
|||
(format t ")~%"))))))) |
|||
(defun watch-timelinev () |
|||
(multiple-value-bind (all-series all-series-names max) (timeline-all *db*) |
|||
(loop for series in all-series-names |
|||
counting series into count |
|||
⚫ | |||
(loop for i from 0 upto (1- max) |
|||
do (let ((episode nil)) |
|||
(loop for series in all-series-names |
|||
do (format t "~:[ ~;~:*~02a~]" |
|||
(when (elt (gethash series all-series) i) |
|||
(setf episode (elt (gethash series all-series) i)) |
|||
(episode-episode episode)))) |
|||
(format t " (~a)~%" (episode-series episode)))))) |
|||
(defun watch-all () |
(defun watch-all () |
||
Line 411: | Line 473: | ||
(defun get-or-add-series (name database) |
(defun get-or-add-series (name database) |
||
(or (get-series name database) |
(or (get-series name database) |
||
(if (y-or-n-p "Add new series? [y/n]: ") |
(if (y-or-n-p "Add new series? [y/n]: ") |
||
(watch-new-series |
(watch-new-series |
||
:name name |
:name name |
||
:description (prompt-read "Description" name) |
:description (prompt-read "Description" name) |
||
:tags (parse-tags (prompt-read "Tags" "active"))) |
:tags (parse-tags (prompt-read "Tags" "active"))) |
||
nil))) |
nil))) |
||
Line 424: | Line 486: | ||
(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 (series-episodes (get-value series1 *db*))) |
(compare-by-date (car (series-episodes (get-value series1 *db*))) |
||
(car (series-episodes (get-value series2 *db*)))))))) |
(car (series-episodes (get-value series2 *db*)))))))) |
||
(defun |
(defun exact-match (term text) |
||
(string-equal (format nil "~{~a~^ ~}" term) text)) |
|||
⚫ | |||
(defun fuzzy- |
(defun fuzzy-match (term text) |
||
(loop for word in term |
|||
(let ((matches (length |
|||
when (search word text :test 'string-equal) |
|||
collect it)) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
matches))) |
|||
(defun match-tags (term |
(defun match-tags (term tags) |
||
(intersection (mapcar #'intern term) tags)) |
|||
(when (> matches 0) |
|||
matches))) |
|||
(defun search-title (term database) |
(defun search-title (term database) |
||
(loop for episode in (get-all database) |
(loop for episode in (get-all database) |
||
when ( |
when (exact-match term (episode-title episode)) |
||
collect episode)) |
|||
(defun search-tags (term database) |
(defun search-tags (term database) |
||
(sort (loop for episode in (get-all database) |
(sort (loop for episode in (get-all database) |
||
for matches = (match-tags term episode |
for matches = (match-tags term (episode-tags episode)) |
||
when matches collect (list matches episode)) |
when matches collect (list (length matches) episode)) |
||
#'> :key #'car)) |
#'> :key #'car)) |
||
(defun search-title-fuzzy (term database) |
(defun search-title-fuzzy (term database) |
||
(sort (loop for episode in (get-all database) |
(sort (loop for episode in (get-all database) |
||
for matches = (fuzzy- |
for matches = (fuzzy-match term (episode-title episode)) |
||
when matches collect (list matches episode)) |
when matches collect (list (length matches) episode)) |
||
#'> :key #'car)) |
#'> :key #'car)) |
||
Line 467: | Line 524: | ||
(fuzzy-results '()) |
(fuzzy-results '()) |
||
(tag-results '())) |
(tag-results '())) |
||
( |
(dolist (episode (get-all database)) |
||
(cond ((exact-match term (episode-title episode)) |
|||
(push episode exact-results)) |
|||
((fuzzy-match term (episode-title episode)) |
|||
(push episode fuzzy-results)) |
|||
((match-tags term (episode-tags episode)) |
|||
(push episode tag-results)))) |
|||
(append (sort exact-results #'compare-by-date) |
|||
⚫ | |||
⚫ | |||
(sort tag-results #'compare-by-date) |
(sort tag-results #'compare-by-date) |
||
(sort fuzzy-results #'compare-by-date)))) |
(sort fuzzy-results #'compare-by-date)))) |
||
Line 484: | Line 540: | ||
(defun list-all-tags (database) |
(defun list-all-tags (database) |
||
(let ((tags (make-hash-table :test 'equal))) |
(let ((tags (make-hash-table :test 'equal))) |
||
( |
(dolist (tag (apply #'append (mapcar #'episode-tags (get-all database)))) |
||
(setf (gethash tag tags) (1+ (or (gethash tag tags) 0)))) |
|||
tags)) |
tags)) |
||
(defun watch-tags () |
(defun watch-tags () |
||
(maphash #'(lambda (tag count) (format t "~a (~d) " tag count)) |
(maphash #'(lambda (tag count) (format t "~a (~d) " tag count)) |
||
(list-all-tags *db*)) |
(list-all-tags *db*)) |
||
(terpri)) |
(terpri)) |
||
Line 500: | Line 556: | ||
(season-str (when pos (subseq season-episode 0 pos))) |
(season-str (when pos (subseq season-episode 0 pos))) |
||
(season (or (parse-integer-quietly season-str) season-str)) |
(season (or (parse-integer-quietly season-str) season-str)) |
||
(episode-str (if pos |
(episode-str (if pos |
||
(subseq season-episode (1+ pos)) |
(subseq season-episode (1+ pos)) |
||
season-episode)) |
season-episode)) |
||
Line 523: | Line 579: | ||
(defun edit-episode (episode database) |
(defun edit-episode (episode database) |
||
(format t "editing:~%~a~%" episode) |
(format t "editing:~%~a~%" episode) |
||
(setf (episode-series episode) |
(setf (episode-series episode) |
||
(prompt-read "Series Title" (episode-series episode))) |
(prompt-read "Series Title" (episode-series episode))) |
||
(setf (episode-title episode) |
(setf (episode-title episode) |
||
(prompt-read "Title" (episode-title episode))) |
(prompt-read "Title" (episode-title episode))) |
||
(setf (episode-season episode) |
(setf (episode-season episode) |
||
(parse-number (prompt-read "Season" (episode-season episode)))) |
(parse-number (prompt-read "Season" (episode-season episode)))) |
||
(setf (episode-episode episode) |
(setf (episode-episode episode) |
||
(parse-number (prompt-read "Episode" (episode-episode episode)))) |
(parse-number (prompt-read "Episode" (episode-episode episode)))) |
||
(setf (episode-part episode) |
(setf (episode-part episode) |
||
(parse-number (prompt-read "Part" (episode-part episode)))) |
(parse-number (prompt-read "Part" (episode-part episode)))) |
||
(setf (episode-date episode) |
(setf (episode-date episode) |
||
(parse-date (prompt-read "Date watched" (format-ymd (episode-date episode))))) |
(parse-date (prompt-read "Date watched" (format-ymd (episode-date episode))))) |
||
(setf (episode-tags episode) |
(setf (episode-tags episode) |
||
(parse-tags (prompt-read "Tags" (format nil "~{~a~^ ~}" (episode-tags episode)))))) |
(parse-tags (prompt-read "Tags" (format nil "~{~a~^ ~}" (episode-tags episode)))))) |
||
Line 546: | Line 602: | ||
(defun watch-load (dbfile) |
(defun watch-load (dbfile) |
||
(setf *db* (load-db dbfile))) |
(setf *db* (load-db dbfile))) |
||
(defun argv () |
(defun argv () |
||
Line 562: | Line 619: | ||
(let ((dbfile (make-pathname :name "lwatch" :type nil :defaults *load-pathname*))) |
(let ((dbfile (make-pathname :name "lwatch" :type nil :defaults *load-pathname*))) |
||
(watch-load dbfile) |
(watch-load dbfile) |
||
(format t "loaded db~%") |
|||
(cond ((equal (cadr argv) "add") (watch-add) (watch-save dbfile)) |
(cond ((equal (cadr argv) "add") (watch-add) (watch-save dbfile)) |
||
((equal (cadr argv) "latest") (watch-latest)) |
((equal (cadr argv) "latest") (watch-latest)) |
||
((null (cadr argv)) (watch-latest)) |
((null (cadr argv)) (watch-latest)) |
||
((equal (cadr argv) "series") (watch-series-names)) |
((equal (cadr argv) "series") (watch-series-names)) |
||
((and (equal (cadr argv) "all") (equal (caddr argv) "series")) (watch-all-series)) |
|||
((equal (cadr argv) "all") (watch-all)) |
((equal (cadr argv) "all") (watch-all)) |
||
((equal (cadr argv) "tags") (watch-tags)) |
((equal (cadr argv) "tags") (watch-tags)) |
||
((equal (cadr argv) "search") (watch-search (cddr argv))) |
((equal (cadr argv) "search") (watch-search (cddr argv))) |
||
((equal (cadr argv) "edit") (watch-edit (cddr argv)) (watch-save dbfile)) |
((equal (cadr argv) "edit") (watch-edit (cddr argv)) (watch-save dbfile)) |
||
((equal (cadr argv) "timeline") (watch-timeline)) |
|||
((equal (cadr argv) "timelinev") (watch-timelinev)) |
|||
((equal (cadr argv) "timelinec") (watch-timelinec)) |
|||
(T (watch-series (format nil "~{~a~^ ~}" (cdr argv))))))) |
(T (watch-series (format nil "~{~a~^ ~}" (cdr argv))))))) |
||