#lang racket/base

(require keystore
         racket/contract
         racket/file
         racket/list
         racket/path
         uuid
         "library.rkt")

(provide (struct-out persisted-tab)
         open-playlist-store
         close-playlist-store!
         load-user-playlists
         save-user-playlists!
         load-user-language
         save-user-language!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Represent one named playlist tab in durable player state.
; pre    : Id is a UUID string, name is non-empty, and tracks contains tracks.
; post   : Constructing or inspecting a value changes no external state.
; result : persisted-tab? recognizes stored and restored playlist tabs.
; internals: track->datum serializes the tracks and datum->tab reconstructs
;            this value after validating its id, name and track collection.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(struct persisted-tab (id name tracks) #:transparent)

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

;;; Keep open tabs and saved library playlists in separate ordered UUID indexes.
(define (user-playlists-key username [saved? #f])
  (format "~aplaylists-for-~a" (if saved? "saved-" "") username))

;;; Produces the keystore key containing one user's language preference.
(define (user-language-key username)
  (format "language-for-~a" username))

(define supported-language-names
  '("en" "nl" "de" "fr" "es" "it" "sv" "no" "fi" "is"))

;;; Serializes a track without exposing the track struct to the keystore.
(define (track->datum item)
  (hasheq 'file (path->string (track-file item))
          'title (track-title item)
          'artist (track-artist item)
          'album (track-album item)
          'duration (or (track-duration item) #f)
          'mime-type (or (track-mime-type item) #f)))

;;; Checks whether a stored optional value is #f or a string.
(define (optional-string? value)
  (or (eq? value #f) (string? value)))

;;; Validates and restores one stored track.
;;; Files outside the configured libraries are deliberately rejected.
(define (datum->track value libraries)
  (if (not (hash? value))
      #f
      (let* ((file (hash-ref value 'file #f))
             (title (hash-ref value 'title #f))
             (artist (hash-ref value 'artist #f))
             (album (hash-ref value 'album #f))
             (duration (hash-ref value 'duration #f))
             (mime-type (hash-ref value 'mime-type #f))
             (valid-duration?
              (or (eq? duration #f)
                  (and (number? duration)
                       (not (negative? duration)))))
             (valid-metadata?
              (and (path-string? file)
                   (string? title)
                   (string? artist)
                   (string? album)
                   valid-duration?
                   (optional-string? mime-type))))
        (if (and valid-metadata?
                 (library-contains-audio-file? libraries file))
            (track (path->complete-path file)
                   title artist album duration mime-type)
            #f))))

;;; Validates and restores one tab while discarding invalid track entries.
(define (datum->tab id value libraries)
  (if (not (and (uuid-string? id) (hash? value)))
      #f
      (let ((name (hash-ref value 'name #f))
            (tracks (hash-ref value 'tracks #f)))
        (if (and (string? name)
                 (not (string=? name ""))
                 (list? tracks))
            (persisted-tab
             id
             name
             (filter-map
              (λ (item) (datum->track item libraries))
              tracks))
            #f))))

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Open the durable store used for playlists and user preferences.
; pre    : File is #f or a writable keystore path.
; post   : The parent directory and keystore exist when file is provided.
; result : An open keystore handle, or #f when persistence is disabled.
; internals: path->complete-path fixes the storage location, ks-open creates or
;            opens the keystore, and later operations use the lock belonging to
;            the returned handle.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (open-playlist-store file)
  (-> (or/c path-string? #f) (or/c keystore? #f))
  (if (eq? file #f)
      #f
      (let ((target (path->complete-path file)))
        (make-parent-directory* target)
        (ks-open target))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Close an open playlist store.
; pre    : Store is #f or was returned by open-playlist-store.
; post   : Its keystore handle is closed; #f remains a harmless no-op.
; result : Void.
; internals: ks-with-lock uses the lock belonging to the keystore handle and
;            prevents ks-close from overlapping a load or save operation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (close-playlist-store! store)
  (-> (or/c keystore? #f) void?)
  (when store
    (ks-with-lock store (λ () (ks-close store))))
  (void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Restore one user's open tabs, or saved library playlists with saved?.
; pre    : Store is #f or open, username is normalized, and libraries are valid.
; post   : Store contents remain unchanged and unsafe track paths are omitted.
; result : Valid persisted-tab values in their saved order.
; internals: ks-with-lock serializes the index and tab reads on the keystore
;            handle. user-playlists-key locates the UUID index; datum->tab then
;            validates each referenced tab and delegates track safety checks to
;            datum->track.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (load-user-playlists store username libraries #:saved? [saved? #f])
  (->* ((or/c keystore? #f) string? (listof music-library?))
       (#:saved? boolean?)
       (listof persisted-tab?))
  (if (eq? store #f)
      '()
      (ks-with-lock
       store
       (λ ()
         (let ((ids (ks-get store (user-playlists-key username saved?) '())))
           (if (list? ids)
               (filter-map
                (λ (id)
                  (datum->tab id (ks-get store id #f) libraries))
                (remove-duplicates (filter uuid-string? ids) string=?))
               '()))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Persist one user's open tabs and saved library playlists atomically.
; pre    : Store is #f or open, username is normalized, and tabs are valid.
; post   : Both UUID indexes match tabs/saved. Closing a saved tab retains its
;          data; playlists absent from both indexes are removed.
; result : Void.
; internals: ks-with-lock prevents another operation from entering this update.
;            ks-transaction removes stale ids from user-playlists-key, stores
;            each distinct playlist using track->datum, and replaces both indexes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (save-user-playlists! store username tabs #:saved [saved '()])
  (->* ((or/c keystore? #f) string? (listof persisted-tab?))
       (#:saved (listof persisted-tab?))
       void?)
  (when store
    (ks-with-lock
     store
     (λ ()
       (let* ((index-key (user-playlists-key username))
              (saved-key (user-playlists-key username #t))
              (old-open (ks-get store index-key '()))
              (old-saved (ks-get store saved-key '()))
              (old-ids (append (if (list? old-open) old-open '())
                               (if (list? old-saved) old-saved '())))
              (ids (map persisted-tab-id tabs))
              (saved-ids (map persisted-tab-id saved))
              (all-tabs (remove-duplicates (append tabs saved)
                                           string=? #:key persisted-tab-id))
              (stale-ids
               (filter
                (λ (id)
                  (and (string? id)
                       (not (member id ids string=?))
                       (not (member id saved-ids string=?))))
                (remove-duplicates old-ids))))
         (ks-transaction
          store
          (for-each (λ (id) (ks-drop! store id)) stale-ids)
          (for-each
           (λ (tab)
             (ks-set!
              store
              (persisted-tab-id tab)
              (hasheq 'name (persisted-tab-name tab)
                      'tracks (map track->datum
                                   (persisted-tab-tracks tab)))))
           all-tabs)
          (ks-set! store index-key ids)
          (ks-set! store saved-key saved-ids))
         (void)))))
  (void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Load one user's persisted interface language.
; pre    : Store is #f or an open playlist store; username is normalized.
; post   : Store contents remain unchanged.
; result : A supported ISO language name, or #f when none was saved.
; internals: user-language-key selects the keystore entry while ks-with-lock
;            holds the handle's lock. Only supported language names return.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (load-user-language store username)
  (-> (or/c keystore? #f) string? (or/c string? #f))
  (if (eq? store #f)
      #f
      (ks-with-lock
       store
       (λ ()
         (let ((value (ks-get store (user-language-key username) #f)))
           (if (member value supported-language-names)
               value
               #f))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Persist one user's interface language.
; pre    : Store is #f or open, username is normalized, and language is one of
;          en, nl, de, fr, es, it, sv, no, fi, or is.
; post   : The user's language key contains language when a store exists.
; result : Void.
; internals: Validation precedes persistence. user-language-key identifies the
;            entry and ks-with-lock serializes the ks-set! call on the handle.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (save-user-language! store username language)
  (-> (or/c keystore? #f) string? string? void?)
  (unless (member language supported-language-names)
    (raise-argument-error
     'save-user-language!
     "one of en, nl, de, fr, es, it, sv, no, fi, or is"
     language))
  (when store
    (ks-with-lock
     store
     (λ ()
       (ks-set! store (user-language-key username) language))))
  (void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests for module playlists.rkt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module+ test
  (require rackunit
           uuid/random)

  (define root
    (make-temporary-file "rkt-playlists-~a" 'directory))
  (define music (build-path root "music"))
  (define music-two (build-path root "music-two"))
  (define outside (build-path root "outside.flac"))
  (define store-file (build-path root "data" "playlists.keystore"))

  (check-false (open-playlist-store #f))
  (check-equal? (load-user-playlists #f "hans" '()) '())
  (check-false (load-user-language #f "hans"))

  (dynamic-wind
    (λ ()
      (make-directory music)
      (make-directory music-two)
      (call-with-output-file (build-path music "one.flac") void)
      (call-with-output-file (build-path music-two "two.flac") void)
      (call-with-output-file outside void))
    (λ ()
      (let* ((libraries (make-music-libraries (list music music-two)))
             (store (open-playlist-store store-file))
             (first-id (uuid-string))
             (second-id (uuid-string))
             (item
              (track (build-path music "one.flac")
                     "One" "Artist" "Album" 60 "audio/flac"))
             (item-two
              (track (build-path music-two "two.flac")
                     "Two" "Artist" "Album" 70 "audio/flac")))
        (dynamic-wind
          void
          (λ ()
            (save-user-playlists!
             store
             "hans"
             (list (persisted-tab first-id "First" (list item item-two))
                   (persisted-tab second-id "Second" '())))
            (save-user-playlists!
             store
             "local"
             (list (persisted-tab (uuid-string) "Local" '())))
            (let ((loaded (load-user-playlists store "hans" libraries)))
              (check-equal? (ks-get store "playlists-for-hans")
                            (list first-id second-id))
              (check-equal? (hash-ref (ks-get store first-id) 'name) "First")
              (check-equal? (map persisted-tab-id loaded)
                            (list first-id second-id))
              (check-equal? (persisted-tab-name (car loaded)) "First")
              (check-equal?
               (map track-title (persisted-tab-tracks (car loaded)))
               '("One" "Two"))
              (check-equal?
               (map persisted-tab-name
                    (load-user-playlists store "local" libraries))
               '("Local"))
              (check-false (load-user-language store "hans"))
              (save-user-language! store "hans" "fr")
              (check-equal? (load-user-language store "hans") "fr")
              (save-user-language! store "hans" "fi")
              (check-equal? (load-user-language store "hans") "fi")
              (check-exn exn:fail:contract?
                         (λ () (save-user-language! store "hans" "da")))

              ;; Rewriting the user's GUID index durably removes the omitted
              ;; playlist instead of leaving it orphaned.
              (save-user-playlists!
               store "hans"
               (list (persisted-tab first-id "First" (list item item-two))))
              (check-equal?
               (map persisted-tab-id
                    (load-user-playlists store "hans" libraries))
               (list first-id))
              (check-false (ks-exists? store second-id))
              (check-equal?
               (map persisted-tab-name
                    (load-user-playlists store "local" libraries))
               '("Local"))

              ;; A playlist may not restore tracks outside configured libraries.
              (let ((unsafe-id (uuid-string)))
                (ks-set!
                 store
                 unsafe-id
                 (hasheq
                  'name "Unsafe"
                  'tracks
                  (list (hasheq 'file (path->string outside)
                                'title "Outside" 'artist "" 'album ""
                                'duration #f 'mime-type "audio/flac"))))
                (ks-set! store
                         (user-playlists-key "unsafe")
                         (list unsafe-id))
                (check-equal?
                 (persisted-tab-tracks
                  (car (load-user-playlists store "unsafe" libraries)))
                 '()))))
          (λ () (close-playlist-store! store)))))
    (λ () (delete-directory/files root))))