chatikbot/db.lisp

(in-package #:chatikbot)

(defvar *db-name* "db.sqlite" "SQLite database name")

(defun db-path ()
  (merge-pathnames *db-name*
                   (asdf:component-pathname
                    (asdf:find-system '#:chatikbot))))

(defvar *current-db* nil "Currently opened database")
(defvar *db-lock* (bordeaux-threads:make-recursive-lock
                   "sqlite connection lock") "Database connection lock")
(defmacro with-db ((db) &body body)
  `(bordeaux-threads:with-recursive-lock-held (*db-lock*)
     (if *current-db*
         (let ((,db *current-db*))
           (declare (ignorable ,db))
           ,@body)
         (sqlite:with-open-database (,db (db-path) :busy-timeout 30)
           (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
           (let ((*current-db* ,db))
             (handler-case (progn ,@body)
               (sqlite:sqlite-error (e)
                 (log:error (sqlite:sqlite-error-code e)
                            (sqlite:sqlite-error-message e))
                 (error e))))))))

(defmacro db-transaction (&body body)
  (let ((db (gensym "DB-")))
    `(with-db (,db)
       (sqlite:with-transaction ,db ,@body))))

(defun db-execute (sql &rest parameters)
  (with-db (db)
    (apply #'sqlite:execute-non-query db sql parameters)
    (sqlite:last-insert-rowid db)))

(defun db-select (sql &rest parameters)
  (with-db (db)
    (apply #'sqlite:execute-to-list db sql parameters)))

(defun db-single (sql &rest parameters)
  (with-db (db)
    (apply #'sqlite:execute-single db sql parameters)))

(defmacro def-db-init (&body body)
  `(add-hook :db-init #'(lambda ()
                          (handler-case (progn ,@body)
                            (error (e) (log:error e)))
                          (values))))

(defun db-init ()
  (with-db (db)
    (db-execute "create table if not exists settings (var, val)")
    (db-execute "create unique index if not exists settings_var_unique on settings (var)")
    (db-execute "create table if not exists lists (list, entry)")
    (db-execute "create unique index if not exists lists_unique on lists (list, entry)")))

(defun load-settings ()
  (let ((*package* (find-package :chatikbot)))
    (loop for (var val) in (db-select "select var, val from settings")
       do (setf (symbol-value (intern var))
                (handler-case (read-from-string val)
                  (error (e) (log:error e)))))))

(defun set-setting (symbol value)
  (handler-case
      (let ((*package* (find-package :chatikbot)))
        (db-execute "replace into settings (var, val) values (?, ?)"
                    (symbol-name symbol)
                    (write-to-string value))
        (setf (symbol-value symbol) value))
    (error (e) (log:error e))))

(defun lists-set-entry (list entry &optional (add t))
  (with-db (db)
    (handler-case
        (if add
            (db-execute "insert into lists (list, entry) values (?, ?)"
                        (dekeyify list) entry)
            (db-execute "delete from lists where list = ? and entry = ?"
                        (dekeyify list) entry))
      (sqlite:sqlite-constraint-error ()
        nil))))

(defun lists-get (list)
  (with-db (db)
    (mapcar #'car (db-select "select entry from lists where list = ?" (dekeyify list)))))