blob: a5a31473a12832205e56087de4a0674f8a3b395d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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")))
|
