chatikbot/chat-cron.lisp

(in-package :cl-user)
(defpackage chatikbot.chat-cron
  (:use :cl :chatikbot.utils :chatikbot.db
        :chatikbot.macros)
  (:export :add-chat-cron
           :get-chat-crons
           :delete-chat-cron
           :def-chat-cron-handler))
(in-package :chatikbot.chat-cron)

(def-db-init
  (db-execute "create table if not exists chat_crons (type, chat_id, schedule, args, last_run)"))

(defun add-chat-cron (type chat-id schedule &rest args)
  (apply #'clon:make-typed-cron-schedule (read-from-string schedule)) ;; Validate schedule
  (db-execute "insert into chat_crons (type, chat_id, schedule, args) values (?, ?, ?, ?)"
              (symbol-name type) chat-id schedule (write-to-string args)))

(defun get-chat-crons (type chat-id)
  (loop for (schedule args) in (db-select "select schedule, args from chat_crons where type = ? and chat_id = ?"
                                          (symbol-name type) chat-id)
     collect (append (list schedule) (read-from-string args))))

(defun delete-chat-cron (type chat-id index)
  (let ((crons (db-select "select schedule, args from chat_crons where type = ? and chat_id = ?"
                          (symbol-name type) chat-id)))
    (destructuring-bind (schedule args) (nth index crons)
      (db-execute "delete from chat_crons where type = ? and chat_id = ? and schedule = ? and args = ?"
                  (symbol-name type) chat-id schedule args))))

(defcron chat-crons-handler ()
  (let ((now (get-universal-time)))
    (loop
       for (type chat-id schedule-text args last-run) in (db-select "select type, chat_id, schedule, args, last_run from chat_crons")
       for schedule = (apply #'clon:make-typed-cron-schedule (read-from-string schedule-text))
       for next-time = (clon:next-time schedule :allow-now-p (not last-run) :now (or last-run now))
       when (and next-time (<= (same-time-in-chat next-time chat-id) now))
       do (unwind-protect
               (progn
                 (log:info :chat-cron type chat-id schedule-text now next-time last-run)
                 (apply #'run-hooks :chat-cron (keyify type) chat-id schedule (read-from-string args)))
            (db-execute "update chat_crons set last_run = ? where type = ? and chat_id = ? and schedule = ? and args = ?" next-time type chat-id schedule-text args)))))

(defmacro def-chat-cron-handler (name (type &rest args) &body body)
  (let ((var-type (gensym "TYPE")))
    `(progn
       (defun ,name (,var-type ,@args)
         (declare (ignorable ,@args))
         (when (eql ,type ,var-type)
           ,@body))
       (add-hook :chat-cron ',name))))