From bef3dad92922fbd261267221df349f3d2569b720 Mon Sep 17 00:00:00 2001
From: Thomas Albers <thomas@thomaslabs.org>
Date: Sun, 24 Jul 2022 12:21:29 +0200
Subject: Initial commit

---
 db.lisp | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)
 create mode 100644 db.lisp

(limited to 'db.lisp')

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")))
-- 
cgit v1.2.3