[mpd] Lispify the MPD query

Write a small DSL for converting a simple lisp expression to an MPD query
format. This turns, for example:

    (and (= artist "Katatonia") (= album "Last Fair Deal Gone Down"))

Into:

    ((artist == "Katatonia") AND (album == "Last Fair Deal Gone Down"))

The expressions inside ‘query’ are quasi-quoted, so that variable substitution
is possible.

2 files changed, 26 insertions, 3 deletions

diff --git a/mpd/usr/bin/mpd-random-albums b/mpd/usr/bin/mpd-random-albums
index 4bcd680..50e6f79 100755
--- a/mpd/usr/bin/mpd-random-albums
+++ b/mpd/usr/bin/mpd-random-albums
@@ -1,7 +1,7 @@
 #!/usr/bin/env sh
 # -*- mode: scheme; -*-
 IFS=" "
-exec scsh -s "$0" "$@"
+exec scsh -ll mpd.scm -o mpd -s "$0" "$@"
 !#
 
 (define (randomize-all-albums)
@@ -12,8 +12,9 @@ exec scsh -s "$0" "$@"
 
 (define (randomize-albums-by-artist artist)
   (for-each (lambda (album)
-              (display (run/string (mpc findadd ,(string-append "((artist == \"" artist "\") AND (album == \"" album "\"))")))))
-            (run/strings (pipe (mpc list album ,(string-append "((artist == \"" artist "\"))"))
+              (run (mpc findadd ,(query (and (= artist ,artist)
+                                             (= album ,album))))))
+            (run/strings (pipe (mpc list album ,(query (= artist ,artist)))
                                (shuf)))))
 
 (run (mpc clear)
diff --git a/mpd/usr/share/scsh/mpd.scm b/mpd/usr/share/scsh/mpd.scm
new file mode 100644
index 0000000..74d297b
--- /dev/null
+++ b/mpd/usr/share/scsh/mpd.scm
@@ -0,0 +1,22 @@
+(define-structure mpd (export query)
+  (open scheme-with-scsh)
+  (begin
+    (define-syntax query
+      (syntax-rules ()
+        ((_ a)
+         (mpd-query-1 `a))))
+
+    (define (mpd-query-equals params)
+      (apply format #f "~s == ~s" params))
+
+    (define (mpd-query-and params)
+      (format #f "~a AND ~a"
+              (mpd-query-1 (car params))
+              (mpd-query-1 (cadr params))))
+
+    (define (mpd-query-1 query)
+      (format #f "(~a)"
+              (let ((op (car query)))
+                (case op
+                  ('= (mpd-query-equals (cdr query)))
+                  ('and (mpd-query-and (cdr query)))))))))