146 lines
4.3 KiB
Racket
146 lines
4.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class)
|
|
|
|
(provide libraries%
|
|
library%
|
|
)
|
|
|
|
(define (new-id)
|
|
(string->symbol
|
|
(format "id-~a-~a" (current-milliseconds) (random 1000000))))
|
|
|
|
(define library%
|
|
(class object%
|
|
(init-field [id (new-id)] [name ""] [local-path ""]
|
|
[host ""] [prefixes ""] [current #f])
|
|
(super-new)
|
|
|
|
(define/public (get-id) id)
|
|
(define/public (get-name) name)
|
|
(define/public (get-local-path) local-path)
|
|
(define/public (get-host) host)
|
|
(define/public (get-prefixes) prefixes)
|
|
(define/public (is-current?) current)
|
|
(define/public (get-current) current)
|
|
(define/public (set-current! c) (set! current c))
|
|
(define/public (->list)
|
|
(list id name local-path host prefixes current))
|
|
))
|
|
|
|
(define libraries%
|
|
(class object%
|
|
(init-field [settings settings])
|
|
(super-new)
|
|
|
|
(define libs #f)
|
|
|
|
(define cfg (send settings clone 'settings))
|
|
|
|
(define (to-library e)
|
|
(let ((f (lambda (id n lp h p . c)
|
|
(let ((cc (if (null? c) #f (car c))))
|
|
(new library% [id id]
|
|
[name n] [local-path lp]
|
|
[host h] [prefixes p] [current cc])
|
|
))))
|
|
(apply f e)
|
|
)
|
|
)
|
|
|
|
(define (from-library l)
|
|
(send l ->list))
|
|
|
|
(define/public (libraries)
|
|
(when (eq? libs #f)
|
|
(set! libs (sort (map to-library (send cfg get 'libraries '()))
|
|
(lambda (a b)
|
|
(string<? (send a get-name) (send b get-name))))))
|
|
libs)
|
|
|
|
(define/public (set-libraries! libs*)
|
|
(send cfg set! 'libraries (map from-library libs*))
|
|
(set! libs #f))
|
|
|
|
(define/public (count)
|
|
(length (send this libraries)))
|
|
|
|
(define/public (library-id idx)
|
|
(let ((libs (send this libraries)))
|
|
(if (and (>= idx 0) (< idx (length libs)))
|
|
(send (list-ref libs idx) get-id)
|
|
#f)))
|
|
|
|
(define/public (get-library id)
|
|
(let ((libs (send this libraries)))
|
|
(for/or ([lib libs])
|
|
(when (eq? (send lib get-id) id)
|
|
lib))))
|
|
|
|
(define/public (remove-library id)
|
|
(let ((libs (send this libraries)))
|
|
(send this set-libraries! (filter (λ (lib)
|
|
(not (eq? (send lib get-id) id)))
|
|
libs))))
|
|
|
|
(define/public (add-library l)
|
|
(let ((libs (send this libraries)))
|
|
(send this set-libraries!
|
|
(cons l libs))
|
|
(set! libs #f)
|
|
(send l get-id)))
|
|
|
|
(define/public (update-library l)
|
|
(let ((libs (send this libraries))
|
|
(id (send l get-id)))
|
|
(send this set-libraries! (map (λ (lib)
|
|
(if (eq? (send lib get-id) id)
|
|
l
|
|
lib))
|
|
libs))))
|
|
|
|
(define/public (current-library)
|
|
(letrec ((f (lambda (libs)
|
|
(if (null? libs)
|
|
(if (= (send this count) 0)
|
|
#f (send this get-library
|
|
(send this library-id 0)))
|
|
(let ((l (car libs)))
|
|
(if (send l is-current?)
|
|
l
|
|
(f (cdr libs))))))
|
|
))
|
|
(f (send this libraries))))
|
|
|
|
))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define settings%
|
|
(class object%
|
|
(super-new)
|
|
(define values (make-hasheq))
|
|
(define/public (clone section) this)
|
|
(define/public (get key default)
|
|
(hash-ref values key default))
|
|
(define/public (set! key value)
|
|
(hash-set! values key value))))
|
|
|
|
(define settings (new settings%))
|
|
(define libraries (new libraries% [settings settings]))
|
|
(define library
|
|
(new library%
|
|
[id 'test-library]
|
|
[name "Test library"]
|
|
[local-path "/music"]
|
|
[host ""]
|
|
[prefixes "/music"]))
|
|
|
|
(check-eq? (send libraries add-library library) 'test-library)
|
|
(check-equal? (send settings get 'libraries #f)
|
|
'((test-library "Test library" "/music" "" "/music" #f)))
|
|
(check-equal? (send libraries count) 1)
|
|
(check-eq? (send libraries get-library 'test-library)
|
|
(car (send libraries libraries))))
|