;;; aud/mpd.lisp --- MPD Interface for Lisp

 ;; based on https://github.com/stassats/mpd

 ;;; Commentary:

 ;; The original code hasn't been updated in quite some time. Here

 ;; we've added in some missing slots, fixed a typo, removed the

 ;; dependency on usocket library and extended the functionality

 ;; slightly.

 ;;; Code:

 (in-package :aud/mpd)

 ;;; Classes

 (define-condition mpd-error (error)

   ((text :initarg :text :reader text

          :initform nil))

   (:report (lambda (condition stream)

              (princ (text condition) stream))))

 (macrolet ((define-conditions (names)

              `(progn ,@(mapcar

                         (lambda (name)

                           `(define-condition ,name (mpd-error) ()))

                         names))))

   (define-conditions (bad-argument incorrect-password

                       not-permitted unknown-command not-exist

                       playlist-size-exceed already-updating exist)))

 (defparameter *error-ids-alist*

   '((2 . bad-argument)

     (3 . incorrect-password)

     (4 . not-permitted)

     (5 . unknown-command)

     (50 . not-exist)

     (51 . playlist-size-exceed)

     (54 . already-updating)

     (56 . exist)))

 (eval-always

   (defparameter *tag-types*

     '(:artist :album :title :track :name :genre :date

       :composer :performer :comment :disc :filename :any)

     "Types of tags for using in `search' and `find'"))

 (deftype tag-type ()

   `(member ,@*tag-types*))

 (defclass track ()

   ((file

     :initform nil :initarg :file :accessor file)

    (title

     :initform nil :initarg :title :accessor title)

    (artist

     :initform nil :initarg :artist :accessor artist)

    (albumartist

     :initform nil :initarg :albumartist :accessor albumartist)

    (album

     :initform nil :initarg :album :accessor album)

    (genre

     :initform nil :initarg :genre :accessor genre)

    (date

     :initform nil :initarg :date :accessor date)

    (performer

     :initform nil :initarg :performer :accessor performer)

    (composer

     :initform nil :initarg :composer :accessor composer)

    (disc

     :initform nil :initarg :disc :accessor disc)

    (track

     :initform nil :initarg :track :accessor track-number)

    (time

     :initform nil :initarg :time :accessor duration)

    (last-modified

     :initform nil :initarg :last-modified :accessor last-modified)))

 (defclass playlist (track)

   ((pos

     :initform 0 :initarg :pos :accessor position-in-playlist

     :type integer)

    (duration

     :initform nil :initarg :duration)

    (format :initform nil :initarg :format)

    (id

     :initform 0 :initarg :id :accessor id

     :type integer)))

 (defclass status ()

   ((volume

     :reader volume :initarg :volume :initform nil)

    (repeat

     :reader repeat :initarg :repeat :initform nil)

    (random

     :reader randomized :initarg :random :initform nil)

    (playlist

     :reader playlist-version :initarg :playlist :initform nil)

    (playlist-length

     :reader playlist-length :initarg :playlistlength :initform nil)

    (xfade

     :reader xfade :initarg :xfade :initform nil)

    (state

     :reader state :initarg :state :initform nil)

    (partition

     :reader partition :initarg :partition :initform nil)

    (audio

     :reader audio :initarg :audio :initform nil)

    (bitrate

     :reader bitrate :initarg :bitrate :initform nil)

    (duration

     :reader duration :initarg :duration :initform nil)

    (time

     :reader %time :initarg :time :initform nil)

    (songid

     :reader songid :initarg :songid :initform nil)

    (song :reader song :initarg :song :initform nil)

    (nextsongid

     :reader nextsongid :initarg :nextsongid :initform nil)

    (nextsong 

     :reader nextsong :initarg :nextsong :initform nil)

    (elapsed

     :reader elapsed :initarg :elapsed :initform nil)

    (mixrampdb 

     :reader mixrampdb :initarg :mixrampdb :initform nil)

    (consume 

     :reader consume :initarg :consume :initform nil)

    (single 

     :reader single :initarg :single :initform nil)))

 (defclass stats ()

   ((artists

     :reader artists :initarg :artists :initform nil)

    (albums

     :reader albums :initarg :albums :initform nil)

    (songs

     :reader songs :initarg :songs :initform nil)

    (uptime

     :reader uptime :initarg :uptime :initform nil)

    (playtime

     :reader playtime :initarg :playtime :initform nil)

    (db-playtime

     :reader db-playtime :initarg :db_playtime :initform nil)

    (db-update

     :reader db-update :initarg :db_update :initform nil)))

 (macrolet ((generate-commands (class names)

              `(progn

                 ,@(mapcar (lambda (name)

                             `(defmethod ,name ((stream socket))

                                (,name (,class stream))))

                           names))))

   (generate-commands status

                      (volume repeat randomized playlist-version playlist-length

                       xfade state audio bitrate duration songid song))

   (generate-commands stats

                      (artists albums songs uptime playtime db-playtime db-update)))

 (defparameter *integer-keys*

   '(:id :pos :volume :playlist :playlistlength

     :xfade :song :songid :bitrate :playtime

     :artists :albums :songs :uptime :db_playtime :db_update

     :outputid)

   "List of keys which values must be integers.")

 (defparameter *value-processing-functions*

   '(:time parse-time :state to-keyword

     :random string-not-zerop :repeat string-not-zerop

     :outputenabled string-not-zerop))

 (defmethod print-object ((object track) stream)

   (print-unreadable-object (object stream :type t :identity t)

     (with-slots (artist title album) object

       (format stream "~A - ~A (~A)" artist title album))))

 ;;; MPD

 (defvar *default-host* (or (sb-posix:getenv "MPD_HOST") "localhost"))

 (defvar *default-port* (or (when-let ((port (sb-posix:getenv "MPD_PORT"))) (parse-integer port)) 6600))

 (defun connect (&key (host *default-host*) (port *default-port*) password)

   "Connect to MPD."

   (let ((connection (socket-connect (make-instance 'inet-socket :type :stream) (get-address-by-name host) port)))

     (prog1 (values connection

                    (read-answer (socket-make-stream connection :input t :output t)))

       (when password

         (password connection password)))))

 (defun read-answer (stream)

   (loop for line = (read-line stream)

         until (string= line "OK" :end1 2)

         collect line

         when (string= line "ACK" :end1 3)

         do (throw-error line)))

 (defun throw-error (text)

   ;; Error format: `ACK [<error id>@<position>] {<comand name>} <description>'

   (let* ((error-id (parse-integer text :start 5 :junk-allowed t))

          (delimiter (position #\] text))

          (condition (cdr (assoc error-id *error-ids-alist*))))

     (error condition :text (subseq text (+ delimiter 2)))))

 (eval-always

   (defmacro with-mpc ((var &rest options) &body body)

     `(let ((,var (connect ,@options)))

        (unwind-protect

             (progn ,@body)

          (disconnect ,var)))))

 (defun ensure-mpd ()

   (handler-case

       (with-mpc (c) t)

     (not-exist () (sb-ext:run-program "mpd" nil :search t :directory (user-homedir-pathname) :wait nil))))

 (defun send-command (connection command)

   "Send command to MPD."

   (let ((stream (socket-make-stream connection :input t)))

     (unless (open-stream-p stream)

       (error 'mpd-error :text (format nil "The stream ~A is not opened." stream)))

     (write-line command stream)

     (finish-output stream)

     (read-answer stream)))

 ;;; Parsing

 (defun to-keyword (name)

   (intern (string-upcase name) :keyword))

 (defun split-value (string)

   "Split a string `key: value' into (list :key value)."

   (let ((column (position #\: string)))

     (process-value (to-keyword (subseq string 0 column))

                    (subseq string (+ 2 column)))))

 (defun split-values (strings)

   "Transform a list of strings 'key: value' into the plist."

   (mapcan #'split-value strings))

 (defun process-value (key value)

   (list key

         (funcall (value-processing-function key) value)))

 (defun value-processing-function (key)

   (if (member key *integer-keys*)

       #'parse-integer

       (getf *value-processing-functions* key #'identity)))

 (defun parse-time (time)

   "\"10:20\" -> (10 20); \"10\" -> 10"

   (multiple-value-bind (first stop)

       (parse-integer time :junk-allowed t)

     (if (= stop (length time))

         first

         (list first

               (parse-integer time :start (1+ stop))))))

 (defun string-not-zerop (string)

   (not (string= string "0")))

 (defun filter-keys (strings)

   "Transform a list of strings 'key: value' into a list of values."

   (mapcar (lambda (entry)

             (subseq entry (+ 2 (position #\: entry))))

           strings))

 (defun make-class (data type)

   "Make a new instance of the class playlist with initargs from

    the list of strings `key: value'."

   (apply 'make-instance type (split-values data)))

 (defun parse-list (list &optional class)

   "Make a list of new instances of the class `class' with initargs from

    a list of strings `key: value'. Each track is separeted by the `file' key."

   (let (track)

     (flet ((create-track ()

              (when track

                (list (apply 'make-instance class track)))))

       (nconc

        (mapcan (lambda (x)

                  (let ((pair (split-value x)))

                    (case (car pair)

                      (:file (prog1 (create-track)

                               (setf track pair)))

                      ((:directory :playlist)

                       (list pair))

                      (t (nconc track pair)

                         nil))))

                list)

        (create-track)))))

 ;;;

 (defun process-string (string)

   "Check for emtpy strings, and escape strings when needed."

   (when string

     (let ((string

            (string-trim '(#\Space #\Tab #\Newline) string)))

       (when (zerop (length string))

         (error 'mpd-error :text "Zero length argument."))

       (if (position #\Space string)

           (prin1-to-string string)

           string))))

 ;;; Macros

 (defmacro send (&rest commands)

   "Macro for using inside `defcommand'."

   `(send-command connection

                  (format nil "~{~A~^ ~}"

                          (remove nil (list ,@commands)))))

 (defmacro defcommand (name parameters &body body)

   `(defun ,name (connection ,@parameters)

      ,@body))

 (defmacro defmethod-command (name parameters &body body)

   `(defmethod ,name (connection ,@parameters)

      ,@body))

 (defmacro check-args (type &rest args)

   "Check string and integer arguments."

   (if (or (eq type 'string)

           (and (listp type)

                (member 'string type)))

       `(progn ,@(mapcan

                  (lambda (arg)

                    `((check-type ,arg ,type "a string")

                      (setf ,arg (process-string ,arg))))

                  args))

       `(progn ,@(mapcar

                  (lambda (arg)

                    `(check-type ,arg ,type))

                  args))))

 ;;; Commands

 (defcommand password (password)

   "Authentication."

   (check-args string password)

   (send "password" password))

 (defcommand disconnect ()

   "Close connection."

   (socket-close connection))

 (defcommand now-playing ()

   "Return instance of playlist with current song."

   (let ((track (send "currentsong")))

     (when track

       (make-class track 'playlist))))

 (defcommand disable-output (id)

   (check-args unsigned-byte id)

   (send "disableoutput" id))

 (defcommand enable-output (id)

   (check-args unsigned-byte id)

   (send "enableoutput" id))

 (defcommand ping ()

   "Send ping to MPD."

   (send "ping"))

 (defcommand kill ()

   "Stop MPD in a safe way."

   (send "kill"))

 (defcommand status ()

   "Return status of MPD."

   (make-class (send "status") 'status))

 (defcommand stats ()

   "Return statisics."

   (make-class (send "stats") 'stats))

 (defcommand outputs ()

   "Return information about all outputs."

   (split-values (send "outputs")))

 (defcommand commands ()

   "Return list of available commands."

   (filter-keys (send "commands")))