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")
(defmacro with-db ((db) &body body)
  `(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))
           ,@body))))

(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)")))

(defun load-settings ()
  (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
      (progn
        (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))))