|
|
@@ -359,7 +359,7 @@
|
|
|
(car info) (cadr info)
|
|
|
(pta-ledger:render entry)
|
|
|
(ledger/format-add-entry-message from))
|
|
|
- "Добавил!")
|
|
|
+ (show-harshly))
|
|
|
(error (e)
|
|
|
(log:error "~A" e)
|
|
|
"Не смог :(")))
|
|
|
@@ -549,3 +549,56 @@
|
|
|
(parse-float (car *args*))
|
|
|
(symbol-name *cmd*))))
|
|
|
(:otherwise (bot-send-message (format nil "/~A <amount> <description>" *cmd*)))))
|
|
|
+
|
|
|
+(defun get-harshly-state (journal account day next-day)
|
|
|
+ (labels ((get-account-balance (query)
|
|
|
+ (car (gethash account
|
|
|
+ (apply #'pta-ledger:balance
|
|
|
+ (pta-ledger::entries journal)
|
|
|
+ (pta-ledger::parse-query query))))))
|
|
|
+ (let* ((left-days (ceiling (- next-day day) 86400))
|
|
|
+ (morning-balance (get-account-balance (format nil "~A date:-~A" account (format-date day))))
|
|
|
+ (balance (get-account-balance (format nil "~A date:-~A" account (format-date (+ day pta-ledger::+day+)))))
|
|
|
+ (today-amount (get-account-balance (format nil "amt:<0 ~A date:~A" account (format-date day))))
|
|
|
+ (daily-amount (if (zerop left-days) balance
|
|
|
+ (pta-ledger:make-amount
|
|
|
+ :quantity (/ (pta-ledger:amount-quantity morning-balance) left-days)
|
|
|
+ :commodity (pta-ledger:amount-commodity morning-balance))))
|
|
|
+ (left-today (pta-ledger:make-amount
|
|
|
+ :quantity (+ (pta-ledger:amount-quantity daily-amount)
|
|
|
+ (if today-amount (pta-ledger:amount-quantity today-amount) 0))
|
|
|
+ :commodity (pta-ledger:amount-commodity morning-balance)))
|
|
|
+ (overspent-today (< (pta-ledger:amount-quantity left-today) 0))
|
|
|
+ (overspent-daily (when (and overspent-today (> left-days 0))
|
|
|
+ (pta-ledger:make-amount
|
|
|
+ :quantity (/ (pta-ledger:amount-quantity balance) (1- left-days))
|
|
|
+ :commodity (pta-ledger:amount-commodity balance)))))
|
|
|
+ (list overspent-today left-days balance daily-amount today-amount left-today overspent-daily))))
|
|
|
+
|
|
|
+(defun format-harshly-state (state)
|
|
|
+ (destructuring-bind (overspent-today left-days balance daily-amount today-amount left-today overspent-daily)
|
|
|
+ state
|
|
|
+ (if overspent-today
|
|
|
+ (apply #'format nil "До зарплаты ~A дн, осталось ~A. Сегодня покутил на ~a и осталось теперь по ~a в день"
|
|
|
+ left-days
|
|
|
+ (mapcar #'pta-ledger:render (list balance today-amount overspent-daily)))
|
|
|
+ (if today-amount
|
|
|
+ (apply #'format nil "До зарплаты ~a дн, осталось ~A. Это по ~A в день. Сегодня уже слито ~a и осталось на сегодня ~A."
|
|
|
+ left-days
|
|
|
+ (mapcar #'pta-ledger:render (list balance daily-amount today-amount left-today)))
|
|
|
+ (apply #'format nil "До зарплаты ~a дн, осталось ~A. Это по ~A в день, на сегодня полностью."
|
|
|
+ left-days
|
|
|
+ (mapcar #'pta-ledger:render (list balance daily-amount)))))))
|
|
|
+
|
|
|
+(defvar *harshly-account* "assets:Raiffeisen:Debit")
|
|
|
+(defvar *harshly-payday-schedule* '(:day-of-month (member 5 20)))
|
|
|
+(defun show-harshly ()
|
|
|
+ (with-chat-journal (*chat-id* journal updated)
|
|
|
+ (format-harshly-state
|
|
|
+ (get-harshly-state
|
|
|
+ journal *harshly-account*
|
|
|
+ (get-universal-time)
|
|
|
+ (clon:next-time (apply #'clon:make-typed-cron-schedule
|
|
|
+ *harshly-payday-schedule*))))))
|
|
|
+(def-message-cmd-handler handler-harshly (:harshly :harsh)
|
|
|
+ (bot-send-message (show-harshly)))
|
