24ced3684c04aba6302c46a7818b7893f1bbd3e5
[bongodb.git] / src / bongodb.scm
1 ;;; BongoDB, an embedded document-based engine
2 ;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 ;;; GNU General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17
18 (define-module (bongodb)
19   #:use-module (srfi srfi-9)
20   #:use-module (srfi srfi-9 gnu)
21   #:use-module (srfi srfi-69)
22   #:export (make-collection
23             collection?
24             count
25             insert
26             find
27             update
28             $eq
29             $exists
30             $not
31             $and
32             $set))
33
34
35 ;;; Collection Definition
36
37 (define-record-type collection
38   (make-collection-record table)
39   collection?
40   (table get-table))
41
42 (define (make-collection)
43   (make-collection-record (make-hash-table)))
44
45 (define (count col)
46   (hash-table-size (get-table col)))
47
48 (set-record-type-printer! collection
49   (lambda (record port)
50     (format port
51             "#<collection with ~a documents>"
52             (count record))))
53
54
55 ;;; Working with documents
56
57 (define (format-document document)
58   "Return an alist document ready to store in a collection"
59   (document-with-id
60    (cond ((hash-table? document)
61           (hash-table->alist document))
62          (else
63           document))))
64
65 (define (document-with-id document)
66   "Return always a document with an id"
67   (or (and (assoc '_id document)
68            document)
69       (assoc-set! document '_id (gensym))))
70
71 (define (insert col . documents)
72   "Insert documents into the collection and return document ids"
73   (cond ((null? documents)
74          '())
75         (else
76          (let* ((document (format-document (car documents)))
77                 (docid (assoc-ref document '_id)))
78            (hash-table-set! (get-table col) docid document)
79            (cons docid (apply insert (cons col (cdr documents))))))))
80
81 (define (find col filter)
82   "Query the collection and return the documents that match with filter"
83   (hash-table-fold
84    (get-table col)
85    (lambda (key document result)
86      (cond ((match-document? document filter)
87             (cons document result))
88            (else
89             result)))
90    '()))
91
92 (define (match-document? document filter)
93   "Try to match the given document with a given filter"
94   (cond ((equal? filter #t)
95          #t)
96         (else
97          (filter document))))
98
99 (define (update col filter . changes)
100   "Update selected documents using the given filter"
101   (let ((documents (find col filter)))
102     (apply insert (cons col (map (lambda (doc) (update-document doc changes)) documents)))))
103
104 (define (update-document document changes)
105   "Update a document with the appropiate changes"
106   (cond ((null? changes)
107          document)
108         (else
109          (update-document ((car changes) document) (cdr changes)))))
110
111
112 ;;; Queries
113
114 (define ($eq field value)
115   (lambda (document)
116     (let ((stored (assoc field document)))
117       (and stored
118            (equal? (cdr stored) value)))))
119
120 (define ($exists field)
121   (lambda (document)
122     (and (assoc field document)
123          #t)))
124
125 (define ($not expr)
126   (lambda (document)
127     (not (expr document))))
128
129 (define-syntax $and
130   (syntax-rules ()
131     ((_ expr ...)
132      (lambda (document)
133        (and (expr document)
134             ...)))))
135
136
137 ;;; Updates
138
139 (define ($set field value)
140   (lambda (document)
141     (assoc-set! document field value)))