quick hack mpv JSON IPC client

mpv.rkt

#lang racket
(require json
         racket/port
         racket/unix-socket
         racket/async-channel)

(provide mpv/fire-and-forget)
(define (mpv/fire-and-forget files)
  (match-let-values
    ([(_ _ to-mpv _) (subprocess (open-output-file "/dev/null" #:exists 'append)
                                 #f
                                 (open-output-file "/dev/null" #:exists 'append)
                                 'new
                                 (find-executable-path "mpv")
                                 "--no-terminal"
                                 "--really-quiet"
                                 "--playlist=-")])

    (display-lines files to-mpv)
    (display "\n" to-mpv)
    (flush-output to-mpv)
    (close-output-port to-mpv)))


(provide current-mpv-connection)
(define current-mpv-connection (make-parameter null))

(provide mpv-server)
(define (mpv-server)
  (match-let*-values ([(socket-name) (format "/tmp/mpv.socket-~a" (current-inexact-milliseconds))]
                      [(`(,_ ,_ ,proc-pid ,_ ,proc-control))
                       ;; start mpv
                       (apply process*
                              `(,(find-executable-path "mpv")
                                 "--no-terminal"
                                 "--idle=yes"
                                 ,(string-append "--input-ipc-server=" socket-name)))]
                      [(socket-in socket-out)
                       (begin
                         ;; give mpv a moment to create the unix socket
                         (let retry-loop ([retries 30])
                           (when (zero? retries) (raise 'mpv-failed-to-start-in-time))
                           (unless (file-exists? socket-name)
                             (sleep .1)
                             (retry-loop (sub1 retries))))
                         ;; connect to mpv
                         (unix-socket-connect socket-name))])

    (thread (thunk
              (define request-bindings (make-hash))
              (define observer-map (make-hash))

              (define (send-json js)
                (displayln (jsexpr->string js)
                           socket-out)
                (flush-output socket-out))

              ;; unix socket connection thread
              ;;   syncing on a unix socket connection and a thread mailbox at the
              ;;   same time doesn't seem to work, so instead each are given their
              ;;   own thread.   TODO: deeper investigation
              (thread (thunk
                        (let loop ()
                          (define res (read-json socket-in))
                          (match res
                            ;; command response
                            [(hash-table ('request_id request-id) _ ...)
                             (async-channel-put (hash-ref request-bindings (hash-ref res 'request_id))
                                                `(,(hash-ref res 'error)
                                                   ,(hash-ref res 'data #f)))
                             (hash-remove! request-bindings (hash-ref res 'request_id))]

                            ;; observations
                            [(hash-table ('event event)
                                         ('id id)
                                         ('data data)
                                         ('name name) _ ...)
                             (async-channel-put (hash-ref request-bindings id)
                                                `(,event ,data ,name))]

                            ;; disconnencted (mpv probably quit)
                            [(? (curry eq? eof) _) (raise 'mpv-lost-connection) ]

                            ;; print everything else
                            [e (println e)])
                          (loop))))

              ;; Thread mailbox thread loop
              (let loop ()
                (define res (thread-receive))
                (match res
                  ;; normal command
                  [`(,command ,return-channel)
                    (define request-id (random 4294967087))
                    (send-json (hash 'command command
                                     'request_id request-id))

                    (hash-set! request-bindings request-id return-channel)]

                  ;; observations
                  [`(observe ,command ,name ,return-channel)
                    (define observer-id (random 4294967087))
                    (send-json
                      (hash 'command `(,command ,observer-id ,name)))
                    (hash-set! observer-map return-channel observer-id)
                    (hash-set! request-bindings observer-id return-channel)]

                  ;; cancel observations
                  [`(unobserve ,observation-channel)
                    (define observer-id (hash-ref observer-map observation-channel))
                    (send-json
                      (hash 'command `("unobserve_property" ,observer-id)))
                    (hash-remove! request-bindings observer-id)
                    (hash-remove! observer-map observation-channel)]

                  ;; print everything else
                  [e (printf "unknown:~a~n" e)])
                (loop))))))


(provide mpv-command/sync)
(define (mpv-command/sync cmd #:connection [connection (current-mpv-connection)])
  (let* ([return-channel (make-async-channel)]
         [request `(,cmd ,return-channel)])
    (thread-send connection request)
    (match (async-channel-get return-channel)
      [`("success" ,response) response]
      [`("error" ,response) (raise response)]
      )))

(provide mpv-command/async)
(define (mpv-command/async cmd #:connection [connection (current-mpv-connection)])
  (let* ([return-channel (make-async-channel)]
         [request `(,cmd ,return-channel)])
    (thread-send connection request)
    return-channel))

(define (mpv-observe cmd name #:connection [connection (current-mpv-connection)])
  (let* ([observation-channel (make-async-channel)]
         [request `(observe ,cmd ,name ,observation-channel)])
    (thread-send connection request)
    observation-channel))

(provide mpv-unobserve)
(define (mpv-unobserve observation-channel #:connection [connection (current-mpv-connection)])
  (let* ([request `(unobserve ,observation-channel)])
    (thread-send connection request)))

(provide mpv-loadfile)
(define (mpv-loadfile file #:connection [connection (current-mpv-connection)])
  (mpv-command/sync `("loadfile" ,file)
                    #:connection connection))

(provide mpv-loadfile-append)
(define (mpv-loadfile-append file #:connection [connection (current-mpv-connection)])
  (mpv-command/sync `("loadfile" ,file "append-play")
                    #:connection connection))

(provide mpv-playlist-clear)
(define (mpv-playlist-clear #:connection [connection (current-mpv-connection)])
  (mpv-command/sync '("stop")
                    #:connection connection))

(provide mpv-playlist-load)
(define (mpv-playlist-load lst #:connection [connection (current-mpv-connection)])
  (for ([file lst])
    (mpv-loadfile-append file
                         #:connection connection)))