X-Git-Url: https://git.jsancho.org/?p=bongodb.git;a=blobdiff_plain;f=src%2Fbongodb.scm;fp=src%2Fbongodb.scm;h=3e5dc680c115c49e5fa79f00eca1661e9952da90;hp=6fc16fe0fcfababa251b2e7686263640e2a2cd18;hb=a5972febd232c4afd64499826c7faab85a10ee03;hpb=07eed7138a1b4aecb9d8ae0926ba22dc82ebe94e diff --git a/src/bongodb.scm b/src/bongodb.scm index 6fc16fe..3e5dc68 100644 --- a/src/bongodb.scm +++ b/src/bongodb.scm @@ -25,9 +25,12 @@ count insert find + update $eq $exists - $not)) + $not + $and + $set)) ;;; Collection Definition @@ -78,26 +81,40 @@ (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 @@ -108,17 +125,29 @@ (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