Writing support
[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 (ice-9 receive)
20   #:use-module (ice-9 vlist)
21   #:use-module (srfi srfi-9)
22   #:use-module (srfi srfi-9 gnu)
23   #:export (make-collection
24             collection?
25             count
26             insert
27             find
28             update
29             $eq
30             $exists
31             $not
32             $and
33             $set))
34
35
36 ;;; Collection Definition
37
38 (define-record-type collection
39   (make-collection-record table)
40   collection?
41   (table get-table))
42
43 (define (make-collection)
44   (make-collection-record vlist-null))
45
46 (define (count col)
47   (vlist-length (get-table col)))
48
49 (set-record-type-printer! collection
50   (lambda (record port)
51     (format port
52             "#<collection with ~a documents>"
53             (count record))))
54
55
56 ;;; Working with documents
57
58 (define (format-document document)
59   "Return a vhash document ready to store in a collection"
60   (document-with-id
61    (cond ((vhash? document)
62           document)
63          (else
64           (alist->vhash document)))))
65
66 (define (document-with-id document)
67   "Return always a document with an id"
68   (or (and (vhash-assoc '_id document)
69            document)
70       (vhash-cons '_id (gensym) document)))
71
72 (define (insert col . documents)
73   "Insert documents into the collection and return the new collection"
74   (cond ((null? documents)
75          (values col '()))
76         (else
77          (let* ((document (format-document (car documents)))
78                 (docid (cdr (vhash-assoc '_id document)))
79                 (newcol (make-collection-record (vhash-cons docid document (get-table col)))))
80            (receive (rescol docids)
81                (apply insert (cons newcol (cdr documents)))
82              (values rescol (cons docid docids)))))))
83
84 (define (find col filter)
85   "Query the collection and return the documents that match with filter"
86   (map vhash->alist (inner-find col filter)))
87
88 (define (inner-find col filter)
89   "Query the collection and return the documents that match with filter"
90   (let ((table (get-table col)))
91     (vhash-fold
92      (lambda (key document result)
93        (cond ((match-document? document filter)
94               (cons document result))
95              (else
96               result)))
97      '()
98      table)))
99
100 (define (match-document? document filter)
101   "Try to match the given document with a given filter"
102   (cond ((equal? filter #t)
103          #t)
104         (else
105          (filter document))))
106
107 (define (update col filter . changes)
108   "Update selected documents using the given filter"
109   (let ((documents (inner-find col filter)))
110     (apply insert (cons col (map (lambda (doc) (update-document doc changes)) documents)))))
111
112 (define (update-document document changes)
113   "Update a document with the appropiate changes"
114   (cond ((null? changes)
115          document)
116         (else
117          (update-document ((car changes) document) (cdr changes)))))
118
119
120 ;;; Queries
121
122 (define ($eq field value)
123   (lambda (document)
124     (let ((stored (vhash-assoc field document)))
125       (and stored
126            (equal? (cdr stored) value)))))
127
128 (define ($exists field)
129   (lambda (document)
130     (and (vhash-assoc field document)
131          #t)))
132
133 (define ($not expr)
134   (lambda (document)
135     (not (expr document))))
136
137 (define-syntax $and
138   (syntax-rules ()
139     ((_ expr ...)
140      (lambda (document)
141        (and (expr document)
142             ...)))))
143
144
145 ;;; Updates
146
147 (define ($set field value)
148   (lambda (document)
149     (vhash-cons field value document)))
150
151              
152 ;;; Tools
153
154 (define (vhash->alist vhash)
155   (vhash-fold-right
156    (lambda (key value result) (assoc-set! result key value))
157    '()
158    vhash))