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))