109 lines
3.1 KiB
Racket
109 lines
3.1 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
"libraries-config.rkt"
|
|
"base/media-library.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide library-factory%
|
|
get-library-factory
|
|
set-library-factory!)
|
|
|
|
(define current-library-factory
|
|
#f)
|
|
|
|
(define (get-library-factory)
|
|
(unless current-library-factory
|
|
(raise-arguments-error
|
|
'get-library-factory
|
|
"no library factory has been configured"))
|
|
current-library-factory)
|
|
|
|
(define (set-library-factory! factory)
|
|
(check/c set-library-factory!
|
|
factory
|
|
(is-a?/c library-factory%))
|
|
(set! current-library-factory factory)
|
|
(void))
|
|
|
|
(define library-factory%
|
|
(class object%
|
|
(init-field libraries-config)
|
|
|
|
(check/c library-factory%
|
|
libraries-config
|
|
(is-a?/c libraries-config%))
|
|
|
|
(define makers
|
|
(make-hash))
|
|
|
|
(define libraries
|
|
(make-hash))
|
|
|
|
(define/public (get-libraries-config)
|
|
libraries-config)
|
|
|
|
(define/public (register-library-maker! kind version maker)
|
|
(check/c* (library-factory% register-library-maker!)
|
|
(kind symbol?)
|
|
(version exact-positive-integer?)
|
|
(maker (-> (is-a?/c library-cfg%) any/c)))
|
|
|
|
(let ((maker-key (cons kind version)))
|
|
(when (hash-has-key? makers maker-key)
|
|
(raise-arguments-error
|
|
'library-factory%:register-library-maker!
|
|
"a library maker is already registered"
|
|
"kind" kind
|
|
"version" version))
|
|
|
|
(hash-set! makers maker-key maker)
|
|
(void)))
|
|
|
|
(define/public (get-library library-id kind version)
|
|
(check/c* (library-factory% get-library)
|
|
(library-id symbol?)
|
|
(kind symbol?)
|
|
(version exact-positive-integer?))
|
|
|
|
(hash-ref!
|
|
libraries
|
|
library-id
|
|
(lambda ()
|
|
(let ((cfg (send libraries-config
|
|
get-library
|
|
library-id)))
|
|
(unless cfg
|
|
(raise-arguments-error
|
|
'library-factory%:get-library
|
|
"library configuration does not exist"
|
|
"library-id" library-id))
|
|
|
|
(unless (and (eq? kind (send cfg get-kind))
|
|
(= version (send cfg get-kind-version)))
|
|
(raise-arguments-error
|
|
'library-factory%:get-library
|
|
"library kind or version does not match its configuration"
|
|
"library-id" library-id
|
|
"kind" kind
|
|
"version" version))
|
|
|
|
(let* ((maker-key (cons kind version))
|
|
(maker
|
|
(hash-ref
|
|
makers
|
|
maker-key
|
|
(lambda ()
|
|
(raise-arguments-error
|
|
'library-factory%:get-library
|
|
"no library maker is registered"
|
|
"kind" kind
|
|
"version" version))))
|
|
(library (maker cfg)))
|
|
(check/c library-factory% get-library
|
|
library
|
|
(is-a?/c media-library%))
|
|
library)))))
|
|
|
|
(super-new)))
|