key store using sqlite3

keystore.rkt

@@ -0,0 +1,78 @@
+#lang racket
+
+(require db
+         racket/class
+         racket/port
+         )
+
+(provide keystore%
+         )
+
+(define keystore%
+  (class object%
+    (init-field
+     [filename (error "filename is mandatory")]
+     )
+
+    (super-new)
+
+    (define db (let* ((path (build-path (find-system-path 'cache-dir) filename))
+                      (dbh (sqlite3-connect #:database path #:mode 'create)))
+                 (query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar, value varchar);")
+                 (query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(key);")
+                 dbh
+                 ))
+
+    (define (msg k)
+      (format "Key ~a must be a symbol" k))
+
+    (define/public (set! key val)
+      (unless (symbol? key) (error (msg key)))
+      (let ((str (call-with-output-string
+                  (λ (out) (write val out))))
+            (k (format "~a" key)))
+        (when (send this exists? key)
+          (send this drop! key))
+        (query-exec db "INSERT OR REPLACE INTO keystore VALUES($1, $2)" k str)
+        )
+      )
+
+    (define/public (exists? key)
+      (unless (symbol? key) (error (msg key)))
+      (let ((k (format "~a" key)))
+        (let ((r (query-value db "SELECT COUNT(*) FROM keystore WHERE key = $1" k)))
+          (> r 0))))
+
+    (define/public (get-raw key)
+      (unless (symbol? key) (error (msg key)))
+      (let ((k (format "~a" key)))
+        (let ((r (query-value db "SELECT COUNT(*) FROM keystore WHERE key = $1" k)))
+          (if (= r 0)
+              '@keystore-@non-@existent
+              (let ((str (vector-ref (query-row db "SELECT value FROM keystore WHERE key = $1" k) 0)))
+                str)))))
+                
+
+    (define/public (get key default-value)
+      (unless (symbol? key) (error (msg key)))
+      (let ((v (get-raw key)))
+        (if (eq? v '@keystore-@non-@existent)
+            default-value
+            (call-with-input-string v
+                                    (λ (in)
+                                      (read in)))
+            )))
+
+    (define/public (drop! key)
+      (unless (symbol? key) (error (msg key)))
+      (let ((k (format "~a" key)))
+        (query-exec db "DELETE FROM keystore WHERE key = $1" k)))
+
+    (define/public (keys)
+      (map
+       (λ (row)
+         (string->symbol row))
+       (query-list db "SELECT key FROM keystore")))
+
+    )
+  )