hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ok

Browse Source
This commit is contained in:
Hans Dijkema
2026-09-08 15:20:27 +02:00
parent 4b9e6c5651
commit 2eb9a9590e
15 changed files with 1023 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/playlists.rkt
+31 -20
View File
@@ -30,9 +30,9 @@
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Produces the keystore key containing one user's ordered playlist ids.
(define (user-playlists-key username)
(format "playlists-for-~a" username))
;;; 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)
@@ -135,7 +135,7 @@
(void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Restore one user's ordered playlist tabs.
; 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.
@@ -144,17 +144,16 @@
; validates each referenced tab and delegates track safety checks to
; datum->track.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (load-user-playlists store username libraries)
(-> (or/c keystore? #f)
string?
(listof music-library?)
(listof persisted-tab?))
(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) '())))
(let ((ids (ks-get store (user-playlists-key username saved?) '())))
(if (list? ids)
(filter-map
(λ (id)
@@ -163,29 +162,40 @@
'()))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Persist one user's complete ordered collection of playlist tabs.
; 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 : The UUID index and tab data match tabs; omitted old tabs are removed.
; 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
; every tab using track->datum, and atomically replaces the index.
; each distinct playlist using track->datum, and replaces both indexes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (save-user-playlists! store username tabs)
(-> (or/c keystore? #f) string? (listof persisted-tab?) void?)
(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))
(old-ids (ks-get store index-key '()))
(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=?))))
(if (list? old-ids) old-ids '()))))
(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)
@@ -197,8 +207,9 @@
(hasheq 'name (persisted-tab-name tab)
'tracks (map track->datum
(persisted-tab-tracks tab)))))
tabs)
(ks-set! store index-key ids))
all-tabs)
(ks-set! store index-key ids)
(ks-set! store saved-key saved-ids))
(void)))))
(void))