count
insert
find
+ update
$eq
$exists
- $not))
+ $not
+ $and
+ $set))
;;; Collection Definition
(apply insert (cons newcol (cdr documents)))
(values rescol (cons docid docids)))))))
-(define (find col . filter)
+(define (find col filter)
+ "Query the collection and return the documents that match with filter"
+ (map vhash->alist (inner-find col filter)))
+
+(define (inner-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))
+ (cons document result))
(else
result)))
'()
table)))
(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
- (and
- ((car filter) document)
- (match-document? document (cdr filter))))))
+ (filter document))))
+
+(define (update col filter . changes)
+ "Update selected documents using the given filter"
+ (let ((documents (inner-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
(and stored
(equal? (cdr stored) value)))))
-
(define ($exists field)
(lambda (document)
(and (vhash-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 ($set field value)
+ (lambda (document)
+ (vhash-cons field value document)))
+
;;; Tools
(test-eqv 3 (count col))
; Search
-(test-eqv 3 (length (find col)))
+(test-eqv 3 (length (find col #t)))
(test-eqv 2 (length (find col ($eq 'a 1))))
-(test-eqv 1 (length (find col ($eq 'a 1) ($eq 'b 2))))
-(test-eqv 0 (length (find col ($eq 'a "test"))))
+(test-eqv 1 (length (find col ($and ($eq 'a 1) ($eq 'b 2)))))
+(test-eqv 0 (length (find col ($eq 'c "test"))))
(test-eqv 2 (length (find col ($exists 'b))))
(test-eqv 2 (length (find col ($not ($exists 'c)))))
+; Update
+(set! col (update col ($exists 'c) ($set 'c "test")))
+(test-eqv 1 (length (find col ($eq 'c "test"))))
+
(test-end "bongodb")