|
|
@@ -3,9 +3,7 @@
|
|
|
(defsetting *saver-default-timezone* -3 "Default timezone for *saver-notify-hour* calculation. GMT+3")
|
|
|
(defsetting *saver-notify-hour* 11 "Notify with upcoming payments and saves at this time")
|
|
|
|
|
|
-(defstruct saver/payment name amount schedule started)
|
|
|
-
|
|
|
-(defun saver/parse-schedule (schedule)
|
|
|
+(defun %saver/parse-schedule (schedule)
|
|
|
(labels ((parse (text &optional def-min def-max)
|
|
|
(let ((dash-pos (position #\- text))
|
|
|
(star-pos (position #\* text))
|
|
|
@@ -24,7 +22,7 @@
|
|
|
(if month-sched (parse month-sched 1 12) (list nil 1 12))
|
|
|
(if year-sched (parse year-sched 1900) (list nil 1900))))))
|
|
|
|
|
|
-(defun saver/get-next-time (schedule universal-time &optional (dir t))
|
|
|
+(defun %saver/get-next-time (schedule universal-time &optional (dir t))
|
|
|
(labels ((leapp (year)
|
|
|
(or (and (zerop (mod year 4))
|
|
|
(not (zerop (mod year 100))))
|
|
|
@@ -85,48 +83,78 @@
|
|
|
next-month
|
|
|
next-year))))))))))
|
|
|
|
|
|
-(defun saver/count-events (from to schedule)
|
|
|
- (loop for ut = (saver/get-next-time schedule from) then (saver/get-next-time
|
|
|
- schedule (+ ut 86400))
|
|
|
+(defstruct saver/payment name amount schedule started)
|
|
|
+
|
|
|
+(defun saver/payment-income-p (payment)
|
|
|
+ (> (saver/payment-amount payment) 0))
|
|
|
+
|
|
|
+(defun saver/payment-next-time (payment moment &optional (dir t))
|
|
|
+ (%saver/get-next-time (%saver/parse-schedule (saver/payment-schedule payment)) moment dir))
|
|
|
+
|
|
|
+(defun saver/payment-count-events (payment from to)
|
|
|
+ (loop for ut = (saver/payment-next-time payment from) then (saver/payment-next-time payment (+ ut 86400))
|
|
|
while (< ut to)
|
|
|
counting ut))
|
|
|
|
|
|
-(defun saver/get-payment-info (payment salary &optional (moment (get-universal-time)))
|
|
|
- (let* ((salary (saver/parse-schedule salary))
|
|
|
- (schedule (saver/parse-schedule (saver/payment-schedule payment)))
|
|
|
- (next-payment (saver/get-next-time schedule moment))
|
|
|
- (prev-payment (max (saver/get-next-time schedule moment nil)
|
|
|
+(defun saver/find-next-payment (payments &optional (moment (get-universal-time)))
|
|
|
+ (loop for payment in payments
|
|
|
+ for next-time = (saver/payment-next-time payment moment)
|
|
|
+ with closest-time and closest-payment
|
|
|
+ when (and next-time
|
|
|
+ (or (null closest-time)
|
|
|
+ (< next-time closest-time)))
|
|
|
+ do (setf closest-time next-time
|
|
|
+ closest-payment payment)
|
|
|
+ finally (return closest-payment)))
|
|
|
+
|
|
|
+(defun saver/get-expense-info (payment incomes &optional (moment (get-universal-time)))
|
|
|
+ (let* ((next-payment (saver/payment-next-time payment moment))
|
|
|
+ (prev-payment (max (saver/payment-next-time payment moment nil)
|
|
|
(or (saver/payment-started payment) 0))))
|
|
|
(when next-payment
|
|
|
- (let* ((total-periods (saver/count-events prev-payment next-payment salary))
|
|
|
- (saved-periods (saver/count-events prev-payment moment salary))
|
|
|
- (period-amount (floor (saver/payment-amount payment) (max 1 total-periods)))
|
|
|
- (saved-amount (* saved-periods period-amount)))
|
|
|
- (list :next-payment next-payment
|
|
|
- :prev-payment prev-payment
|
|
|
- :total-periods total-periods
|
|
|
- :period-amount period-amount
|
|
|
- :saved-periods saved-periods
|
|
|
- :saved-amount saved-amount
|
|
|
- :left-periods (- total-periods saved-periods)
|
|
|
- :left-amount (- (saver/payment-amount payment) saved-amount))))))
|
|
|
-
|
|
|
-(defun saver/get-period-info (salary payments &optional (moment (get-universal-time)))
|
|
|
- (let ((next-salary (saver/get-next-time (saver/parse-schedule salary) moment)))
|
|
|
- (when next-salary
|
|
|
- (loop for payment in payments
|
|
|
- for cur-info = (saver/get-payment-info payment salary moment)
|
|
|
- for next-info = (saver/get-payment-info payment salary next-salary)
|
|
|
- summing (getf cur-info :saved-amount) into total-saved
|
|
|
- summing (getf cur-info :left-amount) into total-left
|
|
|
- summing (if (> (getf next-info :left-periods) 1)
|
|
|
- (getf next-info :period-amount)
|
|
|
- (getf next-info :left-amount)) into total-period
|
|
|
- finally (return
|
|
|
- (list :next-salary next-salary
|
|
|
- :total-saved total-saved
|
|
|
- :total-left total-left
|
|
|
- :total-period total-period))))))
|
|
|
+ (multiple-value-bind (total-periods total-income)
|
|
|
+ (loop for income in incomes
|
|
|
+ for periods = (saver/payment-count-events income prev-payment next-payment)
|
|
|
+ summing periods into total-periods
|
|
|
+ summing (* periods (saver/payment-amount income)) into total-income
|
|
|
+ finally (return (values total-periods total-income)))
|
|
|
+ (let ((payment-income-fracture (/ (saver/payment-amount payment) total-income -1)))
|
|
|
+ (loop for income in incomes
|
|
|
+ for periods = (saver/payment-count-events income prev-payment moment)
|
|
|
+ summing periods into saved-periods
|
|
|
+ summing (floor (* periods (saver/payment-amount income)
|
|
|
+ payment-income-fracture)) into saved-amount
|
|
|
+ finally (return
|
|
|
+ (list :next-payment next-payment
|
|
|
+ :prev-payment prev-payment
|
|
|
+ :total-periods total-periods
|
|
|
+ :total-income total-income
|
|
|
+ :payment-income-fracture payment-income-fracture
|
|
|
+ :saved-periods saved-periods
|
|
|
+ :saved-amount (if (= total-periods saved-periods)
|
|
|
+ (* -1 (saver/payment-amount payment))
|
|
|
+ saved-amount)
|
|
|
+ :left-periods (- total-periods saved-periods)
|
|
|
+ :left-amount (if (= total-periods saved-periods) 0
|
|
|
+ (- (- 0 (saver/payment-amount payment))
|
|
|
+ saved-amount))))))))))
|
|
|
+
|
|
|
+
|
|
|
+(defun saver/get-income-info (income payments &optional (moment (get-universal-time)))
|
|
|
+ (let ((incomes (remove-if-not #'saver/payment-income-p payments))
|
|
|
+ (expenses (remove-if #'saver/payment-income-p payments)))
|
|
|
+ (loop for payment in expenses
|
|
|
+ for cur-info = (saver/get-expense-info payment incomes moment)
|
|
|
+ for nxt-info = (saver/get-expense-info payment incomes (saver/payment-next-time income moment))
|
|
|
+ summing (getf cur-info :saved-amount) into cur-saved
|
|
|
+ summing (getf cur-info :left-amount) into cur-left
|
|
|
+ summing (if (> (getf nxt-info :left-periods) 1)
|
|
|
+ (floor (* (saver/payment-amount income) (getf cur-info :payment-income-fracture)))
|
|
|
+ (getf nxt-info :left-amount)) into next-save
|
|
|
+ finally (return
|
|
|
+ (list :cur-saved cur-saved
|
|
|
+ :cur-left cur-left
|
|
|
+ :next-save next-save)))))
|
|
|
|
|
|
(defun %saver/format-time (universal-time)
|
|
|
(when universal-time
|
|
|
@@ -138,9 +166,7 @@
|
|
|
;; Database
|
|
|
(def-db-init
|
|
|
(db-execute "create table if not exists saver_payments (chat_id, name, amount, schedule, started, notified)")
|
|
|
- (db-execute "create unique index if not exists saver_payments_chat_id_name_idx on saver_payments (chat_id, name)")
|
|
|
- (db-execute "create table if not exists saver_salaries (chat_id, schedule, notified)")
|
|
|
- (db-execute "create unique index if not exists saver_salaries_chat_id_idx on saver_salaries (chat_id)"))
|
|
|
+ (db-execute "create unique index if not exists saver_payments_chat_id_name_idx on saver_payments (chat_id, name)"))
|
|
|
|
|
|
(defun %db/saver/make-payment (row)
|
|
|
(when row
|
|
|
@@ -151,15 +177,7 @@
|
|
|
|
|
|
(defun db/saver/get-payments (chat-id)
|
|
|
(mapcar #'%db/saver/make-payment
|
|
|
- (db-select "select name, amount, schedule, started from saver_payments where chat_id = ? order by started" chat-id)))
|
|
|
-
|
|
|
-(defun db/saver/get-not-notified-payments (notified)
|
|
|
- (loop for row in (db-select "select name, amount, schedule, started, chat_id from saver_payments where notified is null or notified != ?" (%saver/format-time notified))
|
|
|
- collect (cons (nth 4 row) (%db/saver/make-payment row))))
|
|
|
-
|
|
|
-(defun db/saver/set-payment-notified (chat-id name moment)
|
|
|
- (db-execute "update saver_payments set notified = ? where chat_id = ? and name = ?"
|
|
|
- (%saver/format-time moment) chat-id name))
|
|
|
+ (db-select "select name, amount, schedule, started from saver_payments where chat_id = ? order by amount > 0, started" chat-id)))
|
|
|
|
|
|
(defun db/saver/add-payment (chat-id payment)
|
|
|
(with-slots (name amount schedule started) payment
|
|
|
@@ -169,128 +187,110 @@
|
|
|
(defun db/saver/del-payment (chat-id name)
|
|
|
(db-execute "delete from saver_payments where chat_id = ? and name = ?" chat-id name))
|
|
|
|
|
|
-(defun db/saver/get-salary (chat-id)
|
|
|
- (caar (db-select "select schedule from saver_salaries where chat_id = ?" chat-id)))
|
|
|
-
|
|
|
-(defun db/saver/get-not-notified-salaries (notified)
|
|
|
- (loop for row in (db-select "select chat_id, schedule from saver_salaries where notified is null or notified != ?" (%saver/format-time notified))
|
|
|
- collect (cons (nth 0 row) (nth 1 row))))
|
|
|
+(defun db/saver/get-not-notified-payments (notified)
|
|
|
+ (loop for row in (db-select "select name, amount, schedule, started, chat_id from saver_payments where notified is null or notified != ?" (%saver/format-time notified))
|
|
|
+ collect (cons (nth 4 row) (%db/saver/make-payment row))))
|
|
|
|
|
|
-(defun db/saver/set-salary-notified (chat-id moment)
|
|
|
- (db-execute "update saver_salaries set notified = ? where chat_id = ?"
|
|
|
- (%saver/format-time moment) chat-id))
|
|
|
+(defun db/saver/set-payment-notified (chat-id name moment)
|
|
|
+ (db-execute "update saver_payments set notified = ? where chat_id = ? and name = ?"
|
|
|
+ (%saver/format-time moment) chat-id name))
|
|
|
|
|
|
-(defun db/saver/set-salary (chat-id schedule)
|
|
|
- (db-transaction
|
|
|
- (db-execute "delete from saver_salaries where chat_id = ?" chat-id)
|
|
|
- (db-execute "insert into saver_salaries (chat_id, schedule) values (?, ?)" chat-id schedule)))
|
|
|
|
|
|
;; Cron
|
|
|
(defun saver/find-today-payments (&optional (moment (get-universal-time)))
|
|
|
(remove-if-not (lambda (p) (string= (%saver/format-time moment)
|
|
|
(%saver/format-time
|
|
|
- (saver/get-next-time
|
|
|
- (saver/parse-schedule (saver/payment-schedule p))
|
|
|
- moment))))
|
|
|
+ (saver/payment-next-time p moment))))
|
|
|
(db/saver/get-not-notified-payments moment)
|
|
|
:key #'cdr))
|
|
|
|
|
|
-(defun %saver/format-payment-notification (payment moment)
|
|
|
+(defun %saver/format-expense-notification (expense moment)
|
|
|
(format nil "'~A' надо оплатить *~A* на сумму _~$_"
|
|
|
- (saver/payment-name payment)
|
|
|
- (%saver/format-time moment)
|
|
|
- (/ (saver/payment-amount payment) 100)))
|
|
|
-
|
|
|
-(defun saver/find-today-salaries (&optional (moment (get-universal-time)))
|
|
|
- (remove-if-not (lambda (p) (string= (%saver/format-time moment)
|
|
|
- (%saver/format-time (saver/get-next-time
|
|
|
- (saver/parse-schedule p) moment))))
|
|
|
- (db/saver/get-not-notified-salaries moment)
|
|
|
- :key #'cdr))
|
|
|
+ (saver/payment-name expense)
|
|
|
+ (%saver/format-time (saver/payment-next-time expense moment))
|
|
|
+ (/ (saver/payment-amount expense) -100)))
|
|
|
|
|
|
-(defun %saver/format-salary-notification (salary payments moment)
|
|
|
- (let ((period-info (saver/get-period-info salary payments moment)))
|
|
|
- (format nil "*~A* зарплата. Отложи _~$_!"
|
|
|
- (%saver/format-time (getf period-info :next-salary))
|
|
|
- (/ (getf period-info :total-period) 100))))
|
|
|
+(defun %saver/format-income-notification (income payments moment)
|
|
|
+ (let ((income-info (saver/get-income-info income payments moment)))
|
|
|
+ (format nil "*~A* ~A. Отложи _~$_!"
|
|
|
+ (%saver/format-time (saver/payment-next-time income moment))
|
|
|
+ (saver/payment-name income)
|
|
|
+ (/ (getf income-info :next-save) 100))))
|
|
|
|
|
|
(defun %saver/is-ok-to-notify (chat-id &optional (moment (get-universal-time)))
|
|
|
- (let ((tz (or
|
|
|
- (when (boundp '*chat-locations*)
|
|
|
- (let ((chat-loc (aget chat-id (symbol-value '*chat-locations*))))
|
|
|
- (when chat-loc
|
|
|
- (round (- 7.5 (aget "latitude" chat-loc)) 15)))) ;; Nautical time
|
|
|
- *saver-default-timezone*)))
|
|
|
+ (let ((tz (or (alexandria:when-let
|
|
|
+ (chat-loc (aget chat-id (and (boundp '*chat-locations*) (symbol-value '*chat-locations*))))
|
|
|
+ (round (- 7.5 (aget "latitude" chat-loc)) 15)) ;; Nautical time
|
|
|
+ *saver-default-timezone*)))
|
|
|
(>= (nth 2 (multiple-value-list (decode-universal-time moment tz)))
|
|
|
*saver-notify-hour*)))
|
|
|
|
|
|
(defcron process-saver (:hour '*)
|
|
|
(let ((moment (get-universal-time)))
|
|
|
- (dolist (cp (saver/find-today-payments moment))
|
|
|
- (when (%saver/is-ok-to-notify (car cp) moment)
|
|
|
- (db-transaction
|
|
|
- (bot-send-message (car cp) (%saver/format-payment-notification (cdr cp) moment) :parse-mode "markdown")
|
|
|
- (db/saver/set-payment-notified (car cp) (saver/payment-name (cdr cp)) moment))))
|
|
|
- (dolist (cs (saver/find-today-salaries moment))
|
|
|
- (when (%saver/is-ok-to-notify (car cs) moment)
|
|
|
- (db-transaction
|
|
|
- (bot-send-message (car cs)
|
|
|
- (%saver/format-salary-notification (cdr cs)
|
|
|
- (db/saver/get-payments (car cs))
|
|
|
- moment)
|
|
|
- :parse-mode "markdown")
|
|
|
- (db/saver/set-salary-notified (car cs) moment))))))
|
|
|
+ (loop for (chat-id . payment) in (saver/find-today-payments moment)
|
|
|
+ when (%saver/is-ok-to-notify chat-id moment)
|
|
|
+ do (let ((payments (db/saver/get-payments chat-id)))
|
|
|
+ (db-transaction
|
|
|
+ (bot-send-message chat-id
|
|
|
+ (if (saver/payment-income-p payment)
|
|
|
+ (%saver/format-income-notification payment payments moment)
|
|
|
+ (%saver/format-expense-notification payment moment))
|
|
|
+ :parse-mode "markdown")
|
|
|
+ (db/saver/set-payment-notified chat-id (saver/payment-name payment) moment))))))
|
|
|
|
|
|
|
|
|
;; Bot subcommands
|
|
|
-(defun %saver/format-info (payments salary &optional (moment (get-universal-time)))
|
|
|
- (let* (closest-time
|
|
|
- closest-payment
|
|
|
- (payments-info
|
|
|
- (loop for payment in payments
|
|
|
+(defun %saver/format-info (payments &optional (moment (get-universal-time)))
|
|
|
+ (let* ((expenses (remove-if #'saver/payment-income-p payments))
|
|
|
+ (incomes (remove-if-not #'saver/payment-income-p payments))
|
|
|
+ (expenses-info
|
|
|
+ (loop for payment in expenses
|
|
|
for idx from 1
|
|
|
- for info = (saver/get-payment-info payment salary moment)
|
|
|
+ for info = (saver/get-expense-info payment incomes moment)
|
|
|
when info
|
|
|
- when (or (null closest-time)
|
|
|
- (< (getf info :next-payment) closest-time))
|
|
|
- do (setf closest-time (getf info :next-payment)
|
|
|
- closest-payment payment)
|
|
|
- collect (format nil "~D) ~A по [[~A]]: накоплено _~$_ из _~$_, осталось _~$_ за ~A платежа"
|
|
|
+ collect (format nil "~D) ~A по [[~A]]: накоплено _~$_ из _~$_, осталось _~$_ к *~A* за ~A платежа"
|
|
|
idx
|
|
|
(saver/payment-name payment)
|
|
|
(saver/payment-schedule payment)
|
|
|
(/ (getf info :saved-amount) 100)
|
|
|
- (/ (saver/payment-amount payment) 100)
|
|
|
+ (/ (saver/payment-amount payment) -100)
|
|
|
(/ (getf info :left-amount) 100)
|
|
|
+ (%saver/format-time (saver/payment-next-time payment moment))
|
|
|
(getf info :left-periods))))
|
|
|
- (period-info (saver/get-period-info salary payments moment)))
|
|
|
- (if payments-info
|
|
|
- (format nil "*Платежи*~%~{~A~^~%~}~%~%Накоплено должно быть _~$_~%Следующее накопление *~A* на _~$_~%Следующий платёж '~A' *~A*, _~$_"
|
|
|
- payments-info
|
|
|
- (/ (getf period-info :total-saved) 100)
|
|
|
- (%saver/format-time (getf period-info :next-salary))
|
|
|
- (/ (getf period-info :total-period) 100)
|
|
|
- (saver/payment-name closest-payment)
|
|
|
- (%saver/format-time closest-time)
|
|
|
- (/ (saver/payment-amount closest-payment) 100))
|
|
|
+ (closest-expense (saver/find-next-payment expenses moment))
|
|
|
+ (incomes-info
|
|
|
+ (loop for payment in incomes
|
|
|
+ for idx from (1+ (length expenses))
|
|
|
+ for info = (saver/get-income-info payment payments moment)
|
|
|
+ when info
|
|
|
+ collect (format nil "~D) ~A по [[~A]]: отложить _~$_ *~A*"
|
|
|
+ idx
|
|
|
+ (saver/payment-name payment)
|
|
|
+ (saver/payment-schedule payment)
|
|
|
+ (/ (getf info :next-save) 100)
|
|
|
+ (%saver/format-time (saver/payment-next-time payment moment)))))
|
|
|
+ (closest-income (saver/find-next-payment incomes moment))
|
|
|
+ (closest-income-info (and closest-income (saver/get-income-info closest-income payments moment))))
|
|
|
+ (if (or expenses-info incomes-info)
|
|
|
+ (format nil "*Платежи*~%~{~A~^~%~}~%*Следующий платёж*~%'~A' *~A*, заплатить _~$_~%~%*Накопления*~%~{~A~^~%~}~%*Следующее накопление*~%'~A' *~A*, отложить _~$_~%~%*Накоплено должно быть* _~$_"
|
|
|
+ expenses-info
|
|
|
+ (and closest-expense (saver/payment-name closest-expense))
|
|
|
+ (and closest-expense (%saver/format-time (saver/payment-next-time closest-expense moment)))
|
|
|
+ (and closest-expense (/ (saver/payment-amount closest-expense) -100))
|
|
|
+ incomes-info
|
|
|
+ (and closest-income (saver/payment-name closest-income))
|
|
|
+ (and closest-income (%saver/format-time (saver/payment-next-time closest-income moment)))
|
|
|
+ (and closest-income-info (/ (getf closest-income-info :next-save) 100))
|
|
|
+ (and closest-income-info (/ (getf closest-income-info :cur-saved) 100)))
|
|
|
"Нет активных платежей.")))
|
|
|
|
|
|
(defun saver/send-info (chat-id)
|
|
|
- (let ((payments (db/saver/get-payments chat-id))
|
|
|
- (salary (db/saver/get-salary chat-id)))
|
|
|
- (if salary
|
|
|
- (if payments
|
|
|
- (bot-send-message chat-id (%saver/format-info payments salary) :parse-mode "markdown")
|
|
|
- (bot-send-message chat-id (format nil "Платежей нет, зарплата: ~A" salary)))
|
|
|
- (send-response chat-id "Зарплата не задана, /saver salary <cron>"))))
|
|
|
-
|
|
|
-(defun saver/set-salary (chat-id args)
|
|
|
- (let ((sched (spaced args)))
|
|
|
- (saver/parse-schedule sched)
|
|
|
- (db/saver/set-salary chat-id sched)
|
|
|
- (send-response chat-id (format nil "Зарплата теперь '~A'" sched))))
|
|
|
-
|
|
|
-(defparameter +saver/add-scanner+ (cl-ppcre:create-scanner "^(.+?) (\\d+(?:\\.\\d*)?) ((?:\\d+(?:,\\d+)*(?:-\\d+)?|\\*)(?:\\/\\d+)?(?: (?:\\d+(?:,\\d+)*(?:-\\d+)?|\\*)(?:\\/\\d+)?){0,2})(?: (\\d{4}-\\d{2}-\\d{2}))?$"))
|
|
|
+ (let ((payments (db/saver/get-payments chat-id)))
|
|
|
+ (if payments
|
|
|
+ (bot-send-message chat-id (%saver/format-info payments) :parse-mode "markdown")
|
|
|
+ (bot-send-message chat-id (format nil "Платежей нет, /saver add ...")))))
|
|
|
+
|
|
|
+(defparameter +saver/add-scanner+ (cl-ppcre:create-scanner "^(.+?) (-?\\d+(?:\\.\\d*)?) ((?:\\d+(?:,\\d+)*(?:-\\d+)?|\\*)(?:\\/\\d+)?(?: (?:\\d+(?:,\\d+)*(?:-\\d+)?|\\*)(?:\\/\\d+)?){0,2})(?: (\\d{4}-\\d{2}-\\d{2}))?$"))
|
|
|
|
|
|
(defun saver/add-payment (chat-id args)
|
|
|
(multiple-value-bind (matched groups) (cl-ppcre:scan-to-strings +saver/add-scanner+ (spaced args))
|
|
|
@@ -305,25 +305,26 @@
|
|
|
#\- (elt groups 3)))
|
|
|
(encode-universal-time 0 0 0 day month year))
|
|
|
(get-universal-time)))))
|
|
|
- (saver/get-next-time (saver/parse-schedule (saver/payment-schedule payment))
|
|
|
- (get-universal-time))
|
|
|
+ (saver/payment-next-time payment (get-universal-time))
|
|
|
(handler-case
|
|
|
(db/saver/add-payment chat-id payment)
|
|
|
- (error (e) (send-response chat-id (format nil "Платёж '~A' уже есть!"
|
|
|
+ (error () (send-response chat-id (format nil "Платёж '~A' уже есть!"
|
|
|
(saver/payment-name payment)))))
|
|
|
(saver/send-info chat-id))
|
|
|
(send-response chat-id "Неправильно. /saver add <title> <amount> <cron> [started]"))))
|
|
|
|
|
|
(defun saver/del-payment (chat-id args)
|
|
|
(handler-case
|
|
|
- (let ((payment (elt (db/saver/get-payments chat-id) (1- (parse-integer (car args)))))
|
|
|
- (salary (db/saver/get-salary chat-id)))
|
|
|
+ (let* ((payments (db/saver/get-payments chat-id))
|
|
|
+ (payment (elt payments (1- (parse-integer (car args)))))
|
|
|
+ (incomes (remove-if-not #'saver/payment-income-p payments)))
|
|
|
(db/saver/del-payment chat-id (saver/payment-name payment))
|
|
|
(bot-send-message chat-id
|
|
|
(format nil "'~A' удалил.~@[ Забрать _~$_ из накопленого.~]"
|
|
|
(saver/payment-name payment)
|
|
|
- (and salary
|
|
|
- (/ (getf (saver/get-payment-info payment salary) :saved-amount)
|
|
|
+ (and (not (saver/payment-income-p payment))
|
|
|
+ incomes
|
|
|
+ (/ (getf (saver/get-expense-info payment incomes) :saved-amount)
|
|
|
100)))
|
|
|
:parse-mode "markdown"))
|
|
|
(error (e) (send-response chat-id (format nil "/saver del <idx> [~A]" e)))))
|
|
|
@@ -333,7 +334,6 @@
|
|
|
(if (null args)
|
|
|
(saver/send-info chat-id)
|
|
|
(case (keyify (car args))
|
|
|
- (:salary (saver/set-salary chat-id (rest args)))
|
|
|
(:add (saver/add-payment chat-id (rest args)))
|
|
|
(:del (saver/del-payment chat-id (rest args)))
|
|
|
- (t (send-response chat-id "Чот не понял")))))
|
|
|
+ (t (send-response chat-id "Надо /saver add ... или /saver del <idx>")))))
|
