diff --git a/collects/meta/drdr2/lib/db.rkt b/collects/meta/drdr2/lib/db.rkt index fd69a37b81..a628cb8b19 100644 --- a/collects/meta/drdr2/lib/db.rkt +++ b/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)]) \ No newline at end of file diff --git a/collects/meta/drdr2/tests/db.rkt b/collects/meta/drdr2/tests/db.rkt new file mode 100644 index 0000000000..2000908d10 --- /dev/null +++ b/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)))) \ No newline at end of file