#lang racket/base

(require keystore
         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!)

(struct persisted-tab (id name tracks) #:transparent)
(struct playlist-store (keystore lock) #:transparent)

(define (user-playlists-key username)
  (format "playlists-for-~a" username))

(define (user-language-key username)
  (format "language-for-~a" username))

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

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

(define (optional-string? value)
  (or (not value) (string? value)))

(define (datum->track value libraries)
  (and (hash? value)
       (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)))
         (and (path-string? file)
              (string? title)
              (string? artist)
              (string? album)
              (or (not duration)
                  (and (number? duration) (not (negative? duration))))
              (optional-string? mime-type)
              (library-contains-audio-file? libraries file)
              (track (path->complete-path file)
                     title artist album duration mime-type)))))

(define (datum->tab id value libraries)
  (and (uuid-string? id)
       (hash? value)
       (let ((name (hash-ref value 'name #f))
             (tracks (hash-ref value 'tracks #f)))
         (and (string? name)
              (not (string=? name ""))
              (list? tracks)
              (persisted-tab
               id
               name
               (filter-map
                (lambda (item) (datum->track item libraries))
                tracks))))))

(define (open-playlist-store file)
  (and file
       (let ((target (path->complete-path file)))
         (make-parent-directory* target)
         (playlist-store (ks-open target) (make-semaphore 1)))))

(define (close-playlist-store! store)
  (when store
    (call-with-semaphore
     (playlist-store-lock store)
     (lambda () (ks-close (playlist-store-keystore store)))))
  (void))

(define (load-user-playlists store username libraries)
  (if (not store)
      '()
      (call-with-semaphore
       (playlist-store-lock store)
       (lambda ()
         (define ks (playlist-store-keystore store))
         (define ids (ks-get ks (user-playlists-key username) '()))
         (if (list? ids)
             (filter-map
              (lambda (id)
                (datum->tab id (ks-get ks id #f) libraries))
              (remove-duplicates (filter uuid-string? ids) string=?))
             '())))))

(define (save-user-playlists! store username tabs)
  (when store
    (call-with-semaphore
     (playlist-store-lock store)
     (lambda ()
       (define ks (playlist-store-keystore store))
       (define index-key (user-playlists-key username))
       (define old-ids (ks-get ks index-key '()))
       (define ids (map persisted-tab-id tabs))
       (ks-transaction
        ks
        (for ((id (in-list (if (list? old-ids) old-ids '())))
              #:when (and (string? id) (not (member id ids string=?))))
          (ks-drop! ks id))
        (for ((tab (in-list tabs)))
          (ks-set!
           ks
           (persisted-tab-id tab)
           (hasheq 'name (persisted-tab-name tab)
                   'tracks (map track->datum
                                (persisted-tab-tracks tab)))))
        (ks-set! ks index-key ids))
       (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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (load-user-language store username)
  (and store
       (call-with-semaphore
        (playlist-store-lock store)
        (λ ()
          (define value
            (ks-get (playlist-store-keystore store)
                    (user-language-key username)
                    #f))
          (and (member value supported-language-names) value)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (save-user-language! store username language)
  (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
    (call-with-semaphore
     (playlist-store-lock store)
     (λ ()
       (ks-set! (playlist-store-keystore store)
                (user-language-key username)
                language))))
  (void))

(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"))
  (dynamic-wind
    (lambda ()
      (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))
    (lambda ()
      (define libraries (make-music-libraries (list music music-two)))
      (define store (open-playlist-store store-file))
      (define first-id (uuid-string))
      (define second-id (uuid-string))
      (define item
        (track (build-path music "one.flac")
               "One" "Artist" "Album" 60 "audio/flac"))
      (define item-two
        (track (build-path music-two "two.flac")
               "Two" "Artist" "Album" 70 "audio/flac"))
      (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" '())))

      (define loaded (load-user-playlists store "hans" libraries))
      (define ks (playlist-store-keystore store))
      (check-equal? (ks-get ks "playlists-for-hans")
                    (list first-id second-id))
      (check-equal? (hash-ref (ks-get ks 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" "it")))

      ;; Rewriting the user's GUID index durably removes the omitted playlist.
      (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? ks second-id))
      ;; An omitted GUID is deleted rather than becoming orphaned.
      (check-equal?
       (map persisted-tab-name (load-user-playlists store "local" libraries))
       '("Local"))

      ;; A playlist entry may not restore tracks outside configured libraries.
      (define unsafe-id (uuid-string))
      (ks-set!
       (playlist-store-keystore 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! (playlist-store-keystore store)
               (user-playlists-key "unsafe")
               (list unsafe-id))
      (check-equal?
       (persisted-tab-tracks
        (car (load-user-playlists store "unsafe" libraries)))
       '())
      (close-playlist-store! store))
    (lambda () (delete-directory/files root))))