chatikbot/macros.lisp

(in-package :cl-user)
(defpackage chatikbot.macros
  (:use :cl :chatikbot.utils :chatikbot.telegram :chatikbot.crypto)
  (:export :def-db-init
           :def-message-handler
           :def-message-cmd-handler
           :def-message-admin-cmd-handler
           :def-callback-handler
           :def-callback-section-handler
           :def-oauth-handler
           :def-oauth-section-handler
           :defcron))
(in-package #:chatikbot.macros)

(defmacro def-db-init (&body body)
  `(add-hook :db-init #'(lambda ()
                          (handler-case (progn ,@body)
                            (error (e) (log:error e)))
                          (values))))

(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-hook :update-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)))))

(defmacro def-message-admin-cmd-handler (name (&rest commands) &body body)
  `(def-message-handler ,name (message)
     (when (and (member chat-id *admins*)
                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)))))

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

(defmacro def-callback-section-handler (name (&rest sections) &body body)
  `(def-callback-handler ,name (callback)
     (when chat-id
       (multiple-value-bind (data section) (decode-callback-data chat-id raw-data)
         (when (member section (list ,@sections))
           (log:info query-id from-id chat-id message-id section data)
           ,@body
           t)))))

(defmacro def-oauth-handler (name (code error state) &body body)
  `(progn
     (defun ,name (,code ,error ,state)
       (declare (ignorable ,code ,error ,state))
       (handler-case (progn ,@body)
         (error (e)
           (log:error "~A" e)
           (hunchentoot:redirect "/error"))))
     (add-hook :oauth ',name)))

(defmacro def-oauth-section-handler (name (&rest sections) &body body)
  `(def-oauth-handler ,name (code error raw-state)
     (multiple-value-bind (state section) (decode-oauth-state raw-state)
       (when (member section (list ,@sections))
         ,@body
         t))))

;; Schedule
(defmacro defcron (name (&rest schedule) &body body)
  (let ((schedule (or schedule '(:minute '* :hour '*)))
        (scheduler (symbol-append name '-scheduler)))
    `(progn
       (defun ,name ()
         (unwind-protect
              (handler-case (progn ,@body)
                (error (e) (log:error e)))
           (dex:clear-connection-pool)))
       (defun ,scheduler ()
         (clon:schedule-function
          ',name (clon:make-scheduler
                  (clon:make-typed-cron-schedule
                   ,@schedule)
                  :allow-now-p t)
          :name ',name :thread t)
         (values))
       (add-hook :starting ',scheduler))))