|
|
@@ -117,42 +117,41 @@
|
|
|
(with-secret (info (list :ledger chat-id))
|
|
|
(process-info info)))))))
|
|
|
|
|
|
-(Defun ledger/handle-info (chat-id)
|
|
|
- (with-secret (info (list :ledger chat-id))
|
|
|
+(defun ledger/handle-info ()
|
|
|
+ (with-secret (info (list :ledger *chat-id*))
|
|
|
(if info
|
|
|
(destructuring-bind (journal . ut)
|
|
|
- (get-chat-journal-info chat-id info)
|
|
|
+ (get-chat-journal-info *chat-id* info)
|
|
|
(let ((uri (cond
|
|
|
((consp info) (car info))
|
|
|
((stringp info) info))))
|
|
|
- (bot-send-message chat-id (format nil "Журнал с ~D записями, из ~A, обновлён ~A.~%Веб-хук: ~A"
|
|
|
- (length journal)
|
|
|
- (ledger/format-uri uri)
|
|
|
- (ledger/format-time ut)
|
|
|
- (ledger/get-hook-url chat-id))
|
|
|
+ (bot-send-message (format nil "Журнал с ~D записями, из ~A, обновлён ~A.~%Веб-хук: ~A"
|
|
|
+ (length journal)
|
|
|
+ (ledger/format-uri uri)
|
|
|
+ (ledger/format-time ut)
|
|
|
+ (ledger/get-hook-url *chat-id*))
|
|
|
:disable-web-preview t)))
|
|
|
- (bot-send-message chat-id "Добавь журнал: uri - /ledger <url>; git - /ledger <remote> <path>"))))
|
|
|
+ (bot-send-message "Добавь журнал: uri - /ledger <url>; git - /ledger <remote> <path>"))))
|
|
|
|
|
|
-(defun ledger/handle-set-info (chat-id info)
|
|
|
- (setf (gethash chat-id *ledger/chat-journals*) nil)
|
|
|
+(defun ledger/handle-set-info (info)
|
|
|
+ (setf (gethash *chat-id* *ledger/chat-journals*) nil)
|
|
|
(handler-case
|
|
|
(destructuring-bind (journal . ut)
|
|
|
- (get-chat-journal-info chat-id info)
|
|
|
+ (get-chat-journal-info *chat-id* info)
|
|
|
(declare (ignore ut))
|
|
|
- (secret-set (list :ledger chat-id) info)
|
|
|
- (bot-send-message chat-id (format nil "Добавил журнал с ~D записями. Веб-хук для обновления: ~A"
|
|
|
- (length journal)
|
|
|
- (ledger/get-hook-url chat-id))))
|
|
|
+ (secret-set (list :ledger *chat-id*) info)
|
|
|
+ (bot-send-message (format nil "Добавил журнал с ~D записями. Веб-хук для обновления: ~A"
|
|
|
+ (length journal)
|
|
|
+ (ledger/get-hook-url *chat-id*))))
|
|
|
(pta-ledger:journal-failed (e)
|
|
|
- (bot-send-message chat-id (format nil "Не смог спарсить: ~A" e)))
|
|
|
+ (bot-send-message (format nil "Не смог спарсить: ~A" e)))
|
|
|
(dex:http-request-failed (e)
|
|
|
- (bot-send-message chat-id (format nil "Не смог в урл: ~A" (dex:response-body e))))))
|
|
|
-
|
|
|
+ (bot-send-message (format nil "Не смог в урл: ~A" (dex:response-body e))))))
|
|
|
|
|
|
(def-message-cmd-handler handler-ledger (:ledger)
|
|
|
(cond
|
|
|
- ((<= 1 (length args) 2) (ledger/handle-set-info chat-id args))
|
|
|
- (:otherwise (ledger/handle-info chat-id))))
|
|
|
+ ((<= 1 (length *args*) 2) (ledger/handle-set-info *args*))
|
|
|
+ (:otherwise (ledger/handle-info))))
|
|
|
|
|
|
(defmacro with-chat-journal ((chat-id journal updated) &body body)
|
|
|
(let ((info (gensym "info")))
|
|
|
@@ -161,12 +160,12 @@
|
|
|
(destructuring-bind (,journal . ,updated) ,info
|
|
|
(declare (ignorable ,journal ,updated))
|
|
|
,@body)
|
|
|
- (bot-send-message ,chat-id "Добавь журнал: uri - /ledger <url>; git - /ledger <remote> <path>")))))
|
|
|
+ (bot-send-message "Добавь журнал: uri - /ledger <url>; git - /ledger <remote> <path>"
|
|
|
+ :chat-id chat-id)))))
|
|
|
|
|
|
-(defun ledger/handle-balance (chat-id query)
|
|
|
- (with-chat-journal (chat-id journal updated)
|
|
|
- (bot-send-message chat-id
|
|
|
- (text-chunks (split-sequence:split-sequence
|
|
|
+(defun ledger/handle-balance (query)
|
|
|
+ (with-chat-journal (*chat-id* journal updated)
|
|
|
+ (bot-send-message (text-chunks (split-sequence:split-sequence
|
|
|
#\Newline
|
|
|
(or (pta-ledger:journal-balance journal query)
|
|
|
"Не нашлось"))
|
|
|
@@ -176,69 +175,67 @@
|
|
|
|
|
|
(def-message-cmd-handler handler-balance (:balance :bal :budget)
|
|
|
(cond
|
|
|
- ((null args) (ledger/handle-balance chat-id (if (eql cmd :budget) "budget" "assets")))
|
|
|
- (:otherwise (ledger/handle-balance chat-id (spaced args)))))
|
|
|
+ ((null *args*) (ledger/handle-balance (if (eql *cmd* :budget) "budget" "assets")))
|
|
|
+ (:otherwise (ledger/handle-balance (spaced *args*)))))
|
|
|
|
|
|
-(defun ledger/handle-journal (chat-id query)
|
|
|
- (with-chat-journal (chat-id journal updated)
|
|
|
+(defun ledger/handle-journal (query)
|
|
|
+ (with-chat-journal (*chat-id* journal updated)
|
|
|
(let* ((pta-ledger:*posting-length* 40)
|
|
|
(entries (pta-ledger:journal-print journal query))
|
|
|
(len (length entries))
|
|
|
(count (min len 50)))
|
|
|
- (bot-send-message chat-id
|
|
|
- (if entries
|
|
|
+ (bot-send-message (if entries
|
|
|
(text-chunks (subseq entries (- len count) len))
|
|
|
"Не нашлось")
|
|
|
:parse-mode "markdown"))))
|
|
|
|
|
|
(def-message-cmd-handler handler-journal (:journal)
|
|
|
(cond
|
|
|
- ((null args) (ledger/handle-journal chat-id "date:thisweek"))
|
|
|
- (:otherwise (ledger/handle-journal chat-id (spaced args)))))
|
|
|
+ ((null *args*) (ledger/handle-journal "date:thisweek"))
|
|
|
+ (:otherwise (ledger/handle-journal (spaced *args*)))))
|
|
|
|
|
|
(def-message-cmd-handler hander-add-report (:add_report)
|
|
|
- (bot-send-message chat-id "Введи название"
|
|
|
+ (bot-send-message "Введи название"
|
|
|
: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 "Добавил"))))))))
|
|
|
+ (on-next-message
|
|
|
+ (let ((name *text*))
|
|
|
+ (bot-send-message "Введи запрос"
|
|
|
+ :reply-markup (telegram-force-reply))
|
|
|
+ (on-next-message
|
|
|
+ (let ((query *text*))
|
|
|
+ (pta-ledger:parse-query query) ;; Validate query
|
|
|
+ (bot-send-message "Введи расписание, ex: (:day-of-week 0 :hour 10), (:day * :hour 10)"
|
|
|
+ :reply-markup (telegram-force-reply))
|
|
|
+ (on-next-message
|
|
|
+ (let* ((schedule *text*))
|
|
|
+ (add-chat-cron :ledger-report *chat-id* schedule name query)
|
|
|
+ (bot-send-message "Добавил"))))))))
|
|
|
|
|
|
(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
|
|
|
+ (bot-send-message (text-chunks (split-sequence:split-sequence
|
|
|
#\Newline
|
|
|
(format nil "*~A*~%~%~A" name
|
|
|
(pta-ledger:journal-balance journal query)))
|
|
|
:text-sep "
|
|
|
")
|
|
|
- :parse-mode "markdown")))
|
|
|
+ :parse-mode "markdown"
|
|
|
+ :chat-id chat-id)))
|
|
|
|
|
|
(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)))
|
|
|
+ (let ((crons (get-chat-crons :ledger-report *chat-id*)))
|
|
|
(if crons
|
|
|
(bot-send-message
|
|
|
- chat-id (format nil "Отчёты~%~%~{~A) ~A _~A_: ~A~^~%~}"
|
|
|
- (loop for (schedule name query) in crons
|
|
|
- for idx from 1
|
|
|
- append (list idx name schedule query)))
|
|
|
+ (format nil "Отчёты~%~%~{~A) ~A _~A_: ~A~^~%~}"
|
|
|
+ (loop for (schedule name query) in crons
|
|
|
+ for idx from 1
|
|
|
+ append (list idx name schedule query)))
|
|
|
:parse-mode "markdown"
|
|
|
:reply-markup
|
|
|
(get-inline-keyboard
|
|
|
- chat-id
|
|
|
(append
|
|
|
(loop for (schedule name query) in crons
|
|
|
for idx from 0
|
|
|
@@ -246,16 +243,17 @@
|
|
|
(let ((cron-index idx)
|
|
|
(cron-name name))
|
|
|
(list (inline-button ((format nil "Удалить '~A'" cron-name))
|
|
|
- (delete-chat-cron :ledger-report chat-id cron-index)
|
|
|
+ (delete-chat-cron :ledger-report *source-chat-id* cron-index)
|
|
|
(telegram-edit-message-reply-markup
|
|
|
- nil :chat-id source-chat-id :message-id source-message-id)
|
|
|
- (bot-send-message chat-id (format nil "Удалил *~A*" cron-name)
|
|
|
+ nil :chat-id *source-chat-id* :message-id *source-message-id*)
|
|
|
+ (bot-send-message (format nil "Удалил *~A*" cron-name)
|
|
|
+ :chat-id *source-chat-id*
|
|
|
:parse-mode "markdown")))))
|
|
|
(list (list (inline-button ("Отмена")
|
|
|
(telegram-edit-message-reply-markup
|
|
|
- nil :chat-id source-chat-id :message-id source-message-id)))))))
|
|
|
+ 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)))))
|
|
|
|
|
|
@@ -329,16 +327,15 @@
|
|
|
|
|
|
(def-message-cmd-handler handler-create (:rub :usd :eur :thb :btc :czk)
|
|
|
(cond
|
|
|
- ((>= (length args) 2)
|
|
|
- (ledger/new-chat-entry chat-id (create-entry chat-id
|
|
|
- (spaced (subseq args 1))
|
|
|
- (parse-float (car args))
|
|
|
- (symbol-name cmd))))
|
|
|
- (:otherwise (bot-send-message chat-id (format nil "/~A <amount> <description>" cmd)))))
|
|
|
+ ((>= (length *args*) 2)
|
|
|
+ (ledger/new-chat-entry *chat-id* (create-entry *chat-id*
|
|
|
+ (spaced (subseq *args* 1))
|
|
|
+ (parse-float (car *args*)))))
|
|
|
+ (:otherwise (bot-send-message format nil "/~A <amount> <description>" *cmd*))))
|
|
|
|
|
|
(def-webhook-handler ledger/handle-webhook ("ledger")
|
|
|
- (when (= 2 (length paths))
|
|
|
- (destructuring-bind (chat-id hmac) paths
|
|
|
+ (when (= 2 (length *paths*))
|
|
|
+ (destructuring-bind (chat-id hmac) *paths*
|
|
|
(let ((true-hmac (token-hmac chat-id)))
|
|
|
(when (string= true-hmac hmac)
|
|
|
(with-secret (info (list :ledger chat-id))
|
|
|
@@ -380,7 +377,8 @@
|
|
|
(defun ledger/new-chat-entry (chat-id entry)
|
|
|
(let ((entry (extend-entry! chat-id entry)))
|
|
|
(bot-send-message
|
|
|
- chat-id (format-entry entry)
|
|
|
+ (format-entry entry)
|
|
|
+ :chat-id chat-id
|
|
|
:parse-mode "markdown"
|
|
|
:reply-markup (keyboard/entry chat-id entry))))
|
|
|
|
|
|
@@ -394,18 +392,17 @@
|
|
|
|
|
|
(defun keyboard/entry (chat-id entry)
|
|
|
(get-inline-keyboard
|
|
|
- chat-id
|
|
|
(list
|
|
|
(list (inline-button ("➕")
|
|
|
- (telegram-answer-callback-query query-id :text "Добавляю...")
|
|
|
- (telegram-send-message source-chat-id (ledger/process-add-entry
|
|
|
- source-chat-id from entry))
|
|
|
+ (telegram-answer-callback-query *query-id* :text "Добавляю...")
|
|
|
+ (telegram-send-message *source-chat-id* (ledger/process-add-entry
|
|
|
+ *source-chat-id* *from* entry))
|
|
|
(telegram-edit-message-reply-markup
|
|
|
- nil :chat-id source-chat-id :message-id source-message-id))
|
|
|
+ nil :chat-id *source-chat-id* :message-id *source-message-id*))
|
|
|
(inline-button ("💲")
|
|
|
- (entry-edit source-chat-id source-message-id entry))
|
|
|
+ (entry-edit *source-chat-id* *source-message-id* entry))
|
|
|
(inline-button ("✖️")
|
|
|
- (telegram-delete-message source-chat-id source-message-id))))))
|
|
|
+ (telegram-delete-message *source-chat-id* *source-message-id*))))))
|
|
|
|
|
|
(defun def (str default)
|
|
|
(if (or (null str) (string= "" str)) default
|
|
|
@@ -413,57 +410,56 @@
|
|
|
|
|
|
(defun keyboard/edit-entry (chat-id entry)
|
|
|
(get-inline-keyboard
|
|
|
- chat-id
|
|
|
(append
|
|
|
(list
|
|
|
(list (inline-button ((format-date (pta-ledger:entry-date entry)))
|
|
|
- (bot-send-message chat-id "Введите дату"
|
|
|
+ (bot-send-message "Введите дату" :chat-id chat-id
|
|
|
:reply-markup (telegram-force-reply))
|
|
|
- (on-next-message chat-id
|
|
|
- (let ((date (pta-ledger:parse-date text (get-year
|
|
|
- (pta-ledger:entry-date entry)))))
|
|
|
- (if date
|
|
|
- (progn
|
|
|
- (setf (pta-ledger:entry-date entry) date)
|
|
|
- (entry-edit chat-id source-message-id entry))
|
|
|
- (bot-send-message chat-id "Не разобрал")))))
|
|
|
+ (on-next-message
|
|
|
+ (let ((date (pta-ledger:parse-date *text* (get-year
|
|
|
+ (pta-ledger:entry-date entry)))))
|
|
|
+ (if date
|
|
|
+ (progn
|
|
|
+ (setf (pta-ledger:entry-date entry) date)
|
|
|
+ (entry-edit chat-id *source-message-id* entry))
|
|
|
+ (bot-send-message "Не разобрал" :chat-id chat-id)))))
|
|
|
(inline-button ((def (pta-ledger:entry-description entry) "Описание"))
|
|
|
- (bot-send-message chat-id "Введите описание"
|
|
|
+ (bot-send-message "Введите описание" :chat-id chat-id
|
|
|
:reply-markup (telegram-force-reply))
|
|
|
- (on-next-message chat-id
|
|
|
- (setf (pta-ledger:entry-description entry) text)
|
|
|
- (entry-edit chat-id source-message-id entry)))
|
|
|
+ (on-next-message
|
|
|
+ (setf (pta-ledger:entry-description entry) *text*)
|
|
|
+ (entry-edit chat-id *source-message-id* entry)))
|
|
|
(inline-button ((def (pta-ledger:entry-comment entry) "Коммент"))
|
|
|
- (bot-send-message chat-id "Введите комментарий"
|
|
|
+ (bot-send-message "Введите комментарий" :chat-id chat-id
|
|
|
:reply-markup (telegram-force-reply))
|
|
|
- (on-next-message chat-id
|
|
|
- (setf (pta-ledger:entry-comment entry) text)
|
|
|
- (entry-edit chat-id source-message-id entry)))))
|
|
|
+ (on-next-message
|
|
|
+ (setf (pta-ledger:entry-comment entry) *text*)
|
|
|
+ (entry-edit chat-id *source-message-id* entry)))))
|
|
|
(loop for posting in (pta-ledger:entry-postings entry)
|
|
|
collect
|
|
|
(let ((this-posting posting))
|
|
|
(list (inline-button ((pta-ledger:posting-account posting))
|
|
|
- (account-edit chat-id source-message-id entry this-posting
|
|
|
+ (account-edit chat-id *source-message-id* entry this-posting
|
|
|
(pta-ledger:posting-account this-posting)))
|
|
|
(inline-button ((def (pta-ledger:render
|
|
|
(pta-ledger:posting-amount posting))
|
|
|
"Сумма"))
|
|
|
- (bot-send-message chat-id "Введите сумму"
|
|
|
+ (bot-send-message "Введите сумму" :chat-id chat-id
|
|
|
:reply-markup (telegram-force-reply))
|
|
|
- (on-next-message chat-id
|
|
|
- (let ((amount (pta-ledger:parse-amount text)))
|
|
|
- (setf (pta-ledger:posting-amount this-posting) amount
|
|
|
- (pta-ledger:posting-status this-posting) nil)
|
|
|
- (entry-edit chat-id source-message-id entry))))
|
|
|
+ (on-next-message
|
|
|
+ (let ((amount (pta-ledger:parse-amount *text*)))
|
|
|
+ (setf (pta-ledger:posting-amount this-posting) amount
|
|
|
+ (pta-ledger:posting-status this-posting) nil)
|
|
|
+ (entry-edit chat-id *source-message-id* entry))))
|
|
|
(inline-button ("❌")
|
|
|
(setf (pta-ledger:entry-postings entry)
|
|
|
(remove this-posting (pta-ledger:entry-postings entry)
|
|
|
:test #'equalp))
|
|
|
- (entry-edit chat-id source-message-id entry)))))
|
|
|
+ (entry-edit chat-id *source-message-id* entry)))))
|
|
|
(list (list (inline-button ("Готово")
|
|
|
(telegram-edit-message-reply-markup
|
|
|
(keyboard/entry chat-id entry)
|
|
|
- :chat-id chat-id :message-id source-message-id)))))))
|
|
|
+ :chat-id chat-id :message-id *source-message-id*)))))))
|
|
|
|
|
|
(defun accounts/nav (account accounts &optional (offset 0) (count 5))
|
|
|
(let* ((len (1+ (length account)))
|
|
|
@@ -513,43 +509,42 @@
|
|
|
|
|
|
(defun keyboard/account (chat-id entry posting account parent children prev next)
|
|
|
(get-inline-keyboard
|
|
|
- chat-id
|
|
|
(append
|
|
|
(list (list (when account
|
|
|
(inline-button (account)
|
|
|
(setf (pta-ledger:posting-account posting) account
|
|
|
(pta-ledger:posting-status posting) nil)
|
|
|
- (entry-edit chat-id source-message-id entry)))
|
|
|
+ (entry-edit chat-id *source-message-id* entry)))
|
|
|
(inline-button ("Ввести")
|
|
|
- (bot-send-message chat-id "Введите счёт"
|
|
|
+ (bot-send-message "Введите счёт" :chat-id chat-id
|
|
|
:reply-markup (telegram-force-reply))
|
|
|
- (on-next-message chat-id
|
|
|
- (let ((account (pta-ledger:parse-account text)))
|
|
|
- (if account
|
|
|
- (progn
|
|
|
- (setf (pta-ledger:posting-account posting) account
|
|
|
- (pta-ledger:posting-status posting) nil)
|
|
|
- (entry-edit chat-id source-message-id entry))
|
|
|
- (bot-send-message chat-id "Не разобрал")))))))
|
|
|
+ (on-next-message
|
|
|
+ (let ((account (pta-ledger:parse-account *text*)))
|
|
|
+ (if account
|
|
|
+ (progn
|
|
|
+ (setf (pta-ledger:posting-account posting) account
|
|
|
+ (pta-ledger:posting-status posting) nil)
|
|
|
+ (entry-edit chat-id *source-message-id* entry))
|
|
|
+ (bot-send-message "Не разобрал" :chat-id chat-id)))))))
|
|
|
(loop for (acc . leaf) in children
|
|
|
collect (let ((this-account acc))
|
|
|
(list (if leaf
|
|
|
(inline-button (this-account)
|
|
|
(setf (pta-ledger:posting-account posting) this-account
|
|
|
(pta-ledger:posting-status posting) nil)
|
|
|
- (entry-edit chat-id source-message-id entry))
|
|
|
+ (entry-edit chat-id *source-message-id* entry))
|
|
|
(inline-button ((format nil "~A ..." this-account))
|
|
|
- (account-edit chat-id source-message-id entry posting
|
|
|
+ (account-edit chat-id *source-message-id* entry posting
|
|
|
this-account))))))
|
|
|
(list (list (when prev
|
|
|
(inline-button ("<<")
|
|
|
- (account-edit chat-id source-message-id entry posting
|
|
|
+ (account-edit chat-id *source-message-id* entry posting
|
|
|
account prev)))
|
|
|
(when (or parent account)
|
|
|
(inline-button ((or parent "ACC"))
|
|
|
- (account-edit chat-id source-message-id entry posting
|
|
|
+ (account-edit chat-id *source-message-id* entry posting
|
|
|
parent account)))
|
|
|
(when next
|
|
|
(inline-button (">>")
|
|
|
- (account-edit chat-id source-message-id entry posting
|
|
|
+ (account-edit chat-id *source-message-id* entry posting
|
|
|
account next))))))))
|