#lang racket/base

(require racket-audio
         racket/file
         racket/list
         racket-mimetypes
         racket/path
         racket/string)

(provide (struct-out music-library)
         (struct-out browser-entry)
         (struct-out track)
         make-music-libraries
         browse-library
         browser-entry->tracks)

(struct music-library
  (id name root)
  #:transparent)

(struct browser-entry
  (name kind relative-path)
  #:transparent)

(struct track
  (file title artist album duration mime-type)
  #:transparent)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define supported-extensions
  (audio-supported-extensions))

(define (audio-file? file)
  (let ((extension (path-get-extension file)))
    (and extension
         (member (string-downcase
                  (string-trim
                   (bytes->string/utf-8 extension)
                   "."))
                 supported-extensions)
         #t)))

(define (hidden-name? path)
  (string-prefix? (path->string path) "."))

(define (file-title file)
  (let* ((name (file-name-from-path file))
         (without-extension
          (if name
              (path-replace-extension name #"")
              file)))
    (path->string without-extension)))

(define (nonempty value fallback)
  (if (and (string? value)
           (not (string=? (string-trim value) "")))
      value
      fallback))

(define (path->track file)
  (let ((fallback-title (file-title file)))
    (with-handlers
        ((exn:fail?
          (λ (_)
            (track file fallback-title "" "" #f
                   (mimetype-for-ext file)))))
      (call-with-id3-tags
       file
       (λ (tags)
         (if (tags-valid? tags)
             (track file
                    (nonempty (tags-title tags) fallback-title)
                    (nonempty (tags-artist tags) "")
                    (nonempty (tags-album tags) "")
                    (let ((length (tags-length tags)))
                      (if (and (number? length) (positive? length))
                          length
                          #f))
                    (mimetype-for-ext file))
             (track file fallback-title "" "" #f
                    (mimetype-for-ext file))))))))

(define (library-path library relative-path)
  (if (null? relative-path)
      (music-library-root library)
      (apply build-path
             (music-library-root library)
             relative-path)))

(define (path-kind path)
  (cond
    ((directory-exists? path) 'container)
    ((and (file-exists? path)
          (audio-file? path))
     'track)
    (else #f)))

(define (entry<? first second)
  (cond
    ((and (eq? (browser-entry-kind first) 'container)
          (eq? (browser-entry-kind second) 'track))
     #t)
    ((and (eq? (browser-entry-kind first) 'track)
          (eq? (browser-entry-kind second) 'container))
     #f)
    (else
     (string-ci<? (browser-entry-name first)
                  (browser-entry-name second)))))

(define (directory-tracks library relative-path)
  (append-map
   (λ (entry)
     (if (eq? (browser-entry-kind entry) 'container)
         (directory-tracks library
                           (browser-entry-relative-path entry))
         (list
          (path->track
           (library-path library
                         (browser-entry-relative-path entry))))))
   (browse-library library relative-path)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Turn configured directory paths into music libraries.
; pre    : Every value is a path-string naming an existing directory.
; post   : No directory contents or audio metadata have been read.
; result : Libraries in configuration order, without duplicate roots.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-music-libraries paths)
  (let ((roots
         (remove-duplicates
          (map (λ (path)
                 (normal-case-path
                  (path->complete-path path)))
               paths)
          equal?)))
    (for/list ((root (in-list roots))
               (index (in-naturals)))
      (unless (directory-exists? root)
        (raise-arguments-error
         'make-music-libraries
         "music library is not an existing directory"
         "path" root))
      (let ((name (file-name-from-path root)))
        (music-library
         (format "library-~a" index)
         (if name
             (path->string name)
             (path->string root))
         root)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : List the immediate folders and supported audio files in a library.
; pre    : Relative-path was produced by a previous browse result.
; post   : Child directories are listed before tracks; metadata is not read.
; result : Browser entries for one directory level.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (browse-library library relative-path)
  (let ((path (library-path library relative-path)))
    (unless (directory-exists? path)
      (raise-arguments-error
       'browse-library
       "library directory does not exist"
       "path" path))
    (sort
     (filter-map
      (λ (name)
        (let* ((full-path (build-path path name))
               (kind (path-kind full-path)))
          (and kind
               (not (and (eq? kind 'container)
                         (hidden-name? name)))
               (browser-entry
                (path->string name)
                kind
                (append relative-path (list name))))))
      (directory-list path))
     entry<?)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Resolve a selected browser entry to playable tracks.
; pre    : Entry belongs to library and was produced by browse-library.
; post   : Track metadata is read; containers are traversed recursively.
; result : One track, or all supported tracks below the selected container.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (browser-entry->tracks library entry)
  (if (eq? (browser-entry-kind entry) 'container)
      (directory-tracks library
                        (browser-entry-relative-path entry))
      (list
       (path->track
        (library-path library
                      (browser-entry-relative-path entry))))))

(module+ test
  (require rackunit)

  (define root
    (make-temporary-file "rkt-web-library-~a" 'directory))

  (dynamic-wind
    void
    (λ ()
      (make-directory (build-path root "Album"))
      (call-with-output-file (build-path root "track.mp3") void)
      (call-with-output-file (build-path root "cover.jpg") void)
      (let* ((libraries (make-music-libraries (list root)))
             (entries (browse-library (car libraries) '())))
        (check-equal? (length libraries) 1)
        (check-equal? (length entries) 2)
        (check-equal? (browser-entry-name (car entries)) "Album")
        (check-eq? (browser-entry-kind (car entries)) 'container)
        (check-equal? (browser-entry-name (cadr entries)) "track.mp3")
        (check-eq? (browser-entry-kind (cadr entries)) 'track)))
    (λ ()
      (delete-directory/files root))))