Filling out db interface

collects/meta/drdr2/lib/db.rkt

@@ -1,24 +1,72 @@
 #lang racket/base
 (require racket/match
-         racket/contract)
+         racket/list
+         racket/serialize
+         racket/contract
+         racket/local
+         unstable/bytes
+         (planet jaymccarthy/mongodb))
 
-(struct db ())
+(struct db (m d heap-mc tree-mc))
 
-(define (db-connect spec)
-  (db))
+(define (ensure-mongo-collection d c #:init? init?)
+  (if init?
+      (local [(define mc (mongo-db-create-collection! d c #:capped? #f #:size 10000))]
+        (mongo-collection-index! mc (hasheq 'key 1) #:name "key")
+        mc)
+      (mongo-collection d c)))
 
-(define (db-ref db . path)
-  #f)
+(define (db-connect spec #:init? [init? #f])
+  (match-define (regexp #rx"^([a-zA-Z]+):([0-9]+):([a-zA-Z]+)$"
+                        (list _ host (app string->number port) db-name))
+                spec)
+  (define m (create-mongo #:host host #:port port))
+  (define d (mongo-db m db-name))
+  (define h (ensure-mongo-collection d "heap" #:init? init?))
+  (define t (ensure-mongo-collection d "tree" #:init? init?))
+  (db m d h t))
 
-(define (db-set! db value . path)
-  #f)
+(define (db-ref the-db . path)
+  (define e
+    (seqn-first
+     (mongo-collection-find 
+      (db-heap-mc the-db)
+      (hasheq 'key path)
+      #:selector (hasheq 'value 1)
+      #:limit 1)))
+  (read/bytes (hash-ref e 'value)))
+
+(define (db-set! the-db value . path)
+  (mongo-collection-repsert!
+   (db-heap-mc the-db)
+   (hasheq 'key path)
+   (hasheq 'key path
+           'value (write/bytes value)))
+  (define-values (dir entry-l) (split-at path (sub1 (length path))))
+  (define entry (first entry-l))
+  (mongo-collection-repsert!
+   (db-tree-mc the-db)
+   (hasheq 'key dir)
+   (hasheq '$addToSet (hasheq 'entries entry))))
+
+(define (db-list the-db . path)
+  (vector->list
+   (hash-ref
+    (seqn-first
+     (mongo-collection-find 
+      (db-tree-mc the-db)
+      (hasheq 'key path)
+      #:selector (hasheq 'entries 1)
+      #:limit 1))
+    'entries)))
 
 (define (db-close! db)
-  #f)
+  (close-mongo! (db-m db)))
 
 (provide/contract
  [db? (any/c . -> . boolean?)]
- [db-connect (string? . -> . db?)]
- [db-ref ((db?) () #:rest (listof string?) . ->* . any/c)] 
- [db-set! ((db? any/c) () #:rest (listof string?) . ->* . void)]
+ [db-connect ((string?) (#:init? boolean?) . ->* . db?)]
+ [db-ref ((db?) () #:rest (non-empty-listof string?) . ->* . serializable?)] 
+ [db-list ((db?) () #:rest (listof string?) . ->* . (listof string?))] 
+ [db-set! ((db? serializable?) () #:rest (non-empty-listof string?) . ->* . void)]
  [db-close! (db? . -> . void)])

collects/meta/drdr2/tests/db.rkt

@@ -0,0 +1,23 @@
+#lang racket
+(require tests/eli-tester
+         "../lib/db.rkt")
+
+(test
+ (local [(define db (db-connect "localhost:27017:test" #:init? #t))
+         (struct num (n) #:prefab)]
+   (test
+    (for ([i (in-range 10)])
+      (test
+       (for ([j (in-range 10)])
+         (test
+          (db-set! db (num (+ i j)) (number->string i) (number->string j))))
+       
+       (sort (db-list db (number->string i)) string<=?) =>
+       (for/list ([j (in-range 10)]) (number->string j))
+       
+       (for ([j (in-range 10)])
+         (test
+          (db-ref db (number->string i) (number->string j)) =>
+          (num (+ i j))))))
+    
+    (db-close! db))))