[core] chat-cron, used by [ledger] reports

bot.lisp

@@ -63,11 +63,10 @@
 (def-message-handler chat-next-message-handler (message 1000)
   (let ((handler (gethash chat-id *chat-next-message-handlers*)))
     (when handler
-      (unwind-protect
-           (handler-case (funcall handler message)
-             (error (e)
-               (log:error "~A" e)
-               (bot-send-message chat-id
-                                 (format nil "Ошибочка вышла~@[: ~A~]"
-                                         (when (member chat-id *admins*) e)))))
-        (remhash chat-id *chat-next-message-handlers*)))))
+      (remhash chat-id *chat-next-message-handlers*)
+      (handler-case (funcall handler message)
+        (error (e)
+          (log:error "~A" e)
+          (bot-send-message chat-id
+                            (format nil "Ошибочка вышла~@[: ~A~]"
+                                    (when (member chat-id *admins*) e))))))))

chat-cron.lisp

@@ -0,0 +1,49 @@
+(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 t :now (or last-run now))
+       when (and next-time (<= next-time now))
+       do (unwind-protect
+               (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))))

chatikbot.asd

@@ -33,6 +33,7 @@
                (:file "macros")
                (:file "bot")
                (:file "inline")
+               (:file "chat-cron")
                (:file "server")
                (:file "common")
                (:file "chatikbot")))

common.lisp

@@ -9,7 +9,8 @@
         :chatikbot.server
         :chatikbot.macros
         :chatikbot.bot
-        :chatikbot.inline)
+        :chatikbot.inline
+        :chatikbot.chat-cron)
   (:export :db-transaction
            :db-execute
            :db-select
@@ -135,5 +136,9 @@
            :defcron
            :on-next-message
            :get-inline-keyboard
-           :inline-button))
+           :inline-button
+           :add-chat-cron
+           :get-chat-crons
+           :delete-chat-cron
+           :def-chat-cron-handler))
 (in-package :chatikbot.common)

inline.lisp

@@ -41,7 +41,6 @@
 (defmacro inline-button ((text) &body body)
   `(cons ,text
          (lambda (callback)
-
            (with-parsed-callback callback
              (handler-case (progn ,@body)
                (error (e)

plugins/ledger.lisp

@@ -196,6 +196,64 @@
     ((null args) (ledger/handle-journal chat-id "date:thisweek"))
     (:otherwise (ledger/handle-journal chat-id (spaced args)))))
 
+(def-message-cmd-handler hander-add-report (:add_report)
+  (bot-send-message chat-id "Введи название"
+                    :reply-markup (telegram-force-reply))
+  (on-next-message chat-id
+    (let ((name text))
+      (bot-send-message chat-id "Введи запрос"
+                        :reply-markup (telegram-force-reply))
+      (on-next-message chat-id
+        (let ((query text))
+          (pta-ledger:parse-query query) ;; Validate query
+          (bot-send-message chat-id "Введи расписание, ex: (:day-of-week 0 :hour 10), (:day * :hour 10)"
+                            :reply-markup (telegram-force-reply))
+          (on-next-message chat-id
+            (let* ((schedule text))
+              (add-chat-cron :ledger-report chat-id schedule name query)
+              (bot-send-message chat-id "Добавил"))))))))
+
+(defun run-report (chat-id name query)
+  (with-chat-journal (chat-id journal updated)
+    (bot-send-message chat-id
+                      (text-chunks (split-sequence:split-sequence
+                                    #\Newline
+                                    (format nil "*~A*~%~%~A" name
+                                            (pta-ledger:journal-balance journal query)))
+                                   :text-sep "
+")
+                      :parse-mode "markdown")))
+
+(def-chat-cron-handler handler-chat-cron (:ledger-report chat-id schedule name query)
+  (run-report chat-id name query))
+
+(def-message-cmd-handler handler-reports (:reports)
+  (let ((crons (get-chat-crons :ledger-report chat-id)))
+    (if crons
+        (bot-send-message
+         chat-id "Отчёты"
+         :parse-mode "markdown"
+         :reply-markup
+         (get-inline-keyboard
+          chat-id
+          (append
+           (loop for (schedule name query) in crons
+              for idx from 0
+              collect
+                (let ((cron-index idx)
+                      (cron-name name))
+                  (list (inline-button ((format nil "Удалить '~A'" cron-name))
+                          (delete-chat-cron :ledger-report chat-id cron-index)
+                          (bot-send-message chat-id (format nil "Удалил *~A*" cron-name)
+                                            :parse-mode "markdown")))))
+           (list (list (inline-button ("Отмена")
+                         (telegram-edit-message-reply-markup
+                          nil :chat-id source-chat-id :message-id source-message-id)))))))
+        (bot-send-message
+         chat-id "Отчётов пока нет"
+         :reply-markup (telegram-reply-keyboard-markup (list (list (list :text "/add_report")))
+                                                       :one-time-keyboard t)))))
+
 (defun match-entry (text journal)
   (labels ((two-post (entries)
              (remove-if-not #'(lambda (e)

plugins/saver.org

@@ -1,30 +0,0 @@
-* Entities
-** payment schedule (name occurence amount)
-** payment (payment-schedule date )
-** transaction (amount date)
-
-* Use cases
-** Set income dates
-Store dates for periods calculations
-
-** Add payment
-Set name, schedule (due date), amount. System calculates required per-period payments to get the
- amount till due date.
-
-** Transfer money to
-Update balance, top up all pending payments based on their calculated per-period payments
-
-** When payment is soon
-Alert user about the payment, decrease balance (transfer money from) and start saving for next
-payment instance based on schedule.
-
-** List payments
-Show pending payments with up-to-date savings and total balance.
-
-** Delete pending payment
-Show saved amount for this payment to remove from saving account. Income period requirements descreased.
-
-* Example
-Now it's 17th of April. I set up salary schedule on 5th and 20th of each month. Then add new
-recurring payment on 16th of April each year for 9000rub. This means we have 24 periods to save
-9000rub, meaning that we have to save 375rub per salary.