#lang racket/base

(require racket/class
         racket/list
         racket/string
         (prefix-in upnp: racket-upnp)
         "base/media-container.rkt"
         "../misc/utils.rkt")

(provide mc-media-server%)

(define mc-media-server%
  (class media-container%
    (init-field
     library
     container-id
     title)

    (check/c* mc-media-server%
              (library object?)
              (container-id string?)
              (title string?))

    (define/private (audio-item? entry)
      (and
       (upnp:media-item? entry)
       (string? (upnp:media-entry-id entry))
       (string? (upnp:media-entry-parent-id entry))
       (not
        (null?
         (upnp:media-item-resources entry)))
       (or
        (let ((class
               (upnp:media-entry-class entry)))
          (and class
               (string-prefix?
                class
                "object.item.audioItem")))
        (for/or
            ((resource
              (in-list
               (upnp:media-item-resources entry))))
          (let ((content-type
                 (upnp:media-resource-content-type
                  resource)))
            (and content-type
                 (string-prefix?
                  content-type
                  "audio/")))))))

    (define/override (get-title)
      title)

    (define/override (get-items)
      (filter-map
       (lambda (entry)
         (cond
           ((and (upnp:media-container? entry)
                 (string?
                  (upnp:media-entry-id entry)))
            (send library
                  make-container
                  entry))
           ((audio-item? entry)
            (send library
                  make-track
                  entry))
           (else #f)))
       (send library
             browse-container
             container-id)))

    (define/override (get-track-reliver)
      (lambda (track-factory-id
               track-relive-info)
        (send library
              relive-track
              track-factory-id
              track-relive-info)))

    (super-new
     [id
      (cons
       (send (send library get-cfg)
             get-id)
       container-id)])))