#lang racket/base

;; Typed interface for the UPnP ContentDirectory service.
;;
;; The Result field is returned as raw DIDL-Lite XML.  Parsing DIDL-Lite into
;; media items belongs in a separate media-server layer.

(require "../service.rkt")

(provide content-directory?
         device-content-directory
         content-directory-browse
         content-directory-search
         content-result?
         content-result-content
         content-result-number-returned
         content-result-total-matches
         content-result-update-id)

(struct content-result
  (content number-returned total-matches update-id)
  #:transparent
  #:constructor-name make-content-result)

(define (content-directory? value)
  (and (upnp-service? value)
       (eq? (upnp-service-kind value) 'content-directory)))

(define (check-content-directory who value)
  (unless (content-directory? value)
    (raise-argument-error who "content-directory?" value)))

(define (device-content-directory device)
  (upnp-device-service device 'content-directory))

(define (result-number result name)
  (let ([value (hash-ref result name #f)])
    (and value (string->number value))))

(define (make-browse-result result)
  (make-content-result
   (hash-ref result "Result" "")
   (result-number result "NumberReturned")
   (result-number result "TotalMatches")
   (result-number result "UpdateID")))

(define (check-page-arguments who start count)
  (unless (exact-nonnegative-integer? start)
    (raise-argument-error who "exact-nonnegative-integer?" start))
  (unless (exact-nonnegative-integer? count)
    (raise-argument-error who "exact-nonnegative-integer?" count)))

(define (content-directory-browse directory object-id
                                  #:metadata? [metadata? #f]
                                  #:filter [filter "*"]
                                  #:start [start 0]
                                  #:count [count 0]
                                  #:sort [sort ""])
  (check-content-directory 'content-directory-browse directory)
  (unless (string? object-id)
    (raise-argument-error 'content-directory-browse "string?" object-id))
  (check-page-arguments 'content-directory-browse start count)
  (make-browse-result
   (upnp-service-call
    directory
    "Browse"
    (list (cons "ObjectID" object-id)
          (cons "BrowseFlag"
                (if metadata? "BrowseMetadata" "BrowseDirectChildren"))
          (cons "Filter" filter)
          (cons "StartingIndex" start)
          (cons "RequestedCount" count)
          (cons "SortCriteria" sort)))))

(define (content-directory-search directory container-id search-criteria
                                  #:filter [filter "*"]
                                  #:start [start 0]
                                  #:count [count 0]
                                  #:sort [sort ""])
  (check-content-directory 'content-directory-search directory)
  (unless (string? container-id)
    (raise-argument-error 'content-directory-search "string?" container-id))
  (unless (string? search-criteria)
    (raise-argument-error 'content-directory-search "string?" search-criteria))
  (check-page-arguments 'content-directory-search start count)
  (make-browse-result
   (upnp-service-call
    directory
    "Search"
    (list (cons "ContainerID" container-id)
          (cons "SearchCriteria" search-criteria)
          (cons "Filter" filter)
          (cons "StartingIndex" start)
          (cons "RequestedCount" count)
          (cons "SortCriteria" sort)))))