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             $eq
  29             $exists
  30             $not))
  31
  32
  33 ;;; Collection Definition
  34
  35 (define-record-type collection
  36   (make-collection-record table)
  37   collection?
  38   (table get-table))
  39
  40 (define (make-collection)
  41   (make-collection-record vlist-null))
  42
  43 (define (count col)
  44   (vlist-length (get-table col)))
  45
  46 (set-record-type-printer! collection
  47   (lambda (record port)
  48     (format port
  49             "#<collection with ~a documents>"
  50             (count record))))
  51
  52
  53 ;;; Working with documents
  54
  55 (define (format-document document)
  56   "Return a vhash document ready to store in a collection"
  57   (document-with-id
  58    (cond ((vhash? document)
  59           document)
  60          (else
  61           (alist->vhash document)))))
  62
  63 (define (document-with-id document)
  64   "Return always a document with an id"
  65   (or (and (vhash-assoc '_id document)
  66            document)
  67       (vhash-cons '_id (gensym) document)))
  68
  69 (define (insert col . documents)
  70   "Insert documents into the collection and return the new collection"
  71   (cond ((null? documents)
  72          (values col '()))
  73         (else
  74          (let* ((document (format-document (car documents)))
  75                 (docid (cdr (vhash-assoc '_id document)))
  76                 (newcol (make-collection-record (vhash-cons docid document (get-table col)))))
  77            (receive (rescol docids)
  78                (apply insert (cons newcol (cdr documents)))
  79              (values rescol (cons docid docids)))))))
  80
  81 (define (find col . filter)
  82   "Query the collection and return the documents that match with filter"
  83   (let ((table (get-table col)))
  84     (vhash-fold
  85      (lambda (key document result)
  86        (cond ((match-document? document filter)
  87               (cons (vhash->alist document) result))
  88              (else
  89               result)))
  90      '()
  91      table)))
  92
  93 (define (match-document? document filter)
  94   "Try to match the given document with a list of conditions"
  95   (cond ((null? filter)
  96          #t)
  97         (else
  98          (and
  99           ((car filter) document)
 100           (match-document? document (cdr filter))))))
 101
 102
 103 ;;; Queries
 104
 105 (define ($eq field value)
 106   (lambda (document)
 107     (let ((stored (vhash-assoc field document)))
 108       (and stored
 109            (equal? (cdr stored) value)))))
 110
 111
 112 (define ($exists field)
 113   (lambda (document)
 114     (and (vhash-assoc field document)
 115          #t)))
 116
 117
 118 (define ($not expr)
 119   (lambda (document)
 120     (not (expr document))))
 121
 122
 123 ;;; Tools
 124
 125 (define (vhash->alist vhash)
 126   (vhash-fold-right
 127    (lambda (key value result) (assoc-set! result key value))
 128    '()
 129    vhash))