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