#lang racket/base

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

(provide make-dlna-playback
         dlna-playback-play-index!
         dlna-playback-pause!
         dlna-playback-resume!
         dlna-playback-stop!
         dlna-playback-seek-percentage!
         dlna-playback-volume!
         dlna-playback-repeat!
         dlna-playback-close!)

(sl-def-log web-player-dlna)

;; This module deliberately contains only playlist orchestration. Transport,
;; HTTP publication, metadata, polling and seeking remain the responsibility
;; of racket-audio-dlna.
(struct dlna-playback
  (player
   tracks
   update
   error
   [repeat #:mutable]
   [current-index #:mutable]
   [current-uri #:mutable]
   [prepared-index #:mutable]
   [playing-seen? #:mutable]
   [progress-seen? #:mutable]
   [failure-active? #:mutable]
   [stop-requested? #:mutable]
   [stopped-polls #:mutable]
   [play-request-ms #:mutable]
   [reachable? #:mutable]
   [running? #:mutable]
   [monitor #:mutable]
   lock)
  #:transparent)

(define playback-start-timeout-ms 8000)

(define (now-ms)
  (current-inexact-milliseconds))

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

;; Position reporting is optional and notably unreliable on some Denon
;; renderers. PLAYING, TRANSITIONING or PAUSED is itself confirmation that the
;; renderer accepted the transport. A positive position remains useful for
;; devices whose transport state lags behind their position response.
(define (renderer-confirms-playback? state position)
  (or (and (member state '(playing starting paused)) #t)
      (and (number? position) (> position 0))))

(define (with-lock playback proc)
  (call-with-semaphore (dlna-playback-lock playback) proc))

(define (current-tracks playback)
  ((dlna-playback-tracks playback)))

(define (valid-index? playback index)
  (and (exact-nonnegative-integer? index)
       (< index (length (current-tracks playback)))))

(define (track-at playback index)
  (and (valid-index? playback index)
       (list-ref (current-tracks playback) index)))

(define (normalized-file file)
  (with-handlers ((exn:fail? (lambda (_) (format "~a" file))))
    (path->string (path->complete-path file))))

(define (same-file? first second)
  (and first
       second
       ((if (eq? (system-type 'os) 'windows)
            string-ci=?
            string=?)
        (normalized-file first)
        (normalized-file second))))

(define (next-index playback index)
  (define count (length (current-tracks playback)))
  (cond
    ((zero? count) #f)
    ((eq? (dlna-playback-repeat playback) 'one) index)
    ((< (+ index 1) count) (+ index 1))
    ((eq? (dlna-playback-repeat playback) 'all) 0)
    (else #f)))

(define (track-index-for-info playback info)
  (define info-track (dlna-info-track info))
  (define file (and info-track (dlna-track-info-file info-track)))
  (define prepared (dlna-playback-prepared-index playback))
  (cond
    ((and (valid-index? playback prepared)
          (same-file? file (track-file (track-at playback prepared))))
     prepared)
    (else
     (for/first ((item (in-list (current-tracks playback)))
                 (index (in-naturals))
                 #:when (same-file? file (track-file item)))
       index))))

(define (notify! playback state info)
  ((dlna-playback-update playback)
   state
   (dlna-playback-current-index playback)
   info))

(define (report-failure! playback detail)
  (set-dlna-playback-playing-seen?! playback #f)
  (set-dlna-playback-progress-seen?! playback #f)
  (set-dlna-playback-failure-active?! playback #t)
  (set-dlna-playback-play-request-ms! playback #f)
  (set-dlna-playback-stopped-polls! playback 0)
  ((dlna-playback-error playback) detail))

(define (prepare-next! playback)
  (define current (dlna-playback-current-index playback))
  (when (valid-index? playback current)
    (define following (next-index playback current))
    (cond
      ((not following)
       (set-dlna-playback-prepared-index! playback #f))
      ((not (equal? following (dlna-playback-prepared-index playback)))
       (with-handlers
           ((exn:fail?
             (lambda (exception)
               (set-dlna-playback-prepared-index! playback #f)
               (warn-web-player-dlna
                "Could not prepare next DLNA track: ~a"
                (exn-message exception)))))
         (dlna-player-set-next-file!
          (dlna-playback-player playback)
          (track-file (track-at playback following)))
         (set-dlna-playback-prepared-index! playback following))))))

(define (play-index/locked! playback index)
  (define item (track-at playback index))
  (unless item
    (raise-arguments-error
     'dlna-playback-play-index!
     "track index is outside the playlist"
     "index" index))
  (with-handlers
      ((exn:fail?
        (lambda (exception)
          (report-failure! playback (exn-message exception))
          (raise exception))))
    (dlna-player-play! (dlna-playback-player playback) (track-file item))
    (define info (dlna-player-info (dlna-playback-player playback)))
    (set-dlna-playback-current-index! playback index)
    (set-dlna-playback-current-uri! playback (dlna-info-uri info))
    (set-dlna-playback-prepared-index! playback #f)
    (set-dlna-playback-playing-seen?! playback #t)
    (set-dlna-playback-progress-seen?! playback #f)
    (set-dlna-playback-failure-active?! playback #f)
    (set-dlna-playback-play-request-ms! playback (now-ms))
    (set-dlna-playback-stop-requested?! playback #f)
    (set-dlna-playback-stopped-polls! playback 0)
    (notify! playback 'starting info)
    (prepare-next! playback)))

(define (update-current-track! playback info)
  (define index (track-index-for-info playback info))
  (when (valid-index? playback index)
    (unless (equal? index (dlna-playback-current-index playback))
      (set-dlna-playback-progress-seen?! playback #f)
      (set-dlna-playback-play-request-ms! playback (now-ms)))
    (set-dlna-playback-current-index! playback index)
    (set-dlna-playback-prepared-index! playback #f)
    (prepare-next! playback)))

(define (advance! playback)
  (define current (dlna-playback-current-index playback))
  (define following (and (valid-index? playback current)
                         (next-index playback current)))
  (if following
      (play-index/locked! playback following)
      (begin
        (dlna-player-stop! (dlna-playback-player playback))
        (notify! playback
                 'stopped
                 (dlna-player-info (dlna-playback-player playback))))))

(define (poll/locked! playback)
  (define info (dlna-player-info (dlna-playback-player playback)))
  (cond
    ((not (dlna-info-reachable? info))
     (when (dlna-playback-reachable? playback)
       (set-dlna-playback-reachable?! playback #f)
       ((dlna-playback-error playback) "De DLNA-renderer is niet bereikbaar")))
    (else
     (set-dlna-playback-reachable?! playback #t)
     (define state (normalize-state (dlna-info-state info)))
     (define uri (dlna-info-uri info))
     (define position (dlna-info-position info))
     (define failed-now? #f)

     (when (and (string? uri)
                (not (string=? uri ""))
                (not (equal? uri (dlna-playback-current-uri playback))))
       (set-dlna-playback-current-uri! playback uri)
       (set-dlna-playback-stopped-polls! playback 0)
       (update-current-track! playback info))

     (when (renderer-confirms-playback? state position)
       (set-dlna-playback-progress-seen?! playback #t))

     (when (and (dlna-playback-playing-seen? playback)
                (not (dlna-playback-progress-seen? playback))
                (dlna-playback-play-request-ms playback)
                (>= (- (now-ms)
                       (dlna-playback-play-request-ms playback))
                    playback-start-timeout-ms))
       (set! failed-now? #t)
       (warn-web-player-dlna
        "DLNA start was not confirmed: state=~a position=~a uri=~a"
        state position (or uri ""))
       (report-failure!
        playback
        "De DLNA-renderer bevestigde de start van de track niet"))

     (unless (or failed-now? (dlna-playback-failure-active? playback))
       (cond
         ((eq? state 'playing)
          (set-dlna-playback-playing-seen?! playback #t)
          (set-dlna-playback-stopped-polls! playback 0))
         ((and (eq? state 'stopped)
               (dlna-playback-stop-requested? playback))
          (set-dlna-playback-stop-requested?! playback #f)
          (set-dlna-playback-stopped-polls! playback 0))
         ((and (eq? state 'stopped)
               (dlna-playback-playing-seen? playback))
          (cond
            ((and (not (dlna-playback-progress-seen? playback))
                  (dlna-playback-play-request-ms playback)
                  (< (- (now-ms)
                        (dlna-playback-play-request-ms playback))
                     5000))
             (void))
            ((not (dlna-playback-progress-seen? playback))
             (warn-web-player-dlna
              "DLNA renderer stopped without confirming playback: position=~a uri=~a"
              position (or uri ""))
             (report-failure!
              playback
              "De DLNA-renderer bevestigde de start van de track niet"))
            (else
             (set-dlna-playback-stopped-polls!
              playback
              (+ 1 (dlna-playback-stopped-polls playback)))
             ;; Give SetNextAVTransportURI one poll to take over. Some
             ;; renderers need the explicit fallback on the following poll.
             (when (or (not (dlna-playback-prepared-index playback))
                       (> (dlna-playback-stopped-polls playback) 1))
               (set-dlna-playback-playing-seen?! playback #f)
               (set-dlna-playback-stopped-polls! playback 0)
               (advance! playback)))))))

     (notify!
      playback
      (cond
        ((or failed-now? (dlna-playback-failure-active? playback)) 'stopped)
        ((and (dlna-playback-playing-seen? playback)
              (not (dlna-playback-progress-seen? playback)))
         'starting)
        (else state))
      info))))

(define (monitor-loop playback poll-seconds)
  (let loop ()
    (when (dlna-playback-running? playback)
      (sleep poll-seconds)
      (when (dlna-playback-running? playback)
        (with-handlers
            ((exn:fail?
              (lambda (exception)
                (warn-web-player-dlna
                 "Could not update DLNA playback state: ~a"
                 (exn-message exception)))))
          (with-lock playback (lambda () (poll/locked! playback))))
        (loop)))))

(define (make-dlna-playback device
                            tracks
                            update
                            error
                            #:port [port 8734]
                            #:poll-seconds [poll-seconds 1])
  (define raw
    (make-dlna-player device
                      #:port port
                      #:path "/rkt-web-player/"))
  (define playback
    (dlna-playback raw tracks update error 'off #f #f #f
                   #f #f #f #f 0 #f #t #t #f
                   (make-semaphore 1)))
  (set-dlna-playback-monitor!
   playback
   (thread (lambda () (monitor-loop playback poll-seconds))))
  playback)

(define (dlna-playback-play-index! playback index)
  (with-lock playback (lambda () (play-index/locked! playback index))))

(define (dlna-playback-pause! playback)
  (with-lock
   playback
   (lambda ()
     (dlna-player-pause! (dlna-playback-player playback))
     (notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))

(define (dlna-playback-resume! playback)
  (with-lock
   playback
   (lambda ()
     (dlna-player-resume! (dlna-playback-player playback))
     (notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))

(define (dlna-playback-stop! playback)
  (with-lock
   playback
   (lambda ()
     (set-dlna-playback-stop-requested?! playback #t)
     (set-dlna-playback-playing-seen?! playback #f)
     (set-dlna-playback-progress-seen?! playback #f)
     (set-dlna-playback-failure-active?! playback #f)
     (set-dlna-playback-play-request-ms! playback #f)
     (set-dlna-playback-stopped-polls! playback 0)
     (dlna-player-stop! (dlna-playback-player playback))
     (notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))

(define (dlna-playback-seek-percentage! playback percentage)
  (with-lock
   playback
   (lambda ()
     (dlna-player-seek-percentage! (dlna-playback-player playback) percentage)
     ;; racket-audio-dlna updates its cache synchronously after Seek. Publish
     ;; that value immediately so the web slider does not jump back.
     (define info (dlna-player-info (dlna-playback-player playback)))
     (notify! playback
              (normalize-state (dlna-info-state info))
              info))))

(define (dlna-playback-volume! playback percentage)
  (with-lock
   playback
   (lambda ()
     (dlna-player-volume! (dlna-playback-player playback) percentage)
     (define info (dlna-player-info (dlna-playback-player playback)))
     (notify! playback
              (normalize-state (dlna-info-state info))
              info))))

(define (dlna-playback-repeat! playback repeat)
  (with-lock
   playback
   (lambda ()
     (set-dlna-playback-repeat! playback repeat)
     (set-dlna-playback-prepared-index! playback #f)
     (prepare-next! playback))))

(define (dlna-playback-close! playback)
  (when (dlna-playback-running? playback)
    (set-dlna-playback-running?! playback #f)
    (define monitor (dlna-playback-monitor playback))
    (when (and monitor (not (thread-dead? monitor)))
      (kill-thread monitor))
    (set-dlna-playback-monitor! playback #f)
    (with-lock
     playback
     (lambda ()
       (dlna-player-close! (dlna-playback-player playback))))))

(module+ test
  (require rackunit)

  (define first
    (track (build-path "music" "01.flac")
           "First" "Artist" "Album" 60 "audio/flac"))
  (define second
    (track (build-path "music" "02.flac")
           "Second" "Artist" "Album" 60 "audio/flac"))
  (define playback
    (dlna-playback #f (lambda () (list first second)) void void
                   'off 0 #f #f #f #f #f #f 0 #f #t #f #f
                   (make-semaphore 1)))

  (check-equal? (next-index playback 0) 1)
  (check-false (next-index playback 1))
  (set-dlna-playback-repeat! playback 'all)
  (check-equal? (next-index playback 1) 0)
  (set-dlna-playback-repeat! playback 'one)
  (check-equal? (next-index playback 1) 1)

  (set-dlna-playback-prepared-index! playback 1)
  (check-equal?
   (track-index-for-info
    playback
    (dlna-info
     'playing
     (dlna-track-info (track-file second) "Second" "Artist" "Album"
                      #f #f #f 60 #f #f #f)
     "http://renderer.test/02.flac"
     #f #f 1 60 25 #f #t))
   1)
  (check-eq? (normalize-state 'transitioning) 'starting)
  (check-eq? (normalize-state 'no-media) 'stopped)
  (check-true (renderer-confirms-playback? 'playing #f))
  (check-true (renderer-confirms-playback? 'starting 0))
  (check-true (renderer-confirms-playback? 'paused #f))
  (check-true (renderer-confirms-playback? 'unknown 1))
  (check-false (renderer-confirms-playback? 'stopped 0)))