refactor

admin.lisp

@@ -21,10 +21,5 @@
           (format t "~{~S~^ ;~%     ~}~%"
                   (multiple-value-list (eval (read-from-string input)))))))))
 
-(def-message-handler handler-admin (message)
-  (when (member from-id *admins*)
-    (multiple-value-bind (cmd args) (parse-cmd text)
-      (case cmd
-        (:eval (bot-send-message chat-id (rep (format nil "~{~A~^ ~}" args))))
-        (otherwise (send-dont-understand chat-id (preprocess-input (subseq text 1))))))
-    t))
+(def-message-admin-cmd-handler handle-admin-eval (:eval)
+  (bot-send-message chat-id (rep (format nil "~{~A~^ ~}" args))))

chatikbot.lisp

@@ -23,7 +23,7 @@
     (error (e) (log:error e))))
 ;; Init plugin's database
 (with-db (db)
-  (run-hooks :db-init db))
+  (run-hooks :db-init))
 
 (defvar *telegram-last-update* nil "Telegram last update_id")
 

config.lisp.example

@@ -1,5 +1,8 @@
 (in-package #:chatikbot)
 
+;; Bot
+(setf *bot-name* "@chatikbot")
+
 ;; Telegram
 (setf *telegram-token* "123456789:YourTokenHere")
 

db.lisp

@@ -7,42 +7,42 @@
                    (asdf:component-pathname
                     (asdf:find-system '#:chatikbot))))
 
+(defvar *current-db* nil "Currently opened database")
 (defmacro with-db ((db) &body body)
-  `(sqlite:with-open-database (,db (db-path) :busy-timeout 30)
-     (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
-     ,@body))
-
-(defun %db-execute (db sql &rest parameters)
-  (apply #'sqlite:execute-non-query db sql parameters))
-(defun %db-select (db sql &rest parameters)
-  (apply #'sqlite:execute-to-list db sql parameters))
-(defun %db-single (db sql &rest parameters)
-  (apply #'sqlite:execute-single db sql parameters))
+  `(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 #'%db-execute db sql parameters)
+    (apply #'sqlite:execute-non-query db sql parameters)
     (sqlite:last-insert-rowid db)))
 
 (defun db-select (sql &rest parameters)
   (with-db (db)
-    (apply #'%db-select db sql parameters)))
+    (apply #'sqlite:execute-to-list db sql parameters)))
 
 (defun db-single (sql &rest parameters)
   (with-db (db)
-    (apply #'%db-single db sql parameters)))
-
-(defmacro db-transaction ((db) &body body)
-  `(with-db (,db)
-     (sqlite:with-transaction ,db ,@body)))
+    (apply #'sqlite:execute-single db sql parameters)))
 
-(defmacro def-db-init ((db) &body body)
-  `(add-hook :db-init #'(lambda (,db)
+(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 db "create table if not exists settings (var, val)")
-    (%db-execute db "create unique index if not exists settings_var_unique on settings (var)")))
+    (db-execute "create table if not exists settings (var, val)")
+    (db-execute "create unique index if not exists settings_var_unique on settings (var)")))

finance.lisp

@@ -76,9 +76,9 @@
       (adw-charting:save-file "chart.png"))))
 
 ;; Database
-(def-db-init (db)
-  (%db-execute db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
-  (%db-execute db "create index if not exists fin_ts_ids on finance (ts)"))
+(def-db-init
+  (db-execute "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
+  (db-execute "create index if not exists fin_ts_ids on finance (ts)"))
 
 (defun db/add-finance (ts usd eur gbp brent btc)
   (db-execute "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)"

foursquare.lisp

@@ -60,12 +60,12 @@
                :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))))))
 
 ;; Database
-(def-db-init (db)
-  (%db-execute db "create table if not exists fsq_chat_users (chat_id, user_id)")
-  (%db-execute db "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)")
-  (%db-execute db "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)")
-  (%db-execute db "create table if not exists fsq_seen (id, created_at)")
-  (%db-execute db "create index if not exists fsq_seen_idx on fsq_seen (id)"))
+(def-db-init
+  (db-execute "create table if not exists fsq_chat_users (chat_id, user_id)")
+  (db-execute "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)")
+  (db-execute "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)")
+  (db-execute "create table if not exists fsq_seen (id, created_at)")
+  (db-execute "create index if not exists fsq_seen_idx on fsq_seen (id)"))
 
 (defun db/fsq-get-chat-users (chat-id)
   (flatten (db-select "select user_id from fsq_chat_users where chat_id = ?" chat-id)))
@@ -74,10 +74,10 @@
   (flatten (db-select "select chat_id from fsq_chat_users where user_id = ?" user-id)))
 
 (defun db/fsq-set-chat-users (chat-id users)
-  (db-transaction (db)
-    (%db-execute db "delete from fsq_chat_users where chat_id = ?" chat-id)
+  (db-transaction
+    (db-execute "delete from fsq_chat_users where chat_id = ?" chat-id)
     (dolist (user-id users)
-      (%db-execute db "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id))))
+      (db-execute "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id))))
 
 (defun db/fsq-add-seen (id created-at)
   (db-execute "insert into fsq_seen (id, created_at) values (?, ?)" id created-at))

rss.lisp

@@ -130,15 +130,15 @@
     (local-time:timestamp-to-unix ts)))
 
 ;; Databaase
-(def-db-init (db)
-  (%db-execute db "create table if not exists rss_feeds (id INTEGER PRIMARY KEY, url, title, next_fetch, period)")
-  (%db-execute db "create unique index if not exists rss_feeds_url_idx on rss_feeds (url)")
-  (%db-execute db "create table if not exists rss_items (id INTEGER PRIMARY KEY, feed_id REFERENCES rss_feeds, guid, link, title, published)")
-  (%db-execute db "create index if not exists rss_items_idx on rss_items (feed_id, guid)")
+(def-db-init
+  (db-execute "create table if not exists rss_feeds (id INTEGER PRIMARY KEY, url, title, next_fetch, period)")
+  (db-execute "create unique index if not exists rss_feeds_url_idx on rss_feeds (url)")
+  (db-execute "create table if not exists rss_items (id INTEGER PRIMARY KEY, feed_id REFERENCES rss_feeds, guid, link, title, published)")
+  (db-execute "create index if not exists rss_items_idx on rss_items (feed_id, guid)")
 
-  (%db-execute db "create table if not exists rss_chat_feeds (chat_id, feed_id REFERENCES rss_feeds)")
-  (%db-execute db "create index if not exists rss_chat_feeds_chat_idx on rss_chat_feeds (chat_id)")
-  (%db-execute db "create index if not exists rss_chat_feeds_feed_idx on rss_chat_feeds (feed_id)"))
+  (db-execute "create table if not exists rss_chat_feeds (chat_id, feed_id REFERENCES rss_feeds)")
+  (db-execute "create index if not exists rss_chat_feeds_chat_idx on rss_chat_feeds (chat_id)")
+  (db-execute "create index if not exists rss_chat_feeds_feed_idx on rss_chat_feeds (feed_id)"))
 
 (defun %db/make-feed (row)
   (when row
@@ -178,11 +178,11 @@
     (flatten (db-select "select chat_id from rss_chat_feeds where feed_id = ?" id))))
 
 (defun db/rss-set-chat-feeds (chat-id feeds)
-  (db-transaction (db)
-    (%db-execute db "delete from rss_chat_feeds where chat_id = ?" chat-id)
+  (db-transaction
+    (db-execute "delete from rss_chat_feeds where chat_id = ?" chat-id)
     (dolist (feed feeds)
       (with-slots (id) feed
-        (%db-execute db "insert into rss_chat_feeds (chat_id, feed_id) values (?, ?)" chat-id id)))))
+        (db-execute "insert into rss_chat_feeds (chat_id, feed_id) values (?, ?)" chat-id id)))))
 
 (defun db/rss-item-exists (item)
   (let ((feed-id (feed-id (feed-item-feed item)))

twitter.lisp

@@ -1,6 +1,6 @@
 (in-package #:chatikbot)
 
-(defvar *twitter-access-token* nil "OAuth access token")
+(defsetting *twitter-access-token* nil "OAuth access token")
 
 (defparameter *timeline-url* "https://api.twitter.com/1.1/statuses/user_timeline.json")
 

utils.lisp

@@ -1,5 +1,7 @@
 (in-package #:chatikbot)
 
+(defvar *bot-name* "@chatikbot" "bot name to properly handle text input")
+
 (defvar *hooks* (make-hash-table) "Hooks storage")
 
 (defun run-hooks (event &rest arguments)
@@ -98,41 +100,13 @@ is replaced with replacement."
   "Append together elements (or lists) in the list."
   (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))
 
-
-;; Circular lists
-(defun make-circular (items)
-  "Make items list circular"
-  (setf (cdr (last items)) items))
-
-(defmacro push-circular (obj circ)
-  "Move circ list and set head to obj"
-  `(progn
-     (pop ,circ)
-     (setf (car ,circ) ,obj)))
-
-(defmacro peek-circular (circ)
-  "Get head of circular list"
-  `(car ,circ))
-
-(defmacro pop-circular (circ)
-  "Get head of circular list"
-  `(pop ,circ))
-
-(defun flat-circular (circ)
-  "Flattens circular list"
-  (do ((cur (cdr circ) (cdr cur))
-       (head circ)
-       result)
-      ((eq head cur)
-       (nreverse (push (car cur) result)))
-    (push (car cur) result)))
-
 (defun preprocess-input (text)
   (when text
-    (let ((first-word (subseq text 0 (position #\Space text))))
-      (if (equal first-word "@chatikbot")
-          (preprocess-input (subseq text 11))
-          (replace-all text "@chatikbot" "ты")))))
+    (let* ((first-space (position #\Space text))
+           (first-word (subseq text 0 first-space)))
+      (if (equal first-word *bot-name*)
+          (preprocess-input (subseq text (1+ first-space)))
+          (replace-all text *bot-name* "ты")))))
 
 (defun parse-cmd (text)
   (let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))

vk.lisp

@@ -118,18 +118,18 @@
      (if preview 0 1))))
 
 ;; Database
-(def-db-init (db)
-  (%db-execute db "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
-  (%db-execute db "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")
+(def-db-init
+  (db-execute "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
+  (db-execute "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")
 
-  (%db-execute db "create table if not exists vk_chat_walls (chat_id, domain)")
-  (%db-execute db "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
-  (%db-execute db "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))
+  (db-execute "create table if not exists vk_chat_walls (chat_id, domain)")
+  (db-execute "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
+  (db-execute "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))
 
 (defun db/vk-ensure-domain (domain last-id)
-  (db-transaction (db)
-    (unless (%db-single db "select domain from vk_walls where domain = ?" domain)
-      (%db-execute db "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))
+  (db-transaction
+    (unless (db-single "select domain from vk_walls where domain = ?" domain)
+      (db-execute "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))
 
 (defun db/vk-get-domain-chats (domain)
   (flatten (db-select "select chat_id from vk_chat_walls where domain = ?" domain)))