257 lines
9.1 KiB
Racket
257 lines
9.1 KiB
Racket
#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" "da")))
|
|
|
|
;; 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))))
|