chatikbot/hooks.lisp

(in-package #:chatikbot)

(defvar *update-hooks* (make-hash-table) "Update hooks storage")

(defun run-update-hooks (hook-name update)
  (let ((hooks (gethash hook-name *update-hooks*)))
    (labels ((try-handle (func)
               (funcall func update)))
      (unless (some #'try-handle hooks)
        (log:info "unhandled" update)))))

(defun add-update-hook (hook-name handler &optional append)
  (let ((existing (gethash hook-name *update-hooks*))
        (func (if (functionp handler) handler (symbol-function handler))))
    (unless (member func existing)
      (setf (gethash hook-name *update-hooks*)
            (if append (append existing (list func))
                (cons func existing))))))

(defun delete-update-hook (hook-name handler)
  (setf (gethash hook-name *update-hooks*)
        (remove (if (functionp handler) handler (symbol-function handler))
                (gethash hook-name *update-hooks*))))

(defun key-to-hook-name (key)
  (intern (string-upcase (substitute #\- #\_ key)) :keyword))

(defmacro def-message-handler (name (message) &body body)
  `(progn
     (defun ,name (,message)
       (let ((message-id (aget "message_id" ,message))
             (from-id (aget "id" (aget "from" ,message)))
             (chat-id (aget "id" (aget "chat" ,message)))
             (text (aget "text" ,message)))
         (declare (ignorable message-id from-id chat-id text))
         (handler-case (progn ,@body)
           (error (e)
             (log:error "~A" e)
             (bot-send-message chat-id
                               (format nil "Ошибочка вышла~@[: ~A~]"
                                       (when (member chat-id *admins*) e)))))))
     (add-update-hook :message ',name)))

(defmacro def-message-cmd-handler (name (&rest commands) &body body)
  `(def-message-handler ,name (message)
     (when (and text (equal #\/ (char text 0)))
       (multiple-value-bind (cmd args) (parse-cmd text)
         (when (member cmd (list ,@commands))
           (log:info cmd message-id chat-id from-id args)
           ,@body
           t)))))