139 lines
3.2 KiB
Racket
139 lines
3.2 KiB
Racket
#lang racket
|
|
|
|
(require keystore
|
|
racket/serialize)
|
|
|
|
(provide store-ref
|
|
store-set!
|
|
store-open
|
|
store-close
|
|
store-new
|
|
store-config!
|
|
store-exists?
|
|
store-remove!
|
|
store-keys
|
|
store-for-each
|
|
store-count
|
|
store-transaction
|
|
store-begin
|
|
store-commit
|
|
)
|
|
|
|
(define (cvtkey k)
|
|
(string-downcase (format "~a" k)))
|
|
|
|
(define store-kind 'hash)
|
|
|
|
(define (store-config! #:kind [kind 'hash])
|
|
(if (not (or (eq? kind 'hash) (eq? kind 'keystore)))
|
|
(error "kind needs to be 'hash or 'keystore")
|
|
(set! store-kind kind)))
|
|
|
|
(define (store-new file)
|
|
(if (eq? store-kind 'hash)
|
|
(let ((h (make-hash)))
|
|
(hash-set! h 'store-file file)
|
|
(list 'hash h))
|
|
(store-open file))
|
|
)
|
|
|
|
(define (store-open file)
|
|
(if (eq? store-kind 'hash)
|
|
(if (file-exists? file)
|
|
(deserialize (file->value file))
|
|
(store-new file))
|
|
(list 'keystore (ks-open file))))
|
|
|
|
(define (store-close st)
|
|
(if (eq? (car st) 'hash)
|
|
(let ((file (hash-ref (cadr st) 'store-file)))
|
|
(write-to-file
|
|
(serialize st) file #:exists 'replace))
|
|
(ks-close (cadr st))))
|
|
|
|
(define (store-ref st key* . val)
|
|
(let ((key (cvtkey key*)))
|
|
(if (eq? (car st) 'hash)
|
|
(if (null? val)
|
|
(hash-ref (cadr st) key)
|
|
(hash-ref (cadr st) key (car val)))
|
|
(let ((v (if (null? val)
|
|
(ks-get (cadr st) key)
|
|
(ks-get (cadr st) key (car val)))))
|
|
(if (eq? v 'ks-nil)
|
|
(error "No such key in storage")
|
|
v))
|
|
)
|
|
))
|
|
|
|
(define (store-set! st key* val)
|
|
(let ((key (cvtkey key*)))
|
|
(if (eq? (car st) 'hash)
|
|
(hash-set! (cadr st) key val)
|
|
(ks-set! (cadr st) key val))))
|
|
|
|
(define (store-remove! st key*)
|
|
(let ((key (cvtkey key*)))
|
|
(if (eq? (car st) 'hash)
|
|
(hash-remove! (cadr st) key)
|
|
(ks-drop! (cadr st) key))))
|
|
|
|
(define (store-exists? st key*)
|
|
(let ((key (cvtkey key*)))
|
|
(if (eq? (car st) 'hash)
|
|
(hash-has-key? (cadr st) key)
|
|
(ks-exists? (cadr st) key))))
|
|
|
|
(define (store-keys st)
|
|
(if (eq? (car st) 'hash)
|
|
(filter (λ (k)
|
|
(not (eq? k 'store-file)))
|
|
(hash-keys (cadr st)))
|
|
(ks-keys (cadr st))))
|
|
|
|
(define (store-count st)
|
|
(if (eq? (car st) 'hash)
|
|
(hash-count (cadr st))
|
|
(ks-key-count (cadr st))))
|
|
|
|
(define (store-for-each st f)
|
|
(if (eq? (car st) 'hash)
|
|
(hash-for-each (cadr st)
|
|
(λ (k v)
|
|
(unless (eq? k 'store-file)
|
|
(f k v))))
|
|
(let* ((ks (cadr st))
|
|
(keys (ks-keys ks)))
|
|
(for-each (λ (k)
|
|
(let ((v (ks-get ks k)))
|
|
(f k v)))
|
|
keys))
|
|
)
|
|
)
|
|
|
|
(define-syntax store-transaction
|
|
(syntax-rules ()
|
|
((_ st b1 ...)
|
|
(if (eq? (car st) 'hash)
|
|
(begin b1 ...)
|
|
(ks-transaction (cadr st) b1 ...)))))
|
|
|
|
(define (store-begin st)
|
|
(when (eq? (car st) 'keystore)
|
|
(ks-begin-transaction (cadr st)))
|
|
#t)
|
|
|
|
(define (store-commit st)
|
|
(when (eq? (car st) 'keystore)
|
|
(ks-end-transaction (cadr st)))
|
|
#t)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|