|
@@ -21,7 +21,8 @@
|
|
|
(defstruct db
|
|
(defstruct db
|
|
|
(albums (make-hash-table :test 'equal) :type hash-table)
|
|
(albums (make-hash-table :test 'equal) :type hash-table)
|
|
|
(tracks (make-hash-table :test 'equal) :type hash-table)
|
|
(tracks (make-hash-table :test 'equal) :type hash-table)
|
|
|
- (album-tracks (make-hash-table :test 'equal) :type hash-table))
|
|
|
|
|
|
|
+ (album-tracks (make-hash-table :test 'equal) :type hash-table)
|
|
|
|
|
+ (album-added (make-hash-table :test 'equal) :type hash-table))
|
|
|
|
|
|
|
|
(defvar *db* (make-db) "Metadata database")
|
|
(defvar *db* (make-db) "Metadata database")
|
|
|
(defvar *db-path* "music.sexp" "Default file to save/load database")
|
|
(defvar *db-path* "music.sexp" "Default file to save/load database")
|
|
@@ -159,11 +160,14 @@
|
|
|
(declare #.*standard-optimize-settings*)
|
|
(declare #.*standard-optimize-settings*)
|
|
|
|
|
|
|
|
(let ((tracks-db (db-tracks *db*))
|
|
(let ((tracks-db (db-tracks *db*))
|
|
|
- (album-tracks-db (db-album-tracks *db*)))
|
|
|
|
|
|
|
+ (album-tracks-db (db-album-tracks *db*))
|
|
|
|
|
+ (album-added-db (db-album-added *db*)))
|
|
|
(clrhash album-tracks-db)
|
|
(clrhash album-tracks-db)
|
|
|
|
|
+ (clrhash album-added-db)
|
|
|
(loop for entry being the hash-values in tracks-db
|
|
(loop for entry being the hash-values in tracks-db
|
|
|
for track = (entry-track entry)
|
|
for track = (entry-track entry)
|
|
|
when track
|
|
when track
|
|
|
|
|
+ do (setf (gethash (track-album-id track) album-added-db) (entry-added entry))
|
|
|
do (push track (gethash (track-album-id track) album-tracks-db)))
|
|
do (push track (gethash (track-album-id track) album-tracks-db)))
|
|
|
(loop for album-id being the hash-keys in album-tracks-db using (hash-value tracks)
|
|
(loop for album-id being the hash-keys in album-tracks-db using (hash-value tracks)
|
|
|
do (setf (gethash album-id album-tracks-db)
|
|
do (setf (gethash album-id album-tracks-db)
|
|
@@ -205,13 +209,24 @@
|
|
|
(t (if (string< slot-a slot-b) -1 1)))))))))
|
|
(t (if (string< slot-a slot-b) -1 1)))))))))
|
|
|
(defparameter +album<>+ (gen-comparator '(artist type original-date year album)))
|
|
(defparameter +album<>+ (gen-comparator '(artist type original-date year album)))
|
|
|
(defun album< (a b)
|
|
(defun album< (a b)
|
|
|
- (< (funcall +album<>+ a b) 0))
|
|
|
|
|
|
|
+ (declare #.*standard-optimize-settings*
|
|
|
|
|
+ (type function +album<>+))
|
|
|
|
|
+ (< (the fixnum (funcall +album<>+ a b)) 0))
|
|
|
|
|
+
|
|
|
|
|
+(defun album-added> (a b)
|
|
|
|
|
+ (declare #.*standard-optimize-settings*
|
|
|
|
|
+ (type album a b))
|
|
|
|
|
+ (let ((album-added-db (db-album-added *db*)))
|
|
|
|
|
+ (> (the fixnum (gethash (album-id a) album-added-db))
|
|
|
|
|
+ (the fixnum (gethash (album-id b) album-added-db)))))
|
|
|
|
|
|
|
|
(defparameter +track<>+ (gen-comparator '(no title)))
|
|
(defparameter +track<>+ (gen-comparator '(no title)))
|
|
|
(defun track< (a b)
|
|
(defun track< (a b)
|
|
|
- (let ((albs (funcall +album<>+ (track-album a) (track-album b))))
|
|
|
|
|
|
|
+ (declare #.*standard-optimize-settings*
|
|
|
|
|
+ (type function +album<>+ +track<>+))
|
|
|
|
|
+ (let ((albs (the fixnum (funcall +album<>+ (track-album a) (track-album b)))))
|
|
|
(if (zerop albs)
|
|
(if (zerop albs)
|
|
|
- (< (funcall +track<>+ a b) 0)
|
|
|
|
|
|
|
+ (< (the fixnum (funcall +track<>+ a b)) 0)
|
|
|
albs)))
|
|
albs)))
|
|
|
|
|
|
|
|
(defun match-filter (data category filter)
|
|
(defun match-filter (data category filter)
|
|
@@ -243,7 +258,7 @@
|
|
|
(equal (slot-value data (car r)) (cdr r)))
|
|
(equal (slot-value data (car r)) (cdr r)))
|
|
|
restrictions))
|
|
restrictions))
|
|
|
|
|
|
|
|
-(defun query-category (category &key filter restrictions limit (offset 0) count-only)
|
|
|
|
|
|
|
+(defun query-category (category &key filter restrictions limit (offset 0) count-only latest)
|
|
|
(declare #.*standard-optimize-settings*
|
|
(declare #.*standard-optimize-settings*
|
|
|
(type (or null fixnum) limit offset))
|
|
(type (or null fixnum) limit offset))
|
|
|
(let ((albums-db (db-albums *db*))
|
|
(let ((albums-db (db-albums *db*))
|
|
@@ -267,7 +282,7 @@
|
|
|
(album (hash-table-keys results))
|
|
(album (hash-table-keys results))
|
|
|
(t (hash-table-alist results)))
|
|
(t (hash-table-alist results)))
|
|
|
(case category
|
|
(case category
|
|
|
- (album #'album<)
|
|
|
|
|
|
|
+ (album (if latest #'album-added> #'album<))
|
|
|
(year #'<)
|
|
(year #'<)
|
|
|
(t #'string<))
|
|
(t #'string<))
|
|
|
:key (case category
|
|
:key (case category
|