saver hooks and fixes

plugins/saver.lisp

@@ -1,5 +1,7 @@
 (in-package #:chatikbot)
 
+(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)
@@ -69,7 +71,8 @@
       (declare (ignore second minute hour dow dst-p tz))
       (destructuring-bind (&optional (day-rule '(nil 1 31)) (month-rule '(nil 1 12)) (year-rule '(nil 1900)))
           schedule
-        (multiple-value-bind (next-day of-day) (next (add day t) (clamp-day-rule day-rule month year))
+        (multiple-value-bind (next-day of-day) (next (add day (not dir))
+                                                     (clamp-day-rule day-rule month year))
           (multiple-value-bind (next-month of-month) (next (add month of-day) month-rule)
             (multiple-value-bind (next-year of-year) (next (add year of-month) year-rule)
               (unless of-year
@@ -82,7 +85,8 @@
                    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)
+  (loop for ut = (saver/get-next-time schedule from) then (saver/get-next-time
+                                                           schedule (+ ut 86400))
      while (< ut to)
      counting ut))
 
@@ -97,7 +101,9 @@
              (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 :total-periods total-periods
+        (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
@@ -107,11 +113,26 @@
 (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
-      (let ((total-period-amount
-             (loop for payment in payments
-                for info = (saver/get-payment-info payment salary moment)
-                summing (if (> (getf info :left-periods) 1) (getf info :period-amount) (getf info :left-amount)))))
-        (list :next-salary next-salary :total-period-amount total-period-amount)))))
+      (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))))))
+
+(defun %saver/format-time (universal-time)
+  (when universal-time
+    (multiple-value-bind (sec min hour day month year dow dst-p tz)
+        (decode-universal-time universal-time)
+      (declare (ignore sec min hour dow dst-p tz))
+      (format nil "~4,'0D-~2,'0D-~2,'0D" year month day))))
 
 ;; Database
 (def-db-init
@@ -131,6 +152,14 @@
   (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))
+
 (defun db/saver/add-payment (chat-id payment)
   (with-slots (name amount schedule started) payment
     (db-execute "insert into saver_payments (chat_id, name, amount, schedule, started) values (?, ?, ?, ?, ?)"
@@ -142,36 +171,97 @@
 (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/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-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
-;;;; TODO
+(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))))
+                 (db/saver/get-not-notified-payments moment)
+                 :key #'cdr))
+
+(defun %saver/format-payment-notification (payment moment)
+  (format nil "'~A' is due ~A with ~$"
+          (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))
+
+(defun %saver/format-salary-notification (salary payments moment)
+  (let ((period-info (saver/get-period-info salary payments moment)))
+    (format nil "~A is payday. Save ~$!"
+            (%saver/format-time (getf period-info :next-salary))
+            (/ (getf period-info :total-period) 100))))
+
+(defcron process-saver (:hour '*)
+  (let* ((moment (encode-universal-time 0 0 12 21 4 2017))
+         (hour (nth 2 (multiple-value-list (decode-universal-time moment)))))
+    (when (>= hour *saver-notify-hour*)
+      (dolist (cp (saver/find-today-payments moment))
+        (db-transaction
+          (send-response (car cp) (%saver/format-payment-notification (cdr cp) moment))
+          (db/saver/set-payment-notified (car cp) (saver/payment-name (cdr cp)) moment)))
+      (dolist (cs (saver/find-today-salaries moment))
+        (db-transaction
+          (send-response (car cs)
+                         (%saver/format-salary-notification (cdr cs)
+                                                            (db/saver/get-payments (car cs))
+                                                            moment))
+          (db/saver/set-salary-notified (car cs) moment))))))
 
-;; Hooks
 
 ;; Bot subcommands
-(defun %saver/format-info (payments salary)
-  (let ((payments-info
-         (loop for payment in payments
-            for idx from 1
-            for info = (saver/get-payment-info payment salary)
-            collect (format nil "~D) ~A on [~A]: saved ~$ of ~$, left ~$ in ~A periods"
-                            idx
-                            (saver/payment-name payment)
-                            (saver/payment-schedule payment)
-                            (/ (getf info :saved-amount) 100)
-                            (/ (saver/payment-amount payment) 100)
-                            (/ (getf info :left-amount) 100)
-                            (getf info :left-periods))))
-        (period-info (saver/get-period-info salary payments)))
-    (multiple-value-bind (sec min hour day month year dow dst-p tz)
-        (decode-universal-time (getf period-info :next-salary))
-      (declare (ignore sec min hour dow dst-p tz))
-      (format nil "~{~A~^~%~}~%~%Next save on ~4,'0D-~2,'0D-~2,'0D with ~$" payments-info
-              year month day (/ (getf period-info :total-period-amount) 100)))))
+(defun %saver/format-info (payments salary &optional (moment (get-universal-time)))
+  (let* (closest-time
+         closest-payment
+         (payments-info
+          (loop for payment in payments
+             for idx from 1
+             for info = (saver/get-payment-info payment salary 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 on [~A]: saved ~$ of ~$, left ~$ in ~A periods"
+                             idx
+                             (saver/payment-name payment)
+                             (saver/payment-schedule payment)
+                             (/ (getf info :saved-amount) 100)
+                             (/ (saver/payment-amount payment) 100)
+                             (/ (getf info :left-amount) 100)
+                             (getf info :left-periods))))
+        (period-info (saver/get-period-info salary payments moment)))
+    (if payments-info
+        (format nil "~{~A~^~%~}~%~%Savings now should be ~$~%Next save is on ~A with ~$~%Next payment is '~A' on ~A with ~$"
+                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))
+        "No active payments.")))
 
 (defun saver/send-info (chat-id)
   (let ((payments (db/saver/get-payments chat-id))
@@ -225,6 +315,7 @@
                                        100)))))
     (error (e) (send-response chat-id (format nil "/saver del <idx> [~A]" e)))))
 
+;; Hooks
 (def-message-cmd-handler handler-cmd-save (:save :saver)
   (if (null args)
       (saver/send-info chat-id)