#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)
         (struct-out artwork)
         make-music-libraries
         browse-library
         browser-entry->tracks
         track-artwork)

(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)

(struct artwork
  (mime-type data)
  #:transparent)

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

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

(define cover-file-names
  '("cover.jpg" "cover.jpeg" "cover.png"
    "folder.jpg" "folder.jpeg" "folder.png"
    "front.jpg" "front.jpeg" "front.png"))

(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 or a (display-name path) list.
; post   : No directory contents or audio metadata have been read.
; result : Libraries in configuration order, without duplicate roots.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-music-libraries specifications)
  (define (specification-values specification)
    (if (and (list? specification)
             (= (length specification) 2)
             (string? (car specification))
             (path-string? (cadr specification)))
        (values (string-trim (car specification))
                (cadr specification))
        (if (path-string? specification)
            (values #f specification)
            (raise-argument-error
             'make-music-libraries
             "(or/c path-string? (list/c string? path-string?))"
             specification))))
  (let ((roots
         (remove-duplicates
          (for/list ((specification (in-list specifications)))
            (let-values (((name path)
                          (specification-values specification)))
              (list name
                    (normal-case-path
                     (path->complete-path path)))))
          (lambda (first second)
            (equal? (cadr first) (cadr second))))))
    (for/list ((named-root (in-list roots))
               (index (in-naturals)))
      (define configured-name (car named-root))
      (define root (cadr named-root))
      (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 (and configured-name
                  (not (string=? configured-name "")))
             configured-name
             (if name
                 (path->string name)
                 (path->string root)))
         root)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read the artwork associated with a track.
; pre    : Item names a local audio file.
; post   : The audio file and optional neighbouring image remain unchanged.
; result : Embedded artwork, a conventional folder cover, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (track-artwork item)
  (define embedded
    (with-handlers ((exn:fail? (λ (_) #f)))
      (call-with-id3-tags
       (track-file item)
       (λ (tags)
         (let ((picture (and (tags-valid? tags)
                             (tags-picture tags))))
           (and picture
                (artwork (let ((mime (id3-picture-mimetype picture)))
                           (if (and (string? mime)
                                    (not (string=? mime "")))
                               mime
                               "application/octet-stream"))
                         (id3-picture-bytes picture))))))))
  (or embedded
      (with-handlers ((exn:fail? (λ (_) #f)))
        (let* ((directory (or (path-only (track-file item))
                              (current-directory)))
               (cover
                (findf
                 (λ (candidate)
                   (let ((name (file-name-from-path candidate)))
                     (and name
                          (file-exists? candidate)
                          (member (path->string name)
                                  cover-file-names
                                  string-ci=?))))
                 (directory-list directory #:build? #t))))
          (and cover
               (let ((mime (mimetype-for-ext cover)))
                 (artwork (if (string? mime)
                              mime
                              "application/octet-stream")
                          (file->bytes cover))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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)
        (check-equal?
         (music-library-name
          (car (make-music-libraries
                (list (list "Luisterkamer" root)))))
         "Luisterkamer")
        (check-equal?
         (artwork-mime-type
          (track-artwork
           (track (build-path root "track.mp3")
                  "Track" "" "" #f "audio/mpeg")))
         "image/jpeg")))
    (λ ()
      (delete-directory/files root))))