X-Git-Url: https://git.jsancho.org/?p=bongodb.git;a=blobdiff_plain;f=src%2Fbongodb.scm;h=3e5dc680c115c49e5fa79f00eca1661e9952da90;hp=e4df14bde9e1699503e91b4b9d6b9883446ba0b1;hb=a5972febd232c4afd64499826c7faab85a10ee03;hpb=0fe9f925e00b6899f3b685082ed9b3374933c527 diff --git a/src/bongodb.scm b/src/bongodb.scm index e4df14b..3e5dc68 100644 --- a/src/bongodb.scm +++ b/src/bongodb.scm @@ -24,7 +24,13 @@ collection? count insert - find)) + find + update + $eq + $exists + $not + $and + $set)) ;;; Collection Definition @@ -76,27 +82,73 @@ (values rescol (cons docid docids))))))) (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 - (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 (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 + +(define ($eq field value) + (lambda (document) + (let ((stored (vhash-assoc field document))) + (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 (define (vhash->alist vhash)