Replace VHashes with Hash Tables

[bongodb.git] / src / bongodb.scm

diff --git a/src/bongodb.scm b/src/bongodb.scm
index c6b2571605ba23e3a9b4e1ef64a5796ea57760ba..24ced3684c04aba6302c46a7818b7893f1bbd3e5 100644 (file)
--- a/src/bongodb.scm
+++ b/src/bongodb.scm
@@ -1,4 +1,3 @@
-;;;

 ;;; BongoDB, an embedded document-based engine
 ;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
 ;;;
 ;;; BongoDB, an embedded document-based engine
 ;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
 ;;;


@@ -17,10 +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)

-  #:use-module (srfi srfi-9 gnu))
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-69)
+  #:export (make-collection
+           collection?
+           count
+           insert
+           find
+           update
+           $eq
+           $exists
+           $not
+           $and
+           $set))

 
 
 ;;; Collection Definition
 
 
 ;;; Collection Definition


@@ -31,66 +40,102 @@
   (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)
+  (hash-table-size (get-table col)))

 
 (set-record-type-printer! collection
   (lambda (record port)
     (format port
            "#<collection with ~a documents>"
 
 (set-record-type-printer! collection
   (lambda (record port)
     (format port
            "#<collection with ~a documents>"

-           (vlist-length (get-table record)))))
+           (count record))))

 
 
 ;;; 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 value result) (cons (vhash->alist value) 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)
+  "Try to match the given document with a given filter"
+  (cond ((equal? filter #t)
+        #t)
+       (else
+        (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)))))
+
+(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)))

 
 

-;;; Tools
+(define ($not expr)
+  (lambda (document)
+    (not (expr document))))

 
 

-(define (vhash->alist vhash)
-  (vhash-fold-right
-   (lambda (key value result) (assoc-set! result key value))
-   '()
-   vhash))
+(define-syntax $and
+  (syntax-rules ()
+    ((_ expr ...)
+     (lambda (document)
+       (and (expr document)
+           ...)))))

 
 
 
 

-;;; Testing
+;;; Updates

 
 

-(define (sample-test)
-  (let ((col (make-collection)))
-    (format #t "1 New collection: ~a~%" col)
-    (set! col (insert col '((a . 1) (b . 2)) '((a . 10) (b . 20)) '((a . 1) (b . "hello world"))))
-    (format #t "2 Insert 3 documents: ~a~%" col)
-    (format #t "3 Search (a . 1): ~a~%" (find col '((a . 1))))))
+(define ($set field value)
+  (lambda (document)
+    (assoc-set! document field value)))