chatikbot/plugins/massmention.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.massmention
  (:use :cl :chatikbot.common))
(in-package :chatikbot.plugins.massmention)

(defparameter +default-group+ "all")

(defun format-mention-group (group)
  (format nil "Але!~{ @~a~^~}" (alexandria:flatten (db-select "select user_tag from mention_groups where mention_group = ? and chat_id = ?" group *chat-id*))))

(defun handle-mass-mention (group)
  (bot-send-message (format-mention-group group) :reply-to *message-id*))

(defun add-user-to-group (group mentions)
  (apply-to-mentions group mentions #'db/add-user-to-group "Добавил ~{~a~^,~} в группу ~a."))

(defun remove-user-from-group (group mentions)
  (apply-to-mentions group mentions #'db/remove-user-from-group "Удалил ~{~a~^,~} из группы ~a."))

(defun apply-contol-function (args func)
  (cond
    ((equalp (subseq (second args) 0 1) "@") (funcall func +default-group+ (cdr *args*)))
    (:otherwise (funcall func (second args) (subseq *args* 2)))))

(defun apply-to-mentions (group mentions func message)
  (handler-case (progn
                 (loop for name in mentions
                   do (funcall func group (subseq name 1)))
                 (bot-send-message (format nil message mentions group)))
                (error (e) (progn
                            (bot-send-message "Не получилось, попробуй еще раз.")
                            (log:error "~A" e)))))

(defun db/add-user-to-group (group user-tag)
  (db-execute "insert or ignore into mention_groups (mention_group, user_tag, chat_id) VALUES (?, ?, ?)" group user-tag *chat-id*))

(defun db/remove-user-from-group (group user-tag)
  (db-execute "delete from mention_groups where mention_group = ? and user_tag = ? and chat_id = ?" group user-tag *chat-id*))

(def-db-init
  (db-execute "create table if not exists mention_groups (mention_group TEXT, user_tag TEXT, chat_id INTEGER, primary key (mention_group, user_tag, chat_id)) without rowid"))


(def-message-cmd-handler handle-cmd-all (:all)
  (cond
    ((= 1 (length *args*)) (handle-mass-mention (car *args*)))
    ((equalp "add" (car *args*)) (apply-contol-function *args* #'add-user-to-group))
    ((equalp "remove" (car *args*)) (apply-contol-function *args* #'remove-user-from-group))
    (:otherwise (handle-mass-mention +default-group+))))