path: root/db.el

;;; db.el --- A database for EmacsLisp  -*- lexical-binding: t -*-

;; Copyright (C) 2012  Nic Ferrier

;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
;; Keywords: data, lisp
;; Created: 23rd September 2012
;; Package-Requires: ((kv "0.0.11"))
;; Version: 0.0.5

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This is a simple database interface and implementation.
;;
;; It should be possible to specify any kind of key/value database
;; with this interface.
;;
;; The supplied implementation is an Emacs hash-table implementation
;; backed with serializing objects.  It is NOT intended for anything
;; other than very simple use cases and will not scale very well at
;; all.

;; However, other implementations (mongodb, redis or PostgreSQL
;; hstore) would be easy to implement and fit in here.


;;; Code:

(eval-when-compile
  (require 'cl))
(require 'kv)

(defun db/make-type-store ()
  "Make the type store."
  (make-hash-table :test 'eq))

(defvar db/types (db/make-type-store)
  "Hash of database type ids against funcs?")

(defun* db-make (reference)
  "Make a DB based on the REFERENCE."
  (if (and (listp reference)
           (eq
            'db-hash
            (car reference)))
      ;; this should be part of what we find when we look it up?
      (db-hash reference)
      ;; Otherwise look it up...
      (let ((db-func (gethash (car reference) db/types)))
        (if (functionp db-func)
            (funcall db-func reference)
            ;; there should be a specific db error
            (error "no such database implementation")))))

(defun db-get (key db)
  "Get the value from the DB with the KEY."
  (funcall (plist-get db :get) key db))

(defun db-put (key value db)
  "Put a new VALUE into the DB with the specified KEY.

Return the VALUE as it has been put into the DB."
  (funcall (plist-get db :put) key value db))

(defun db-map (func db &optional query filter)
  "Call FUNC for every record in DB optionally QUERY filter.

QUERY, if specified, should be a list of query terms as specified
by `kvquery->func'.

FUNC should take 2 arguments:

  KEY DB-VALUE

where the DB-VALUE is whatever the DB has attached to the
specified KEY.

This returns an alist of the KEY and the value the function
returned.  If FILTER is `t' then only pairs with a value are
returned."
  (let (retlist)
    (funcall (plist-get db :map)
             (lambda (key value)
               (when key
                 (setq
                  retlist
                  (cons
                   (funcall func key value)
                   retlist))))
             db query)
    (if filter
        (loop for p in retlist
           if (cdr p)
           collect p)
        retlist)))

(defun db-query (db query)
  "Do QUERY on DB and return the result.

The query is as specified by `kvquery->func'.

This is `db-map' with an identity function."
  (db-map 'kvidentity db query))


;;; Generic utility functions

(defun db-copy (src-db dest-db)
  "Copy the data from SRC-DB into DEST-DB."
  (db-map (lambda (key value)
            ;;(unless (db-get key dest-db)
            (progn
              (db-put key value dest-db))) src-db))


;;; Hash implementation

(defun db-hash (reference)
  "Make a db-hash database.

REFERENCE comes from the call to `db-make' and should
include a `:filename' key arg to point to a file:

  '(db-hash :filename \"/var/local/db/auth-db\")

If the filename exists then it is loaded into the database."
  (let* ((db-plist (cdr reference))
         (filename (plist-get db-plist :filename))
         (from-filename (plist-get db-plist :from-filename)) 
         (db (list
              :db (make-hash-table :test 'equal)
              :get 'db-hash-get
              :put 'db-hash-put
              :map 'db-hash-map
              :query-equal (or
                            (plist-get db-plist :query-equal)
                            'kvassoq=)
              :filename filename
              :from-filename from-filename)))
    (when (and filename
               (file-exists-p (concat filename ".elc")))
      (db-hash/read db))
    ;; Return the database
    db))

(defun db-hash/read (db)
  "Loads the DB."
  (let* ((filename (plist-get db :filename))
         (source-filename ; this is needed for the crappy old way of
                          ; saving with a unique filename based symbol
          (or
           (plist-get db :from-filename)
           filename)))
    (when filename
      (plist-put
       db :db
       (catch 'return
         (progn
           ;; The new saving mechanism causes that throw
           (load-file (concat filename ".elc"))
           ;; the old way used unique symbols
           (symbol-value (intern source-filename))))))))

(defvar db-hash-do-not-save nil
  "If `t' then do not save the database.

This is very useful for testing.")

(defun db-hash/save (db)
  "Saves the DB."
  (unless db-hash-do-not-save
    (let ((filename (plist-get db :filename)))
      (when filename
        ;; Make the parent directory for the db if it doesn't exist
        (let ((dir (file-name-directory filename)))
          (unless (file-exists-p dir)
            (make-directory dir t)))
        ;; Now store the data
        (with-temp-file (concat filename ".el")
          (erase-buffer)
          (let ((fmt-obj (format
                          "(throw 'return %S)"
                          (plist-get db :db))))
            (insert fmt-obj)))
        ;; And compile it and delete the original
        (byte-compile-file (concat filename ".el"))
        (delete-file (concat filename ".el"))))))


(defun db-hash-get (key db)
  (let ((v (gethash key (plist-get db :db))))
    v))

(defun db-hash-map (func db &optional query)
  "Run FUNC for every value in DB.

The QUERY is ignored.  We never filter."
  (let* ((equal-fn (plist-get db :query-equal))
         (filterfn (if query
                       (kvquery->func query :equal-func equal-fn)
                       'identity)))
    (maphash
     (lambda (key value)
       (when (funcall filterfn value)
         (funcall func key value)))
     (plist-get db :db))))

(defun db-hash-put (key value db)
  (let ((v (puthash key value (plist-get db :db))))
    ;; Instead of saving every time we could simply signal an update
    ;; and have a timer do the actual save.
    (db-hash/save db)
    v))

(defvar db/hash-clear-history nil
  "History variable for completing read.")

(defun db-hash-clear (db)
  "Clear the specified DB (a hash-db)."
  (interactive
   (list (symbol-value
          (intern
           (completing-read
            "Database: "
            obarray
            nil
            't
            nil
            'db/hash-clear-history)))))
  (clrhash (plist-get db :db))
  (if (file-exists-p (plist-get db :filename))
      (delete-file (plist-get db :filename))))


;; Filter db - let's you filter another db

(defun db-filter-get (key db)
  (let* ((filter-func (plist-get db :filter))
         (origin (plist-get db :source))
         (value (db-get key origin)))
    (funcall filter-func key value)))

(defun db-filter-put (key value db)
  (let* ((filter-func (plist-get db :filter))
         (origin (plist-get db :source))
         (ret (db-put key value origin)))
    (funcall filter-func key ret)))

(defun db-filter-map (key db &optional query)
  (let* ((filter-func (plist-get db :filter))
         (origin (plist-get db :source)))
    (mapcar
     filter-func
     (db-map key origin query))))

(defun db-filter (reference)
  "Make a database object that is a filter around another.

The reference should look something like:

 '(db-filter
    :source (db-hash :filename ....)
    :filter (lambda (value) ...)

The `:filter' function takes 2 arguments: KEY and VALUE with
VALUE being the returned value from the `:source' database."
  (let* ((ref-plist (cdr reference))
         (db (list
              :get 'db-filter-get
              :put 'db-filter-put
              :map 'db-filter-map
              :filter (plist-get ref-plist :filter)
              :source (plist-get ref-plist :source))))
    db))

(puthash 'db-filter 'db-filter db/types)

(defun db-change-timestamp ()
  "Place a timestamp in the kill-ring for a db change log."
  (interactive)
  (kill-new (format-time-string "\"%Y%M%d%H%M%S%N\""(current-time))))

(defmacro db-change (change-db timestamp &rest change)
  "Do CHANGE and make a record in the CHANGE-DB with TIMESTAMP."
  (declare (indent 2))
  (let ((cdbv (make-symbol "cdbv"))
        (tsv (make-symbol "tsv")))
  `(let ((,cdbv ,change-db)
         (,tsv ,timestamp))
     (unless (db-get ,tsv ,cdbv)
       (progn
         (progn ,@change)
         (db-put ,tsv (list (cons "timestamp" ,tsv)) ,cdbv))))))

(provide 'db)

;;; db.el ends here