Rates charting

chatikbot.asd

@@ -4,6 +4,7 @@
   :author "Innokentiy Enikeev <me@enikesha.net>"
   :license "MIT"
   :depends-on (#:alexandria
+               #:adw-charting-vecto
                #:bordeaux-threads
 ;;               #:cl-oauth
                #:clon

chatikbot.lisp

@@ -67,6 +67,7 @@
               (:hourly (handle-cmd-weather chat-id id '("hourly")))
               (:daily (handle-cmd-weather chat-id id '("daily")))
               (:rates (handle-cmd-rates chat-id id args))
+              (:charts (handle-cmd-charts chat-id id args))
               (:postcheckins (handle-cmd-post-checkins chat-id id args))
               (:friends (handle-cmd-fsq-friends chat-id id args))
               (:checkins (handle-cmd-checkins chat-id id args))
@@ -170,11 +171,31 @@
       (telegram-send-message chat-id "Ошибочка вышла"))))
 
 ;; Finance
+(defvar *per-minute-rates* (make-circular (make-list 1440))
+  "Circular list for 24h per minute rates")
+
+(defun process-rates ()
+  (handler-case
+      (push-circular (cons (local-time:timestamp-to-unix (local-time:now))
+                           (get-rates))
+                     *per-minute-rates*)
+    (error (e) (log:error e))))
+
 (defun handle-cmd-rates (chat-id message-id args)
   (log:info "handle-cmd-rates" chat-id message-id args)
-  (let ((rates (get-rates)))
+  (let ((rates (rest (peek-circular *per-minute-rates*))))
     (telegram-send-message chat-id
-			   (format nil "Зеленый ~A, гейро ~A, британец ~A" (cdar rates) (cdadr rates) (cdaddr rates)))))
+                           (format nil "Зеленый ~A, гейро ~A, британец ~A"
+                                   (cdar rates) (cdadr rates) (cdaddr rates)))))
+
+(defun handle-cmd-charts (chat-id message-id args)
+  (log:info "handle-cmd-charts" chat-id message-id args)
+  (telegram-send-chat-action chat-id "upload_photo")
+  (let ((chart (make-chart *per-minute-rates*))
+        (rates (rest (peek-circular *per-minute-rates*))))
+    (telegram-send-photo chat-id chart
+                         :caption (format nil "Зеленый ~A, гейро ~A, британец ~A"
+                                          (cdar rates) (cdadr rates) (cdaddr rates)))))
 
 ;; Weather
 (defun handle-cmd-weather (chat-id message-id args)
@@ -290,6 +311,7 @@
              (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts))))
     (error (e) (log:error e))))
 
+
 (defun save-settings()
   (with-open-file (s (merge-pathnames "settings.lisp"
                                       (asdf:component-pathname
@@ -333,6 +355,12 @@
     (clon:make-typed-cron-schedule :minute '* :hour '*)
     :allow-now-p t)
    :thread t)
+  (clon:schedule-function
+   (lambda () (process-rates))
+   (clon:make-scheduler
+    (clon:make-typed-cron-schedule :minute '* :hour '*)
+    :allow-now-p t)
+   :thread t)
   ;; Start getUpdates thread
   (bordeaux-threads:make-thread
    (lambda ()

finance.lisp

@@ -18,4 +18,22 @@
       (error "Error in rates request"))
     (loop for rate in (aget "rate" (aget "results" (aget "query" response)))
        collect (cons (aget "Name" rate)
-		     (aget "Rate" rate)))))
+                     (read-from-string (aget "Rate" rate))))))
+
+(defun make-chart (series &key (usd t) (eur t) (gbp t))
+  (let ((flat (remove-if #'null (if (alexandria:circular-list-p series)
+                                     (flat-circular series)
+                                     series))))
+    (adw-charting:with-line-chart (1200 900)
+      (when usd
+        (adw-charting:add-series "USD/RUB" (loop for p in flat collect (list (car p) (cdadr p)))))
+      (when eur
+        (adw-charting:add-series "EUR/RUB" (loop for p in flat collect (list (car p) (cdaddr p)))))
+      (when gbp
+        (adw-charting:add-series "GBP/RUB" (loop for p in flat collect (list (car p) (cdr (cadddr p))))))
+      (adw-charting:set-axis
+       :x "Time" :draw-gridlines-p t
+       :label-formatter #'(lambda (v) (local-time:format-timestring nil (local-time:unix-to-timestamp v)
+                                                               :format '((:hour 2) ":" (:min 2)))))
+      (adw-charting:set-axis :y "RUB" :draw-gridlines-p t :label-formatter "~,2F")
+      (adw-charting:save-file "chart.png"))))

telegram.lisp

@@ -23,7 +23,8 @@
 (defun %telegram-api-call (method &optional args)
   (let* ((params (loop for (k . v) in args collect (cons
                                                     (princ-to-string k)
-                                                    (princ-to-string v))))
+                                                    (if (pathnamep v) v
+                                                        (princ-to-string v)))))
          (timeout (+ 5 (or (cdr (assoc :timeout args))
                            *telegram-timeout*)))
          (response (yason:parse
@@ -66,3 +67,18 @@
          (cons "sticker" sticker)
          (cons "reply_to_message_id" reply-to)
          (cons "reply_markup" reply-markup))))
+
+(defun telegram-send-photo (chat-id photo &key caption reply-to reply-markup)
+  (%telegram-api-call
+   "sendPhoto"
+   (list (cons "chat_id" chat-id)
+         (cons "photo" photo)
+         (cons "caption" caption)
+         (cons "reply_to_message_id" reply-to)
+         (cons "reply_markup" reply-markup))))
+
+(defun telegram-send-chat-action (chat-id action)
+  (%telegram-api-call
+   "sendChatAction"
+   (list (cons "chat_id" chat-id)
+         (cons "action" action))))

utils.lisp

@@ -54,3 +54,29 @@ is replaced with replacement."
   "Append together elements (or lists) in the list."
   (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))
 
+(defun make-circular (items)
+  "Make items list circular"
+  (setf (cdr (last items)) items))
+
+(defmacro push-circular (obj circ)
+  "Move circ list and set head to obj"
+  `(progn
+     (pop ,circ)
+     (setf (car ,circ) ,obj)))
+
+(defmacro peek-circular (circ)
+  "Get head of circular list"
+  `(car ,circ))
+
+(defmacro pop-circular (circ)
+  "Get head of circular list"
+  `(pop ,circ))
+
+(defun flat-circular (circ)
+  "Flattens circular list"
+  (do ((cur (cdr circ) (cdr cur))
+       (head circ)
+       result)
+      ((eq head cur)
+       (nreverse (push (car cur) result)))
+    (push (car cur) result)))