src/bongodb.scm

   1 ;;;
   2 ;;; BongoDB, an embedded document-based engine
   3 ;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
   4 ;;;
   5 ;;; This program is free software: you can redistribute it and/or modify
   6 ;;; it under the terms of the GNU General Public License as published by
   7 ;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;; (at your option) any later version.
   9 ;;;
  10 ;;; This program is distributed in the hope that it will be useful,
  11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;; GNU General Public License for more details.
  14 ;;;
  15 ;;; You should have received a copy of the GNU General Public License
  16 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18
  19 (define-module (bongodb)
  20   #:use-module (ice-9 receive)
  21   #:use-module (ice-9 vlist)
  22   #:use-module (srfi srfi-9)
  23   #:use-module (srfi srfi-9 gnu))
  24
  25
  26 ;;; Collection Definition
  27
  28 (define-record-type collection
  29   (make-collection-record table)
  30   collection?
  31   (table get-table))
  32
  33 (define (make-collection)
  34   (make-collection-record vlist-null))
  35
  36 (set-record-type-printer! collection
  37   (lambda (record port)
  38     (format port
  39             "#<collection with ~a documents>"
  40             (vlist-length (get-table record)))))
  41
  42
  43 ;;; Working with documents
  44
  45 (define (format-document document)
  46   "Return a vhash document ready to store in a collection"
  47   (document-with-id
  48    (cond ((vhash? document)
  49           document)
  50          (else
  51           (alist->vhash document)))))
  52
  53 (define (document-with-id document)
  54   "Return always a document with an id"
  55   (or (and (vhash-assoc '_id document)
  56            document)
  57       (vhash-cons '_id (gensym) document)))
  58
  59 (define (insert col . documents)
  60   "Insert documents into the collection and return the new collection"
  61   (cond ((null? documents)
  62          (values col '()))
  63         (else
  64          (let* ((document (format-document (car documents)))
  65                 (docid (cdr (vhash-assoc '_id document)))
  66                 (newcol (make-collection-record (vhash-cons docid document (get-table col)))))
  67            (receive (rescol docids)
  68                (apply insert (cons newcol (cdr documents)))
  69              (values rescol (cons docid docids)))))))
  70
  71 (define (find col filter)
  72   "Query the collection and return the documents that match with filter"
  73   (let ((table (get-table col)))
  74     (vhash-fold
  75      (lambda (key value result) (cons (vhash->alist value) result))
  76      '()
  77      table)))
  78
  79
  80 ;;; Tools
  81
  82 (define (vhash->alist vhash)
  83   (vhash-fold-right
  84    (lambda (key value result) (assoc-set! result key value))
  85    '()
  86    vhash))
  87
  88
  89 ;;; Testing
  90
  91 (define (sample-test)
  92   (let ((col (make-collection)))
  93     (format #t "1 New collection: ~a~%" col)
  94     (set! col (insert col '((a . 1) (b . 2)) '((a . 10) (b . 20)) '((a . 1) (b . "hello world"))))
  95     (format #t "2 Insert 3 documents: ~a~%" col)
  96     (format #t "3 Search (a . 1): ~a~%" (find col '((a . 1))))))