#lang racket/base

(require net/url
         racket/async-channel
         racket/class
         racket/file
         racket/path
         racket/string
         "../library/base/media-resource.rkt"
         "../misc/utils.rkt")

(provide playlist-cache%
         playlist-cache-root
         clear-playlist-cache!)

(define (playlist-cache-root)
  (build-path (find-system-path 'cache-dir)
              "rktplayer"))

(define (safe-name value)
  (regexp-replace* #px"[<>:\"/\\\\|?*]"
                   (format "~a" value)
                   "_"))

(define (resource-extension resource)
  (let* ((uri (send resource get-uri))
         (without-query
          (regexp-replace #px"[?#].*$" uri ""))
         (uri-extension
          (regexp-match #px"(?i:[.]([a-z0-9]{1,8})$)"
                        without-query))
         (mime-type (send resource get-mime-type)))
    (cond
      (uri-extension
       (string-append "."
                      (string-downcase
                       (cadr uri-extension))))
      ((member mime-type
               '("audio/flac"
                 "audio/x-flac"
                 "application/flac")) ".flac")
      ((or (equal? mime-type "audio/mpeg")
           (equal? mime-type "audio/mp3")) ".mp3")
      ((or (equal? mime-type "audio/opus")
           (equal? mime-type "audio/ogg")) ".opus")
      ((member mime-type
               '("audio/wav"
                 "audio/wave"
                 "audio/x-wav")) ".wav")
      ((member mime-type
               '("audio/mp4"
                 "audio/x-m4a")) ".m4a")
      ((equal? mime-type "audio/aac") ".aac")
      ((equal? mime-type "audio/x-ms-wma") ".wma")
      (else ".audio"))))

(define (content-length headers)
  (for/or ((header (in-list headers)))
    (let ((matched
           (regexp-match
            #px#"(?i:^content-length:[ \t]*([0-9]+)[ \t]*$)"
            header)))
      (and matched
           (string->number
            (bytes->string/utf-8
             (cadr matched)))))))

(define (successful-status? status)
  (regexp-match? #px#"^HTTP/[0-9.]+ 2[0-9][0-9]" status))

(define (clear-playlist-cache! [playlist-id #f])
  (let ((target
         (if playlist-id
             (build-path (playlist-cache-root)
                         (safe-name playlist-id))
             (playlist-cache-root))))
    (when (directory-exists? target)
      (with-handlers ([exn:fail? (lambda (e) (void))])
        (delete-directory/files target)))))

(define playlist-cache%
  (class object%
    (init-field
     playlist-id
     [updated (lambda (entry downloaded total) (void))])

    (define directory
      (build-path (playlist-cache-root)
                  (safe-name playlist-id)))

    (define queue
      (make-async-channel))

    (define generations
      (make-hash))

    (define stopped?
      #f)

    (define worker-custodian
      (make-custodian))

    (define/private (entry-generation entry)
      (hash-ref generations
                (send entry get-id)
                0))

    (define/private (next-generation! entry)
      (hash-update! generations
                    (send entry get-id)
                    add1
                    0)
      (entry-generation entry))

    (define/private (cache-file entry)
      (let ((resource
             (send (send entry get-track)
                   get-resource)))
        (build-path directory
                    (string-append
                     (safe-name (send entry get-id))
                     (resource-extension resource)))))

    (define/private (notify! entry downloaded total)
      (with-handlers
          ((exn:fail?
            (lambda (exception)
              (warn-rktplayer
               "Cache status callback failed: ~a"
               (exn-message exception)))))
        (updated entry downloaded total)))

    (define/private (copy-download!
                     input temporary entry total)
      (let ((downloaded 0)
            (last-reported 0)
            (buffer (make-bytes 65536)))
        (dynamic-wind
          void
          (lambda ()
            (call-with-output-file
             temporary
             (lambda (output)
               (let loop ()
                 (let ((count
                        (read-bytes-avail!* buffer input)))
                   (unless (eof-object? count)
                     (write-bytes buffer output 0 count)
                     (set! downloaded (+ downloaded count))
                     (when (>= (- downloaded last-reported)
                               1048576)
                       (set! last-reported downloaded)
                       (notify! entry downloaded total))
                     (loop)))))
             #:exists 'replace
             #:mode 'binary))
          (lambda ()
            (close-input-port input)))
        downloaded))

    (define/private (finish-download!
                     entry generation target temporary
                     downloaded total)
      (if (and (not stopped?)
               (= generation
                  (entry-generation entry)))
          (begin
            (when (file-exists? target)
              (delete-file target))
            (rename-file-or-directory temporary target)
            (send entry set-cache-file! target)
            (notify! entry downloaded total))
          (when (file-exists? temporary)
            (delete-file temporary))))

    (define/private (download! entry generation)
      (let* ((resource
              (send (send entry get-track)
                    get-resource))
             (uri (send resource get-uri))
             (target (cache-file entry))
             (temporary
              (string->path
               (string-append (path->string target)
                              ".part"))))
        (let ((finished? #f))
          (dynamic-wind
            void
            (lambda ()
              (make-directory* directory)
              (let-values
                  (((status headers input)
                    (http-sendrecv/url
                     (string->url uri)
                     #:headers
                     (list "Connection: close"))))
                (unless (successful-status? status)
                  (close-input-port input)
                  (error 'playlist-cache%
                         "download failed for ~a: ~a"
                         uri
                         status))
                (let* ((total (content-length headers))
                       (downloaded
                        (copy-download!
                         input temporary entry total)))
                  (finish-download!
                   entry generation target temporary
                   downloaded total)
                  (set! finished? #t))))
            (lambda ()
              (when (and (not finished?)
                         (file-exists? temporary))
                (delete-file temporary)))))))

    (define worker
      (parameterize
          ((current-custodian worker-custodian))
        (thread
         (lambda ()
           (let loop ()
             (let ((request (async-channel-get queue)))
               (unless (eq? request 'stop)
                 (let ((entry (car request))
                       (generation (cadr request)))
                   (with-handlers
                       ((exn:fail?
                         (lambda (exception)
                           (when (= generation
                                    (entry-generation entry))
                             (send entry
                                   set-cache-failed!
                                   (exn-message exception))
                             (notify! entry 0 #f)))))
                     (download! entry generation))
                   (loop)))))))))

    (define/public (ensure-entry! entry)
      (let ((track (send entry get-track)))
        (when track
          (let* ((resource (send track get-resource))
                 (file (send resource get-file)))
            (cond
              (file
               (send entry set-cache-file! file))
              ((regexp-match? #px"(?i:^https?://)"
                              (send resource get-uri))
               (let ((target (cache-file entry)))
                 (if (file-exists? target)
                     (send entry set-cache-file! target)
                     (let ((generation
                            (next-generation! entry)))
                       (send entry set-cache-downloading!)
                       (notify! entry 0 #f)
                       (async-channel-put
                        queue
                        (list entry generation)))))))))))

    (define/public (drop-entry! entry)
      (next-generation! entry)
      (let ((file (send entry get-cache-file)))
        (when (and file
                   (path? file)
                   (file-exists? file)
                   (equal? (simplify-path directory)
                           (simplify-path
                            (path-only file))))
          (delete-file file))))

    (define/public (clear!)
      (when (directory-exists? directory)
        (delete-directory/files directory)))

    (define/public (stop!)
      (unless stopped?
        (set! stopped? #t)
        (custodian-shutdown-all
         worker-custodian)))

    (super-new)))