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