Files
rktplayer/library/track-store.rkt
T

176 lines
4.7 KiB
Racket

#lang racket/base
(require racket/class
racket/match
"library-factory.rkt"
"library-ref.rkt"
"base/track.rkt"
"../misc/utils.rkt")
(provide track-store?
track-store-id
track-store-number
track-store-title
track->store
store->track)
(define track-store-version
1)
(define (track-store? stored)
(match stored
((list 'track
(== track-store-version)
_
number
title
library-reference
track-factory-id
_)
(and (exact-integer? number)
(string? title)
(library-ref? library-reference)
(symbol? track-factory-id)))
(else #f)))
(define (track-store-id stored)
(check/c track-store-id stored track-store?)
(list-ref stored 2))
(define (track-store-number stored)
(check/c track-store-number stored track-store?)
(list-ref stored 3))
(define (track-store-title stored)
(check/c track-store-title stored track-store?)
(list-ref stored 4))
(define (track->store track)
(check/c track->store track (is-a?/c track<%>))
(let ((stored
(list 'track
track-store-version
(send track get-id)
(send track get-number)
(send track get-title)
(send track get-music-library-factory-id)
(send track get-track-factory-id)
(send track get-track-relive-info))))
(check/c track->store stored track-store?)
stored))
(define (store->track stored factory)
(check/c store->track
factory
(is-a?/c library-factory%))
(and
(track-store? stored)
(with-handlers ((exn:fail?
(lambda (_)
#f)))
(let* ((library-reference (list-ref stored 5))
(library
(send factory
get-library
(library-ref-library-id library-reference)
(library-ref-kind library-reference)
(library-ref-version library-reference)))
(root-container
(send library get-root-container))
(track-reliver
(send root-container get-track-reliver))
(track
(track-reliver
(list-ref stored 6)
(list-ref stored 7))))
(and (object? track)
(is-a? track track<%>)
track)))))
(module+ test
(require rackunit
racket/file
"libraries-config.rkt"
"library-filesystem.rkt"
"library-item.rkt")
(define settings%
(class object%
(define values
(make-hash))
(define/public (clone _)
this)
(define/public (get key default)
(hash-ref values key default))
(define/public (set! key value)
(hash-set! values key value))
(super-new)))
(define root
(make-temporary-file
"rktplayer-track-store-~a"
'directory))
(define file-name
"track.mp3")
(define file
(build-path root file-name))
(dynamic-wind
(lambda ()
(call-with-output-file file void))
(lambda ()
(let* ((libraries-config
(new libraries-config%
[settings (new settings%)]))
(factory
(new library-factory%
[libraries-config libraries-config])))
(send libraries-config
add-library
(library-item
'test-library
"Test library"
'filesystem
1
root
#f
100
#t))
(register-library-filesystem! factory)
(let* ((library
(send factory
get-library
'test-library
'filesystem
1))
(track
(send library
make-track
(list (string->path file-name))))
(stored (track->store track))
(relived (store->track stored factory)))
(check-true (track-store? stored))
(check-equal? (track-store-id stored)
(send track get-id))
(check-equal? (track-store-number stored)
(send track get-number))
(check-equal? (track-store-title stored)
(send track get-title))
(check-true (is-a? relived track<%>))
(check-equal?
(normal-case-path
(send (send relived get-resource)
get-file))
(normal-case-path file)))))
(lambda ()
(delete-directory/files root))))