Replace VHashes with Hash Tables

[bongodb.git] / src / bongodb.scm

diff --git a/src/bongodb.scm b/src/bongodb.scm
index e4df14bde9e1699503e91b4b9d6b9883446ba0b1..24ced3684c04aba6302c46a7818b7893f1bbd3e5 100644 (file)
--- a/src/bongodb.scm
+++ b/src/bongodb.scm
@@ -16,15 +16,20 @@
 
 
 (define-module (bongodb)
 
 
 (define-module (bongodb)

-  #:use-module (ice-9 receive)
-  #:use-module (ice-9 vlist)

   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)

+  #:use-module (srfi srfi-69)

   #:export (make-collection
            collection?
            count
            insert
   #:export (make-collection
            collection?
            count
            insert

-           find))
+           find
+           update
+           $eq
+           $exists
+           $not
+           $and
+           $set))

 
 
 ;;; Collection Definition
 
 
 ;;; Collection Definition


@@ -35,10 +40,10 @@
   (table get-table))
 
 (define (make-collection)
   (table get-table))
 
 (define (make-collection)

-  (make-collection-record vlist-null))
+  (make-collection-record (make-hash-table)))

 
 (define (count col)
 
 (define (count col)

-  (vlist-length (get-table col)))
+  (hash-table-size (get-table col)))

 
 (set-record-type-printer! collection
   (lambda (record port)
 
 (set-record-type-printer! collection
   (lambda (record port)


@@ -50,57 +55,87 @@
 ;;; Working with documents
 
 (define (format-document document)
 ;;; Working with documents
 
 (define (format-document document)

-  "Return a vhash document ready to store in a collection"
+  "Return an alist document ready to store in a collection"

   (document-with-id
   (document-with-id

-   (cond ((vhash? document)
-         document)
+   (cond ((hash-table? document)
+         (hash-table->alist document))

         (else
         (else

-         (alist->vhash document)))))
+         document))))

 
 (define (document-with-id document)
   "Return always a document with an id"
 
 (define (document-with-id document)
   "Return always a document with an id"

-  (or (and (vhash-assoc '_id document)
+  (or (and (assoc '_id document)

           document)
           document)

-      (vhash-cons '_id (gensym) document)))
+      (assoc-set! document '_id (gensym))))

 
 (define (insert col . documents)
 
 (define (insert col . documents)

-  "Insert documents into the collection and return the new collection"
+  "Insert documents into the collection and return document ids"

   (cond ((null? documents)
   (cond ((null? documents)

-        (values col '()))
+        '())

        (else
         (let* ((document (format-document (car documents)))
        (else
         (let* ((document (format-document (car documents)))

-               (docid (cdr (vhash-assoc '_id document)))
-               (newcol (make-collection-record (vhash-cons docid document (get-table col)))))
-          (receive (rescol docids)
-              (apply insert (cons newcol (cdr documents)))
-            (values rescol (cons docid docids)))))))
+               (docid (assoc-ref document '_id)))
+          (hash-table-set! (get-table col) docid document)
+          (cons docid (apply insert (cons col (cdr documents))))))))

 
 (define (find col filter)
   "Query the collection and return the documents that match with filter"
 
 (define (find col filter)
   "Query the collection and return the documents that match with filter"

-  (let ((table (get-table col)))
-    (vhash-fold
-     (lambda (key document result)
-       (cond ((match-document? document filter)
-             (cons (vhash->alist document) result))
-            (else
-             result)))
-     '()
-     table)))
+  (hash-table-fold
+   (get-table col)
+   (lambda (key document result)
+     (cond ((match-document? document filter)
+           (cons document result))
+          (else
+           result)))
+   '()))

 
 (define (match-document? document filter)
 
 (define (match-document? document filter)

-  "Try to match the given document with a list of conditions"
-  (cond ((null? filter)
+  "Try to match the given document with a given filter"
+  (cond ((equal? filter #t)

         #t)
        (else
         #t)
        (else

-        (and
-         (equal? (vhash-assoc (caar filter) document) (car filter))
-         (match-document? document (cdr filter))))))
+        (filter document))))

 
 

+(define (update col filter . changes)
+  "Update selected documents using the given filter"
+  (let ((documents (find col filter)))
+    (apply insert (cons col (map (lambda (doc) (update-document doc changes)) documents)))))

 
 

-;;; Tools
+(define (update-document document changes)
+  "Update a document with the appropiate changes"
+  (cond ((null? changes)
+        document)
+       (else
+        (update-document ((car changes) document) (cdr changes)))))
+
+
+;;; Queries
+
+(define ($eq field value)
+  (lambda (document)
+    (let ((stored (assoc field document)))
+      (and stored
+          (equal? (cdr stored) value)))))
+
+(define ($exists field)
+  (lambda (document)
+    (and (assoc field document)
+        #t)))
+
+(define ($not expr)
+  (lambda (document)
+    (not (expr document))))
+
+(define-syntax $and
+  (syntax-rules ()
+    ((_ expr ...)
+     (lambda (document)
+       (and (expr document)
+           ...)))))
+
+
+;;; Updates

 
 

-(define (vhash->alist vhash)
-  (vhash-fold-right
-   (lambda (key value result) (assoc-set! result key value))
-   '()
-   vhash))
+(define ($set field value)
+  (lambda (document)
+    (assoc-set! document field value)))