#lang racket/base

(require racket-audio
         racket-audio-dlna
         racket/list
         racket/path
         racket/string
         racket-sonos
         racket-upnp
         simple-log
         "library.rkt")

(provide make-player
         player-state->jsexpr
         player-command!
         player-discover!
         player-close!)

(sl-def-log web-player)

(struct renderer
  (id name kind device)
  #:transparent)

(struct playlist-tab
  (id [name #:mutable] [tracks #:mutable])
  #:transparent)

(struct player
  (libraries
   [current-library-id #:mutable]
   [browser-path #:mutable]
   [browser-entries #:mutable]
   [tracks #:mutable]
   [tabs #:mutable]
   [current-tab-index #:mutable]
   [renderers #:mutable]
   [selected-id #:mutable]
   [backend #:mutable]
   [backend-kind #:mutable]
   [current-index #:mutable]
   [state #:mutable]
   [position #:mutable]
   [duration #:mutable]
   [rate #:mutable]
   [channels #:mutable]
   [bits #:mutable]
   [decoder #:mutable]
   [volume #:mutable]
   [repeat #:mutable]
   [error #:mutable]
   [discovering? #:mutable]
   [closed? #:mutable]
   state-lock
   command-lock
   dlna-port)
  #:transparent)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal state / functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (with-state-lock value proc)
  (call-with-semaphore (player-state-lock value) proc))

(define (renderer-by-id value id)
  (findf (λ (item)
           (string=? (renderer-id item) id))
         (player-renderers value)))

(define (library-by-id value id)
  (findf (λ (library)
           (string=? (music-library-id library) id))
         (player-libraries value)))

(define (current-library value)
  (and (player-current-library-id value)
       (library-by-id value
                      (player-current-library-id value))))

(define (current-tab value)
  (list-ref (player-tabs value)
            (player-current-tab-index value)))

(define (save-current-tab! value)
  (set-playlist-tab-tracks!
   (current-tab value)
   (player-tracks value)))

(define (normalize-state state)
  (cond
    ((eq? state 'playing) 'playing)
    ((eq? state 'paused) 'paused)
    ((eq? state 'transitioning) 'starting)
    ((eq? state 'initialized) 'stopped)
    ((eq? state 'no-media) 'stopped)
    (else state)))

(define (set-error! value message)
  (with-state-lock
   value
   (λ ()
     (set-player-error! value message))))

(define (clear-error! value)
  (set-error! value #f))

(define (reset-audio-info! value)
  (set-player-rate! value #f)
  (set-player-channels! value #f)
  (set-player-bits! value #f)
  (set-player-decoder! value #f))

(define (local-state-callback value handle state full-state)
  (with-state-lock
   value
   (λ ()
     (when (eq? handle (player-backend value))
       (set-player-state! value (normalize-state state))
       (set-player-position!
        value
        (or (hash-ref full-state 'at-second #f) 0))
       (set-player-duration!
        value
        (hash-ref full-state 'duration #f))
       (set-player-rate! value
                         (hash-ref full-state 'rate #f))
       (set-player-channels! value
                             (hash-ref full-state 'channels #f))
       (set-player-bits! value
                         (hash-ref full-state 'bits #f))
       (set-player-decoder! value
                            (hash-ref full-state 'decoder #f))))))

(define (local-end-callback value handle)
  (when (eq? handle (player-backend value))
    (with-handlers
        ((exn:fail?
          (λ (exception)
            (set-error! value (exn-message exception)))))
      (player-command! value "next" (hasheq)))))

(define (make-local-backend value)
  (let ((backend
         (make-audio-player
          (λ (handle state full-state)
            (local-state-callback value handle state full-state))
          (λ (handle)
            (local-end-callback value handle)))))
    (audio-ao-buf-ms! backend 500)
    (audio-buf-seconds! backend 4 10)
    (let ((logical-volume
           (/ (player-volume value) 100.0)))
      (audio-volume!
       backend
       (* 100.0 logical-volume logical-volume)))
    backend))

(define (make-network-backend value device)
  (make-dlna-player device
                    #:port (player-dlna-port value)
                    #:path "/rkt-web-player/"))

(define (ensure-backend! value)
  (if (player-backend value)
      (player-backend value)
      (let* ((selected
              (renderer-by-id value
                              (player-selected-id value)))
             (kind (and selected (renderer-kind selected)))
             (backend
              (cond
                ((eq? kind 'local)
                 (make-local-backend value))
                ((or (eq? kind 'upnp)
                     (eq? kind 'sonos))
                 (make-network-backend
                  value
                  (renderer-device selected)))
                (else
                 (raise-arguments-error
                  'player-command!
                  "selected renderer is unavailable"
                  "renderer" (player-selected-id value))))))
        (with-state-lock
         value
         (λ ()
           (set-player-backend! value backend)
           (set-player-backend-kind! value kind)))
        backend)))

(define (close-backend! value)
  (let ((backend (player-backend value))
        (kind (player-backend-kind value)))
    (when backend
      (with-handlers
          ((exn:fail?
            (λ (exception)
              (warn-web-player
               "Could not close ~a player: ~a"
               kind
               (exn-message exception)))))
        (if (eq? kind 'local)
            (audio-quit! backend)
            (dlna-player-close! backend))))
    (with-state-lock
     value
     (λ ()
       (set-player-backend! value #f)
       (set-player-backend-kind! value #f)
       (set-player-state! value 'stopped)
       (set-player-position! value 0)
       (set-player-duration! value #f)
       (reset-audio-info! value)))))

(define (stop-playback! value)
  (when (player-backend value)
    (if (eq? (player-backend-kind value) 'local)
        (audio-stop! (player-backend value))
        (dlna-player-stop! (player-backend value))))
  (with-state-lock
   value
   (λ ()
     (set-player-state! value 'stopped)
     (set-player-position! value 0)
     (reset-audio-info! value))))

(define (valid-track-index? value index)
  (and (exact-nonnegative-integer? index)
       (< index (length (player-tracks value)))))

(define (play-index! value index)
  (unless (valid-track-index? value index)
    (raise-arguments-error
     'player-command!
     "track index is outside the playlist"
     "index" index))
  (let* ((item (list-ref (player-tracks value) index))
         (backend (ensure-backend! value))
         (kind (player-backend-kind value)))
    (with-state-lock
     value
     (λ ()
       (set-player-current-index! value index)
       (set-player-state! value 'starting)
       (set-player-position! value 0)
       (set-player-duration! value (track-duration item))))
    (if (eq? kind 'local)
        (audio-play! backend (track-file item))
        (dlna-player-play! backend (track-file item)))
    (clear-error! value)))

(define (next-index value direction)
  (let ((count (length (player-tracks value)))
        (current (player-current-index value))
        (repeat (player-repeat value)))
    (cond
      ((zero? count) #f)
      ((eq? repeat 'one) current)
      ((eq? current #f)
       (if (positive? direction) 0 (- count 1)))
      (else
       (let ((candidate (+ current direction)))
         (cond
           ((and (>= candidate 0) (< candidate count)) candidate)
           ((eq? repeat 'all)
            (if (positive? direction) 0 (- count 1)))
           (else #f)))))))

(define (refresh-network-state! value)
  (when (and (player-backend value)
             (not (eq? (player-backend-kind value) 'local)))
    (with-handlers
        ((exn:fail?
          (λ (exception)
            (set-error! value (exn-message exception)))))
      (let* ((info (dlna-player-info (player-backend value)))
             (track-info (dlna-info-track info)))
        (with-state-lock
         value
         (λ ()
           (set-player-state!
            value
            (normalize-state (dlna-info-state info)))
           (set-player-position!
            value
            (or (dlna-info-position info) 0))
           (set-player-duration!
            value
            (dlna-info-duration info))
           (set-player-rate!
            value
            (and track-info
                 (dlna-track-info-sample-rate track-info)))
           (set-player-channels!
            value
            (and track-info
                 (dlna-track-info-channels track-info)))
           (set-player-bits! value #f)
           (set-player-decoder! value 'dlna)
           (when (number? (dlna-info-volume info))
             (set-player-volume! value
                                 (dlna-info-volume info)))))))))

(define (entry-by-index value index)
  (and (exact-nonnegative-integer? index)
       (< index (length (player-browser-entries value)))
       (list-ref (player-browser-entries value) index)))

(define (refresh-browser! value library relative-path)
  (let ((entries (browse-library library relative-path)))
    (with-state-lock
     value
     (λ ()
       (set-player-current-library-id!
        value
        (music-library-id library))
       (set-player-browser-path! value relative-path)
       (set-player-browser-entries! value entries)))))

(define (selected-entry-tracks value index)
  (let ((entry (entry-by-index value index))
        (library (current-library value)))
    (unless entry
      (raise-arguments-error
       'player-command!
       "library entry does not exist"
       "index" index))
    (unless library
      (raise-arguments-error
       'player-command!
       "no music library is selected"))
    (browser-entry->tracks library entry)))

(define (same-track? first second)
  (equal? (normal-case-path (track-file first))
          (normal-case-path (track-file second))))

(define (append-tracks! value tracks)
  (let ((combined
         (foldl
          (λ (item result)
            (if (findf (λ (existing)
                         (same-track? item existing))
                       result)
                result
                (append result (list item))))
          (player-tracks value)
          tracks)))
    (with-state-lock
     value
     (λ ()
       (set-player-tracks! value combined)
       (save-current-tab! value)))))

(define (replace-tracks! value tracks)
  (stop-playback! value)
  (with-state-lock
   value
   (λ ()
     (set-player-tracks! value tracks)
     (set-player-current-index! value #f)
     (save-current-tab! value))))

(define (drop-track! value index)
  (unless (valid-track-index? value index)
    (raise-arguments-error
     'player-command!
     "track index is outside the playlist"
     "index" index))
  (when (equal? index (player-current-index value))
    (stop-playback! value))
  (with-state-lock
   value
   (λ ()
     (set-player-tracks!
      value
      (append (take (player-tracks value) index)
              (drop (player-tracks value) (+ index 1))))
     (cond
       ((equal? index (player-current-index value))
        (set-player-current-index! value #f))
       ((and (player-current-index value)
             (< index (player-current-index value)))
        (set-player-current-index!
         value
         (- (player-current-index value) 1))))
     (save-current-tab! value))))

(define (move-track! value from-index to-index)
  (unless (and (valid-track-index? value from-index)
               (valid-track-index? value to-index))
    (raise-arguments-error
     'player-command!
     "track move indexes are outside the playlist"
     "from" from-index
     "to" to-index))
  (unless (= from-index to-index)
    (with-state-lock
     value
     (λ ()
       (let* ((tracks (player-tracks value))
              (item (list-ref tracks from-index))
              (without
               (append (take tracks from-index)
                       (drop tracks (+ from-index 1))))
              (moved
               (append (take without to-index)
                       (list item)
                       (drop without to-index)))
              (current (player-current-index value)))
         (set-player-tracks! value moved)
         (when current
           (cond
             ((= current from-index)
              (set-player-current-index! value to-index))
             ((and (< from-index current)
                   (<= current to-index))
              (set-player-current-index! value (- current 1)))
             ((and (<= to-index current)
                   (< current from-index))
              (set-player-current-index! value (+ current 1)))))
         (save-current-tab! value))))))

(define (select-tab! value index)
  (unless (and (exact-nonnegative-integer? index)
               (< index (length (player-tabs value))))
    (raise-arguments-error
     'player-command!
     "playlist tab does not exist"
     "index" index))
  (unless (= index (player-current-tab-index value))
    (stop-playback! value)
    (with-state-lock
     value
     (λ ()
       (save-current-tab! value)
       (set-player-current-tab-index! value index)
       (set-player-tracks!
        value
        (playlist-tab-tracks (current-tab value)))
       (set-player-current-index! value #f)))))

(define (add-tab! value)
  (with-state-lock
   value
   (λ ()
     (save-current-tab! value)
     (let* ((tabs (player-tabs value))
            (number (+ (length tabs) 1))
            (tab
             (playlist-tab
              (format "tab-~a-~a"
                      (current-milliseconds)
                      (random 10000))
              (format "Playlist ~a" number)
              '())))
       (set-player-tabs! value (append tabs (list tab)))
       (set-player-current-tab-index! value (length tabs))
       (set-player-tracks! value '())
       (set-player-current-index! value #f)))))

(define (rename-tab! value index name)
  (unless (and (exact-nonnegative-integer? index)
               (< index (length (player-tabs value))))
    (raise-arguments-error
     'player-command!
     "playlist tab does not exist"
     "index" index))
  (let ((trimmed (string-trim name)))
    (when (string=? trimmed "")
      (raise-arguments-error
       'player-command!
       "playlist name cannot be empty"))
    (with-state-lock
     value
     (λ ()
       (set-playlist-tab-name!
        (list-ref (player-tabs value) index)
        trimmed)))))

(define (delete-tab! value index)
  (when (= (length (player-tabs value)) 1)
    (raise-arguments-error
     'player-command!
     "the last playlist tab cannot be removed"))
  (unless (and (exact-nonnegative-integer? index)
               (< index (length (player-tabs value))))
    (raise-arguments-error
     'player-command!
     "playlist tab does not exist"
     "index" index))
  (stop-playback! value)
  (with-state-lock
   value
   (λ ()
     (save-current-tab! value)
     (let* ((tabs
             (append (take (player-tabs value) index)
                     (drop (player-tabs value) (+ index 1))))
            (new-index
             (min (player-current-tab-index value)
                  (- (length tabs) 1))))
       (set-player-tabs! value tabs)
       (set-player-current-tab-index! value new-index)
       (set-player-tracks!
        value
        (playlist-tab-tracks (list-ref tabs new-index)))
       (set-player-current-index! value #f)))))

(define (track->jsexpr item index)
  (hasheq 'index index
          'title (track-title item)
          'artist (track-artist item)
          'album (track-album item)
          'duration (or (track-duration item) 'null)
          'mimeType (track-mime-type item)
          'source (path->string
                   (or (file-name-from-path (track-file item))
                       (track-file item)))))

(define (renderer->jsexpr item)
  (hasheq 'id (renderer-id item)
          'name (renderer-name item)
          'kind (symbol->string (renderer-kind item))))

(define (library->jsexpr library)
  (hasheq 'id (music-library-id library)
          'name (music-library-name library)))

(define (browser-entry->jsexpr entry index)
  (hasheq 'index index
          'name (browser-entry-name entry)
          'kind (symbol->string (browser-entry-kind entry))))

(define (tab->jsexpr tab index)
  (hasheq 'index index
          'id (playlist-tab-id tab)
          'name (playlist-tab-name tab)
          'count (length (playlist-tab-tracks tab))))

(define (normal-device-id device)
  (let ((id (upnp-device-udn device)))
    (and id
         (let ((match
                (regexp-match
                 #px"(?i:RINCON_[0-9A-F]+)"
                 id)))
           (if match
               (string-upcase (car match))
               (regexp-replace #px"(?i:^uuid:)" id ""))))))

(define (sonos-member? device member-ids)
  (let ((id (normal-device-id device)))
    (and id
         (ormap (λ (member-id)
                  (string-ci=? id member-id))
                member-ids))))

(define (discover-renderers)
  (let* ((devices (query-upnp-devices 'all))
         (media-renderers (filter media-renderer? devices))
         (groups
          (with-handlers
              ((exn:fail?
                (λ (exception)
                  (warn-web-player
                   "Could not read Sonos topology: ~a"
                   (exn-message exception))
                  '())))
            (sonos-groups devices)))
         (member-ids
          (append-map sonos-group-member-ids groups))
         (upnp-renderers
          (for/list ((device (in-list media-renderers))
                     #:unless (sonos-member? device member-ids))
            (renderer
             (format "upnp:~a"
                     (or (upnp-device-udn device)
                         (media-renderer-address device)))
             (if (sonos-device? device)
                 (sonos-device-name device)
                 (media-renderer-name device))
             'upnp
             device)))
         (sonos-renderers
          (for/list ((group (in-list groups)))
            (renderer
             (format "sonos:~a" (sonos-group-id group))
             (sonos-group-name group)
             'sonos
             (sonos-group-renderer group)))))
    (sort (append upnp-renderers sonos-renderers)
          string-ci<?
          #:key renderer-name)))

(define (json-number data key [default #f])
  (let ((value (hash-ref data key default)))
    (if (number? value) value default)))

(define (json-string data key [default #f])
  (let ((value (hash-ref data key default)))
    (if (string? value) value default)))

(define (perform-library-command! value command data)
  (let ((index (json-number data 'index #f)))
    (cond
      ((string=? command "library")
       (let* ((id (json-string data 'id #f))
              (library (and id (library-by-id value id))))
         (unless library
           (raise-arguments-error
            'player-command!
            "music library does not exist"
            "id" id))
         (refresh-browser! value library '())))
      ((string=? command "browse")
       (let ((entry (entry-by-index value index)))
         (unless (and entry
                      (eq? (browser-entry-kind entry) 'container))
           (raise-arguments-error
            'player-command!
            "library entry is not a directory"
            "index" index))
         (refresh-browser!
          value
          (current-library value)
          (browser-entry-relative-path entry))))
      ((string=? command "up")
       (unless (null? (player-browser-path value))
         (refresh-browser!
          value
          (current-library value)
          (drop-right (player-browser-path value) 1))))
      ((string=? command "item-play")
       (let ((tracks (selected-entry-tracks value index)))
         (when (null? tracks)
           (raise-arguments-error
            'player-command!
            "selected item contains no supported audio"))
         (replace-tracks! value tracks)
         (play-index! value 0)))
      ((string=? command "item-add")
       (append-tracks!
        value
        (selected-entry-tracks value index))))))

(define (perform-playlist-command! value command data)
  (let ((index (json-number data 'index #f)))
    (cond
      ((string=? command "track-remove")
       (drop-track! value index))
      ((string=? command "track-move")
       (move-track! value
                    (json-number data 'from #f)
                    (json-number data 'to #f)))
      ((string=? command "playlist-clear")
       (replace-tracks! value '()))
      ((string=? command "tab-add")
       (stop-playback! value)
       (add-tab! value))
      ((string=? command "tab-select")
       (select-tab! value index))
      ((string=? command "tab-rename")
       (rename-tab! value index
                    (or (json-string data 'name #f) "")))
      ((string=? command "tab-delete")
       (delete-tab! value index)))))

(define (perform-command! value command data)
  (cond
    ((member command '("library" "browse" "up"
                       "item-play" "item-add"))
     (perform-library-command! value command data))
    ((member command '("track-remove" "track-move"
                       "playlist-clear" "tab-add"
                       "tab-select" "tab-rename"
                       "tab-delete"))
     (perform-playlist-command! value command data))
    ((string=? command "play")
     (play-index!
      value
      (or (json-number data 'index #f)
          (player-current-index value)
          0)))
    ((string=? command "pause")
     (let ((backend (ensure-backend! value)))
       (if (eq? (player-backend-kind value) 'local)
           (audio-pause! backend #t)
           (dlna-player-pause! backend))))
    ((string=? command "resume")
     (let ((backend (ensure-backend! value)))
       (if (eq? (player-backend-kind value) 'local)
           (audio-pause! backend #f)
           (dlna-player-resume! backend))))
    ((string=? command "stop")
     (stop-playback! value))
    ((string=? command "next")
     (let ((index (next-index value 1)))
       (if index
           (play-index! value index)
           (stop-playback! value))))
    ((string=? command "previous")
     (let ((index (next-index value -1)))
       (when index
         (play-index! value index))))
    ((string=? command "seek")
     (let ((percentage (json-number data 'percentage #f)))
       (unless percentage
         (raise-arguments-error
          'player-command!
          "seek requires a numeric percentage"))
       (let ((backend (ensure-backend! value)))
         (if (eq? (player-backend-kind value) 'local)
             (audio-seek! backend percentage)
             (dlna-player-seek-percentage! backend percentage)))))
    ((string=? command "volume")
     (let ((percentage (json-number data 'value #f)))
       (unless percentage
         (raise-arguments-error
          'player-command!
          "volume requires a numeric value"))
       (let* ((clamped (min 100 (max 0 percentage)))
              (backend (ensure-backend! value)))
         (if (eq? (player-backend-kind value) 'local)
             (let ((logical-volume (/ clamped 100.0)))
               (audio-volume!
                backend
                (* 100.0 logical-volume logical-volume)))
             (dlna-player-volume! backend clamped))
         (with-state-lock
          value
          (λ ()
            (set-player-volume! value clamped))))))
    ((string=? command "repeat")
     (let* ((name (json-string data 'mode "off"))
            (mode (string->symbol name)))
       (unless (member mode '(off all one))
         (raise-arguments-error
          'player-command!
          "repeat mode must be off, all, or one"
          "mode" name))
       (with-state-lock
        value
        (λ ()
          (set-player-repeat! value mode)))))
    ((string=? command "renderer")
     (let* ((id (json-string data 'id #f))
            (selected (and id (renderer-by-id value id))))
       (unless selected
         (raise-arguments-error
          'player-command!
          "renderer does not exist"
          "id" id))
       (unless (string=? id (player-selected-id value))
         (close-backend! value)
         (with-state-lock
          value
          (λ ()
            (set-player-selected-id! value id))))))
    (else
     (raise-arguments-error
      'player-command!
      "unknown player command"
      "command" command))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Create a player for lazily browsed music libraries.
; pre    : Libraries is a list of music-library values; DLNA port is positive.
; post   : Only the selected root directory has been listed; no backend exists.
; result : A player that initially selects local playback.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-player libraries #:dlna-port [dlna-port 8734])
  (let* ((library (and (pair? libraries) (car libraries)))
         (browser-entries
          (if library
              (browse-library library '())
              '()))
         (tab (playlist-tab "default" "Default" '())))
    (player libraries
            (and library (music-library-id library))
            '()
            browser-entries
            '()
            (list tab)
            0
            (list (renderer "local" "Dit apparaat" 'local #f))
            "local"
            #f
            #f
            #f
            'stopped
            0
            #f
            #f
            #f
            #f
            #f
            50
            'off
            #f
            #f
            #f
            (make-semaphore 1)
            (make-semaphore 1)
            dlna-port)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Return the complete browser-visible player state.
; pre    : Value was created with make-player.
; post   : Cached DLNA playback information has been incorporated.
; result : A JSON-compatible hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-state->jsexpr value)
  (refresh-network-state! value)
  (with-state-lock
   value
   (λ ()
     (let ((current
            (and (player-current-index value)
                 (valid-track-index?
                  value
                  (player-current-index value))
                 (list-ref (player-tracks value)
                           (player-current-index value)))))
       (hasheq
        'libraries (map library->jsexpr
                        (player-libraries value))
        'libraryId (or (player-current-library-id value) 'null)
        'browser
        (hasheq
         'path (map path->string (player-browser-path value))
         'canGoUp (not (null? (player-browser-path value)))
         'entries
         (for/list ((entry (in-list (player-browser-entries value)))
                    (index (in-naturals)))
           (browser-entry->jsexpr entry index)))
        'tabs
        (for/list ((tab (in-list (player-tabs value)))
                   (index (in-naturals)))
          (tab->jsexpr tab index))
        'currentTab (player-current-tab-index value)
        'tracks
        (for/list ((item (in-list (player-tracks value)))
                   (index (in-naturals)))
          (track->jsexpr item index))
        'renderers (map renderer->jsexpr
                        (player-renderers value))
        'rendererId (player-selected-id value)
        'currentIndex (or (player-current-index value) 'null)
        'state (symbol->string (player-state value))
        'position (player-position value)
        'duration (or (player-duration value) 'null)
        'rate (or (player-rate value) 'null)
        'channels (or (player-channels value) 'null)
        'bits (or (player-bits value) 'null)
        'format (if (player-decoder value)
                    (format "~a" (player-decoder value))
                    "")
        'source (if current
                    (path->string
                     (or (file-name-from-path (track-file current))
                         (track-file current)))
                    "")
        'volume (player-volume value)
        'repeat (symbol->string (player-repeat value))
        'discovering (player-discovering? value)
        'error (or (player-error value) 'null))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Execute one browser player command.
; pre    : Command is a string and data is a JSON object hash.
; post   : The command has completed or a concrete exception is raised.
; result : The updated JSON-compatible player state.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-command! value command data)
  (call-with-semaphore
   (player-command-lock value)
   (λ ()
     (when (player-closed? value)
       (raise-arguments-error
        'player-command!
        "player has been closed"))
     (with-handlers
         ((exn:fail?
           (λ (exception)
             (set-error! value (exn-message exception))
             (raise exception))))
       (perform-command! value command data))
     (player-state->jsexpr value))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Discover UPnP renderers and logical Sonos groups asynchronously.
; pre    : Value was created with make-player.
; post   : The renderer list is updated when discovery finishes.
; result : #t when discovery started, #f when it was already running.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-discover! value)
  (let ((can-start?
         (with-state-lock
          value
          (λ ()
            (if (player-discovering? value)
                #f
                (begin
                  (set-player-discovering?! value #t)
                  #t))))))
    (when can-start?
      (thread
       (λ ()
         (with-handlers
             ((exn:fail?
               (λ (exception)
                 (set-error! value (exn-message exception)))))
           (let ((found (discover-renderers)))
             (with-state-lock
              value
              (λ ()
                (set-player-renderers!
                 value
                 (cons (renderer "local"
                                 "Dit apparaat"
                                 'local
                                 #f)
                       found))
                (set-player-error! value #f)))))
         (with-state-lock
          value
          (λ ()
            (set-player-discovering?! value #f))))))
    can-start?))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Stop playback and release all player resources.
; pre    : Value was created with make-player.
; post   : The active backend is closed; repeated calls are harmless.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-close! value)
  (call-with-semaphore
   (player-command-lock value)
   (λ ()
     (unless (player-closed? value)
       (close-backend! value)
       (with-state-lock
        value
        (λ ()
          (set-player-closed?! value #t)))))))

(module+ test
  (require rackunit
           racket/file)

  (define root
    (make-temporary-file "rkt-web-player-~a" 'directory))

  (dynamic-wind
    void
    (λ ()
      (make-directory (build-path root "Album"))
      (let* ((libraries (make-music-libraries (list root)))
             (example-player (make-player libraries))
             (initial-state
              (player-state->jsexpr example-player)))
        (check-equal? (hash-ref initial-state 'state) "stopped")
        (check-equal? (hash-ref initial-state 'rendererId) "local")
        (check-equal? (length (hash-ref initial-state 'libraries)) 1)
        (check-equal?
         (length (hash-ref (hash-ref initial-state 'browser) 'entries))
         1)
        (check-equal? (length (hash-ref initial-state 'tracks)) 0)

        (define browsed-state
          (player-command!
           example-player
           "browse"
           (hasheq 'index 0)))

        (check-equal?
         (hash-ref (hash-ref browsed-state 'browser) 'path)
         '("Album"))
        (check-true
         (hash-ref (hash-ref browsed-state 'browser) 'canGoUp))

        (define root-state
          (player-command! example-player "up" (hasheq)))

        (check-equal?
         (hash-ref (hash-ref root-state 'browser) 'path)
         '())

        (define repeat-state
          (player-command!
           example-player
           "repeat"
           (hasheq 'mode "all")))

        (check-equal? (hash-ref repeat-state 'repeat) "all")

        (define tab-state
          (player-command!
           example-player
           "tab-add"
           (hasheq)))

        (check-equal? (length (hash-ref tab-state 'tabs)) 2)
        (check-equal? (hash-ref tab-state 'currentTab) 1)

        (define renamed-state
          (player-command!
           example-player
           "tab-rename"
           (hasheq 'index 1 'name "Favorieten")))

        (check-equal?
         (hash-ref (list-ref (hash-ref renamed-state 'tabs) 1) 'name)
         "Favorieten")

        (define deleted-state
          (player-command!
           example-player
           "tab-delete"
           (hasheq 'index 1)))

        (check-equal? (length (hash-ref deleted-state 'tabs)) 1)
        (check-exn exn:fail?
                   (λ ()
                     (player-command!
                      example-player
                      "unknown"
                      (hasheq))))
        (player-close! example-player)))
    (λ ()
      (delete-directory/files root))))