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