aboutsummaryrefslogtreecommitdiff
path: root/db.lisp
diff options
context:
space:
mode:
authorThomas Albers <thomas@thomaslabs.org>2022-07-24 12:21:29 +0200
committerThomas Albers <thomas@thomaslabs.org>2022-07-24 12:21:29 +0200
commitbef3dad92922fbd261267221df349f3d2569b720 (patch)
treeac16bd3629a39a55eeb300b0f2991a240b093aca /db.lisp
Initial commitHEADmaster
Diffstat (limited to 'db.lisp')
-rw-r--r--db.lisp103
1 files changed, 103 insertions, 0 deletions
diff --git a/db.lisp b/db.lisp
new file mode 100644
index 0000000..a5a3147
--- /dev/null
+++ b/db.lisp
@@ -0,0 +1,103 @@
+(in-package #:autotag)
+
+(setf plump:*tag-dispatchers* plump:*xml-tags*)
+
+(defun get-child-element-by-tag (node tag-name)
+ "Finds the first child element with tag-name"
+ (find tag-name (plump:child-elements node)
+ :key #'plump:tag-name
+ :test #'equal))
+
+(defun get-child-element-text-by-tag (node tag-name)
+ (when-let* (elem (get-child-element-by-tag node tag-name))
+ (plump:text elem)))
+
+(defun get-child-elements-by-tag (node tag-name &key count)
+ "Finds all child element with tag-name"
+ (coerce (remove-if (curry #'string-not-equal tag-name)
+ (plump:child-elements node)
+ :count count
+ :key #'plump:tag-name)
+ 'list))
+
+(defun get-elements-by-tag-path (node path)
+ (cond ((null path)
+ nil)
+ ((and (listp path) (rest path))
+ (mappend (rcurry #'get-elements-by-tag-path (rest path))
+ (get-child-elements-by-tag node (first path))))
+ (t
+ (get-child-elements-by-tag node (if (consp path) (car path) path)))))
+
+(defun get-element-by-tag-path (node path)
+ (first (get-elements-by-tag-path node path)))
+
+(defvar *release-artist-path*
+ '("artist-credit" "name-credit" "artist" "name"))
+
+(defun keywords (string)
+ (mapcar #'(lambda (s)
+ (remove-if (complement #'alphanumericp) s))
+ (split-sequence #\Space (string-upcase string))))
+
+(defun release-title (release)
+ (when-let* (elem (get-child-element-text-by-tag release "title"))
+ (str:replace-using *title-replacements* elem)))
+
+(defun release-date (release)
+ (let ((raw-date (get-child-element-text-by-tag release "date")))
+ (first (split-sequence #\- raw-date))))
+
+(defun release-artist (release)
+ (when-let* (elem (get-element-by-tag-path release *release-artist-path*))
+ (plump:text elem)))
+
+(defun release-track-count (release)
+ (when-let* (elem (get-element-by-tag-path release '("medium-list" "track-count")))
+ (plump:text elem)))
+
+(defun track-title (track)
+ (when-let* ((elem (first (plump:get-elements-by-tag-name track "title")))
+ (text (plump:text elem)))
+ (str:replace-using *title-replacements* text)))
+
+(defun track-position (track)
+ (get-child-element-text-by-tag track "position"))
+
+(defun track-keywords (track)
+ (keywords (track-title track)))
+
+(defun query (url parameters)
+ (plump:parse
+ (babel:octets-to-string
+ (drakma:http-request url :parameters parameters))))
+
+(defun mb-lookup (entity mbid &optional inc)
+ (query (concatenate 'string *database* entity "/" mbid)
+ (when inc `(("inc" . ,inc)))))
+
+(defun mb-browse (entity browsing-entity mbid &optional limit offset inc)
+ (let (parameters)
+ (when limit (push (cons "limit" limit) parameters))
+ (when offset (push (cons "offset" offset) parameters))
+ (when inc (push (cons "inc" inc) parameters))
+ (push (cons browsing-entity mbid) parameters)
+ (query (concatenate 'string *database* entity) parameters)))
+
+(defun mb-search (entity value &key filters limit offset)
+ (let ((query (format nil "~A~{~*~:[~;~2:* AND ~A:\"~A\"~]~}" value filters))
+ (parameters nil))
+ (when offset (push (cons "offset" offset) parameters))
+ (when limit (push (cons "limit" limit) parameters))
+ (push (cons "query" query) parameters)
+ (query (concatenate 'string *database* entity) parameters)))
+
+(defun search-release (name &optional artist)
+ (let* ((root (mb-search "release" name :filters `("artist" ,artist)))
+ (releases (plump:get-elements-by-tag-name root "release")))
+ (and releases (coerce releases 'list))))
+
+(defun lookup-release (id)
+ (first-elt (plump:get-elements-by-tag-name
+ (mb-lookup "release" id "recordings+artists")
+ "release")))