#lang racket

(require racket/class
         racket/list
         racket-sonos
         racket-upnp
         "renderer-sonos.rkt"
         "renderer-upnp.rkt"
         "../misc/utils.rkt")

(provide check-dlna-players)

(define running-sem (make-semaphore 1))
(define running #f)

(define (normalized-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 (represented-by-sonos-group? device member-ids)
  (let ((id (normalized-device-id device)))
    (and id
         (ormap
          (lambda (member-id)
            (string-ci=? id member-id))
          member-ids))))

(define (make-generic-renderers devices preferences
                                #:excluded-ids [excluded-ids '()])
  (for/list ((device
              (in-list
               (filter media-renderer? devices)))
             #:unless
             (represented-by-sonos-group?
              device
              excluded-ids))
    (new renderer-upnp%
         [upnp-device device]
         [name
          (if (sonos-device? device)
              (sonos-device-name device)
              #f)]
         [preferences preferences])))

(define (discover-renderers preferences)
  (let* ((devices (query-upnp-devices 'all))
         (groups
          (with-handlers
              ((exn:fail?
                (lambda (e)
                  (warn-rktplayer
                   "Could not read Sonos topology; using generic UPnP renderers: ~a"
                   (exn-message e))
                  '())))
            (sonos-groups devices)))
         (renderers
          (if (null? groups)
              (make-generic-renderers
               devices
               preferences)
              (append
               (make-generic-renderers
                devices
                preferences
                #:excluded-ids
                (append-map
                 sonos-group-member-ids
                 groups))
               (for/list ((group (in-list groups)))
                 (new renderer-sonos%
                      [sonos-group group]
                      [preferences preferences]))))))
    (sort renderers
          string-ci<?
          #:key
          (lambda (renderer)
            (send renderer get-name)))))

(define (check-dlna-players gui preferences)
  (let ((can-check
         (begin
           (semaphore-wait running-sem)
           (let ((was-running running))
             (unless was-running
               (set! running #t))
             (semaphore-post running-sem)
             (not was-running)))))
    (if can-check
        (void
         (thread
          (lambda ()
            (dynamic-wind
              void
              (lambda ()
                (send gui
                      set-dlna-renderers!
                      (discover-renderers preferences)))
              (lambda ()
                (semaphore-wait running-sem)
                (set! running #f)
                (semaphore-post running-sem))))))
        (send gui dlna-query-busy))))