150 lines
4.3 KiB
Racket
150 lines
4.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
"library-cfg.rkt"
|
|
"library-item.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide libraries-config%
|
|
(all-from-out "library-cfg.rkt")
|
|
(all-from-out "library-item.rkt"))
|
|
|
|
(define libraries-config%
|
|
(class object%
|
|
(init-field settings)
|
|
|
|
(define items
|
|
#f)
|
|
|
|
(define revisions
|
|
(make-hash))
|
|
|
|
(define cfg
|
|
(send settings clone 'settings))
|
|
|
|
(define/private (sorted-items value)
|
|
(sort value
|
|
(lambda (a b)
|
|
(string<? (library-item-name a)
|
|
(library-item-name b)))))
|
|
|
|
(define/private (get-items)
|
|
(when (eq? items #f)
|
|
(let ((stored (send cfg get 'libraries '())))
|
|
(dbg-rktplayer "libraries from ini: ~a" stored)
|
|
(set! items
|
|
(sorted-items
|
|
(map store->library-item stored)))))
|
|
items)
|
|
|
|
(define/private (store-items! value)
|
|
(let ((new-items (sorted-items value)))
|
|
(send cfg
|
|
set!
|
|
'libraries
|
|
(map library-item->store new-items))
|
|
(set! items new-items)))
|
|
|
|
(define/private (increment-revision! id)
|
|
(hash-update! revisions id add1 0))
|
|
|
|
(define/public (libraries)
|
|
(map (lambda (item)
|
|
(new library-cfg%
|
|
[library-cfg-id (library-item-id item)]
|
|
[libraries-config this]))
|
|
(get-items)))
|
|
|
|
(define/public (count)
|
|
(length (get-items)))
|
|
|
|
(define/public (library-id idx)
|
|
(let ((all-items (get-items)))
|
|
(if (and (>= idx 0)
|
|
(< idx (length all-items)))
|
|
(library-item-id (list-ref all-items idx))
|
|
#f)))
|
|
|
|
(define/public (get-item id)
|
|
(check/c libraries-config% get-item id symbol?)
|
|
(findf (lambda (item)
|
|
(eq? (library-item-id item) id))
|
|
(get-items)))
|
|
|
|
(define/public (get-item-revision id)
|
|
(check/c libraries-config% get-item-revision id symbol?)
|
|
(hash-ref revisions id 0))
|
|
|
|
(define/public (get-library id)
|
|
(check/c libraries-config% get-library id symbol?)
|
|
(and (send this get-item id)
|
|
(new library-cfg%
|
|
[library-cfg-id id]
|
|
[libraries-config this])))
|
|
|
|
(define/public (remove-library id)
|
|
(check/c libraries-config% remove-library id symbol?)
|
|
(store-items!
|
|
(filter (lambda (item)
|
|
(not (eq? (library-item-id item) id)))
|
|
(get-items)))
|
|
(increment-revision! id))
|
|
|
|
(define/public (add-library item)
|
|
(check/c libraries-config% add-library item library-item?)
|
|
|
|
(let ((id (library-item-id item)))
|
|
(when (send this get-item id)
|
|
(raise-arguments-error
|
|
'libraries-config%:add-library
|
|
"a library with this id already exists"
|
|
"id" id))
|
|
|
|
(store-items! (cons item (get-items)))
|
|
(increment-revision! id)
|
|
id))
|
|
|
|
(define/public (update-item! item)
|
|
(check/c libraries-config% update-item! item library-item?)
|
|
|
|
(let* ((id (library-item-id item))
|
|
(current-item (send this get-item id)))
|
|
(unless current-item
|
|
(raise-arguments-error
|
|
'libraries-config%:update-item!
|
|
"library does not exist"
|
|
"id" id))
|
|
|
|
(unless (and (eq? (library-item-kind current-item)
|
|
(library-item-kind item))
|
|
(= (library-item-kind-version current-item)
|
|
(library-item-kind-version item)))
|
|
(raise-arguments-error
|
|
'libraries-config%:update-item!
|
|
"library kind and kind-version cannot be changed"
|
|
"id" id))
|
|
|
|
(store-items!
|
|
(map (lambda (existing)
|
|
(if (eq? (library-item-id existing) id)
|
|
item
|
|
existing))
|
|
(get-items)))
|
|
(increment-revision! id)
|
|
(void)))
|
|
|
|
(define/public (current-library)
|
|
(let ((item
|
|
(findf library-item-current
|
|
(get-items))))
|
|
(if item
|
|
(send this get-library
|
|
(library-item-id item))
|
|
(if (null? (get-items))
|
|
#f
|
|
(send this get-library
|
|
(library-item-id
|
|
(car (get-items))))))))
|
|
|
|
(super-new)))
|