Reorganize

chatikbot.asd

@@ -21,11 +21,7 @@
                #:yason)
   :serial t
   :components ((:file "package")
-               (:file "hooks")
                (:file "utils")
-               (:file "telegram")
                (:file "db")
-               (:file "settings")
-               (:file "patmatch")
-               (:file "eliza")
+               (:file "telegram")
                (:file "chatikbot")))

chatikbot.lisp

@@ -13,6 +13,17 @@
 (db-init)
 ;; Load settings
 (load-settings)
+;; Load plugins
+(defsetting *plugins* nil "List of enabled plugins")
+(dolist (plugin *plugins*)
+  (handler-case
+      (load (merge-pathnames (format nil "~A.lisp" plugin)
+                             (asdf:component-pathname
+                              (asdf:find-system '#:chatikbot))))
+    (error (e) (log:error e))))
+;; Init plugin's database
+(with-db (db)
+  (run-hooks :db-init db))
 
 (defvar *telegram-last-update* nil "Telegram last update_id")
 
@@ -32,36 +43,6 @@
      unless (equal "update_id" key)
      do (run-hooks (string-to-event (format nil "update-~A" key)) value)))
 
-(defun send-dont-understand (chat-id &optional text reply-id)
-  (let ((resp (eliza text)))
-    (log:info text resp)
-    (when resp
-      (send-response chat-id resp reply-id))))
-
-(defun handle-unknown-message (message)
-  (let ((chat-id (aget "id" (aget "chat" message)))
-        (text (aget "text" message)))
-    (log:info "handle-unknown-message" message)
-    (send-dont-understand chat-id (preprocess-input text))
-    t))
-(add-hook :update-message 'handle-unknown-message t)
-
-;; Schedule
-(defmacro defcron (name (&rest schedule) &body body)
-  (let ((schedule (or schedule '(:minute '* :hour '*))))
-    `(progn
-       (defun ,name ()
-         (handler-case (progn ,@body)
-           (error (e) (log:error e))))
-       (add-hook :starting #'(lambda ()
-                               (clon:schedule-function
-                                ',name (clon:make-scheduler
-                                        (clon:make-typed-cron-schedule
-                                         ,@schedule)
-                                        :allow-now-p t)
-                                :name ',name :thread t)
-                               (values))))))
-
 (defcron process-watchdog ()
   (close
    (open (merge-pathnames ".watchdog"
@@ -71,25 +52,19 @@
          :if-exists :supersede
          :if-does-not-exist :create)))
 
-(defsetting *plugins* nil "List of enabled plugins")
 
-(defun start ()
+(defun cleanup ()
   ;; Clear prev threads
   (mapc #'trivial-timers:unschedule-timer (trivial-timers:list-all-timers))
   (let ((old-updates (find "process-updates"
-                            (bordeaux-threads:all-threads)
-                            :key #'bordeaux-threads:thread-name
-                            :test #'equal)))
+                           (bordeaux-threads:all-threads)
+                           :key #'bordeaux-threads:thread-name
+                           :test #'equal)))
     (when old-updates
-      (bordeaux-threads:destroy-thread old-updates)))
+      (bordeaux-threads:destroy-thread old-updates))))
 
-  ;; Load plugins
-  (dolist (plugin *plugins*)
-    (handler-case
-        (load (merge-pathnames (format nil "~A.lisp" plugin)
-                               (asdf:component-pathname
-                                (asdf:find-system '#:chatikbot))))
-      (error (e) (log:error e))))
+(defun start ()
+  (cleanup)
 
   ;; Run 'starting' hooks to set up schedules
   (run-hooks :starting)

db.lisp

@@ -12,23 +12,28 @@
      (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON")
      ,@body))
 
-(defun db-execute (sql &rest parameters)
-  (with-db (db)
-    (apply #'sqlite:execute-non-query db sql parameters)))
+(defun db-execute (sql &rest parameters &key db)
+  (if db
+      (apply #'sqlite:execute-non-query db sql parameters)
+      (with-db (db)
+        (apply #'sqlite:execute-non-query db sql parameters))))
 
-(defun db-select (sql &rest parameters)
-  (with-db (db)
-    (apply #'sqlite:execute-to-list db sql parameters)))
+(defun db-select (sql &rest parameters &key db)
+  (if db
+      (apply #'sqlite:execute-to-list db sql parameters)
+      (with-db (db)
+        (apply #'sqlite:execute-to-list db sql parameters))))
 
-(defmacro def-db-init (() &body body)
-  `(add-hook :db-init #'(lambda ()
+(defmacro def-db-init ((db) &body body)
+  `(add-hook :db-init #'(lambda (,db)
                           (handler-case (progn ,@body)
                             (error (e) (log:error e)))
                           (values))))
 
 (defun db-init ()
   (with-db (db)
-    (run-hooks :db-init)
+    (db-execute "create table if not exists settings (var, val)" :db db)
+    (db-execute "create unique index if not exists settings_var_unique on settings (var)" :db db)
     ;; Finance
     (sqlite:execute-non-query db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
     (sqlite:execute-non-query db "create index if not exists fin_ts_ids on finance (ts)")

eliza.lisp

@@ -1,5 +1,8 @@
 (in-package #:chatikbot)
 
+;; Load pattern matching facility
+(load (merge-pathnames "patmatch.lisp" (asdf:component-pathname (asdf:find-system '#:chatikbot))))
+
 (defparameter *fuck-off*
   '((отъебись) (мне похуй) (ебаный ты нахуй!))
   "Fuck-off responses")
@@ -78,3 +81,17 @@
        (apply (cadar r) (cdr r)))
       ((keywordp (car r)) r)
       (t (print-with-spaces (flatten r))))))
+
+(defun send-dont-understand (chat-id &optional text reply-id)
+  (let ((resp (eliza text)))
+    (log:info text resp)
+    (when resp
+      (send-response chat-id resp reply-id))))
+
+(defun handle-unknown-message (message)
+  (let ((chat-id (aget "id" (aget "chat" message)))
+        (text (aget "text" message)))
+    (log:info "handle-unknown-message" message)
+    (send-dont-understand chat-id (preprocess-input text))
+    t))
+(add-hook :update-message 'handle-unknown-message t)

hooks.lisp

@@ -1,26 +0,0 @@
-(in-package #:chatikbot)
-
-(defvar *hooks* (make-hash-table) "Hooks storage")
-
-(defun run-hooks (event &rest arguments)
-  (let ((hooks (gethash event *hooks*)))
-    (labels ((try-handle (func)
-               (apply func arguments)))
-      (unless (some #'try-handle hooks)
-        (log:info "unhandled" event arguments)))))
-
-(defun add-hook (event hook &optional append)
-  (let ((existing (gethash event *hooks*))
-        (func (if (functionp hook) hook (symbol-function hook))))
-    (unless (member func existing)
-      (setf (gethash event *hooks*)
-            (if append (append existing (list func))
-                (cons func existing))))))
-
-(defun remove-hook (event hook)
-  (setf (gethash event *hooks*)
-        (remove (if (functionp hook) hook (symbol-function hook))
-                (gethash event *hooks*))))
-
-(defun string-to-event (key)
-  (intern (string-upcase (substitute #\- #\_ key)) :keyword))

utils.lisp

@@ -1,5 +1,28 @@
 (in-package #:chatikbot)
 
+(defvar *hooks* (make-hash-table) "Hooks storage")
+
+(defun run-hooks (event &rest arguments)
+  (let ((hooks (gethash event *hooks*)))
+    (labels ((try-handle (func)
+               (apply func arguments)))
+      (unless (some #'try-handle hooks)
+        (log:info "unhandled" event arguments)))))
+
+(defun add-hook (event hook &optional append)
+  (let ((existing (gethash event *hooks*)))
+    (unless (member hook existing)
+      (setf (gethash event *hooks*)
+            (if append (append existing (list hook))
+                (cons hook existing))))))
+
+(defun remove-hook (event hook)
+  (setf (gethash event *hooks*)
+        (remove hook (gethash event *hooks*))))
+
+(defun string-to-event (key)
+  (intern (string-upcase (substitute #\- #\_ key)) :keyword))
+
 (defmacro def-message-handler (name (message) &body body)
   `(progn
      (defun ,name (,message)
@@ -35,6 +58,49 @@
            ,@body
            t)))))
 
+;; Schedule
+(defmacro defcron (name (&rest schedule) &body body)
+  (let ((schedule (or schedule '(:minute '* :hour '*))))
+    `(progn
+       (defun ,name ()
+         (handler-case (progn ,@body)
+           (error (e) (log:error e))))
+       (add-hook :starting #'(lambda ()
+                               (clon:schedule-function
+                                ',name (clon:make-scheduler
+                                        (clon:make-typed-cron-schedule
+                                         ,@schedule)
+                                        :allow-now-p t)
+                                :name ',name :thread t)
+                               (values))))))
+
+;; Settings
+(defvar *settings* nil "List of plugin's settings symbols")
+(defmacro defsetting (var &optional val doc)
+  `(progn (defvar ,var ,val ,doc)
+          (push ',var *settings*)))
+
+(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))))
+
+(def-message-admin-cmd-handler handle-admin-settings (:settings)
+  (send-response chat-id
+                 (format nil "~{~{~A~@[ (~A)~]: ~A~}~^~%~}"
+                         (loop for symbol in *settings*
+                            collect (list symbol (documentation symbol 'variable) (symbol-value symbol))))))
+
 (defvar *backoff-start* 1 "Initial back-off")
 (defvar *backoff-max* 64 "Maximum back-off delay")