1
0
Selaa lähdekoodia

Better charts cmd handing and other refactor

Innocenty Enikeew 10 vuotta sitten
vanhempi
commit
428312c353
3 muutettua tiedostoa jossa 51 lisäystä ja 53 poistoa
  1. 25 22
      chatikbot.lisp
  2. 15 20
      db.lisp
  3. 11 11
      finance.lisp

+ 25 - 22
chatikbot.lisp

@@ -196,32 +196,35 @@
                                    usd eur gbp brent
                                    (format-ts (local-time:unix-to-timestamp ts))))))
 
+(defparameter +chart-ranges+ (list (cons "day" (* 24 60))
+                                   (cons "week" (* 7 24 60))
+                                   (cons "month" (* 30 24 60))
+                                   (cons "quarter" (* 91 24 60))
+                                   (cons "year" (* 365 24 60))))
+
 (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")
   (handler-case
-      (let* ((usd (or (null args) (find "usd" args :test #'equal)))
-             (eur (or (null args) (find "eur" args :test #'equal)))
-             (gbp (or (null args) (find "gbp" args :test #'equal)))
-             (brent (or (null args) (find "brent" args :test #'equal)))
-             (avg (or (some #'(lambda (a)
-                                (when (find (princ-to-string a) args :test #'equal)
-                                  (* a 60)))
-                            '(240 60 30 15 10 6 5 4 3 2 1))
-                      60))
-             (rates (multiple-value-list (db-get-last-finance))))
-        (if (or usd eur gbp brent)
-            (let ((data (db-get-series
-                         (local-time:timestamp- (local-time:now)
-                                                (* 800 avg) :sec)
-                         usd eur gbp brent avg)))
-              (telegram-send-photo chat-id
-                                   (make-chart data :usd usd :eur eur :gbp gbp :brent brent)
-                                   :caption
-                                   (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F @ ~A"
-                                           (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4)
-                                           (format-ts (local-time:unix-to-timestamp (elt rates 0))))))
-            (telegram-send-message chat-id "Хуй тебе")))
+      (let* ((args (mapcar 'string-downcase args))
+             (all-fields (mapcar #'car +db-finance-map+))
+             (fields (or (intersection args all-fields :test 'equal) all-fields))
+             (day-range (some #'(lambda (a) (aget a +chart-ranges+)) args))
+             (number (some #'(lambda (a) (parse-integer a :junk-allowed t)) args))
+             (avg (* 60 (cond
+                          (day-range (round day-range *chart-points*))
+                          (number)
+                          (:otherwise 1))))
+             (after-ts (local-time:timestamp- (local-time:now)
+                                              (* avg *chart-points*) :sec))
+             (rates (multiple-value-list (db-get-last-finance)))
+             (chart (apply #'make-chart (multiple-value-list
+                                         (db-get-series after-ts fields avg)))))
+        (telegram-send-photo chat-id chart
+                             :caption
+                             (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F @ ~A"
+                                     (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4)
+                                     (format-ts (local-time:unix-to-timestamp (elt rates 0))))))
     (error (e)
       (log:error e)
       (telegram-send-message chat-id "Хуйня какая-то"))))

+ 15 - 20
db.lisp

@@ -45,26 +45,21 @@
   (with-db (db)
     (sqlite:execute-one-row-m-v db "select ts, usd, eur, gbp, brent from finance order by ts desc limit 1")))
 
-(defun %finance-alist (statement)
-  (let ((names (sqlite:statement-column-names statement))
-        (map '(("usd" . "USD/RUB") ("eur" . "EUR/RUB") ("gbp" . "GBP/RUB") ("brent" . "Brent"))))
-    (cons (sqlite:statement-column-value statement 0)
-          (loop
-             for i from 1 below (length names)
-             for col in (rest names)
-             collect (cons (aget col map) (sqlite:statement-column-value statement i))))))
-
-(defun db-get-series (after-ts &optional usd eur gbp brent (avg 60))
-  (let ((sql (format nil
-                     "select ts/~a*~a~:[~;,avg(usd) as usd~]~:[~;,avg(eur) as eur~]~:[~;,avg(gbp) as gbp~]~:[~;,avg(brent) as brent~] from finance where ts >= ? group by ts/~a order by ts"
-                     avg avg usd eur gbp brent avg)))
-    (with-db (db)
-      (loop
-         with statement = (sqlite:prepare-statement db sql)
-         initially (sqlite:bind-parameter statement 1 (local-time:timestamp-to-unix after-ts))
-         while (sqlite:step-statement statement)
-         collect (%finance-alist statement)
-         finally (sqlite:finalize-statement statement)))))
+
+(defparameter +db-finance-map+ '(("usd" . "USD/RUB")
+                                 ("eur" . "EUR/RUB")
+                                 ("gbp" . "GBP/RUB")
+                                 ("brent" . "Brent")))
+
+(defun db-get-series (after-ts &optional (fields '("usd" "eur" "gbp" "brent")) (avg 60))
+  (when fields
+    (let ((sql (format nil
+                       "select ts/~a*~:*~a,~{avg(~a) as ~:*~a~^,~} from finance where ts >= ? group by ts/~a order by ts"
+                       avg fields avg)))
+      (with-db (db)
+        (values
+         (sqlite:execute-to-list db sql (local-time:timestamp-to-unix after-ts))
+         (sublis +db-finance-map+ fields :test #'equal))))))
 
 ;; Foursquare
 (defun db-fsq-get-chat-users (chat-id)

+ 11 - 11
finance.lisp

@@ -27,10 +27,9 @@
           last))
     (error (e) (log:error e))))
 
-(defun get-serie (series name)
-  (loop for (time . rates) in series
-     when (numberp (aget name rates))
-     collect (list time (aget name rates))))
+(defun get-serie (series idx)
+  (loop for row in series
+     collect (list (first row) (elt row idx))))
 
 (defun range (seq &key (key 'identity))
   (loop
@@ -40,18 +39,19 @@
      maximizing value into max
      finally (return (values min max))))
 
-(defun make-chart (series &key (usd t) (eur t) (gbp t) (brent t))
+(defvar *chart-points* 800 "Data points in chart")
+
+(defun make-chart (series names)
   (let* ((r (multiple-value-list (range series :key #'car)))
          (fmt (if (<= (- (second r) (first r))
                       (* 60 60 36))
                   '((:hour 2) ":" (:min 2))
                   '((:day 2) "." (:month 2) " " (:hour 2) ":" (:min 2)))))
-    (adw-charting:with-line-chart (890 600)
-      (when usd (adw-charting:add-series "USD/RUB" (get-serie series "USD/RUB")))
-      (when eur (adw-charting:add-series "EUR/RUB" (get-serie series "EUR/RUB")))
-      (when gbp (adw-charting:add-series "GBP/RUB" (get-serie series "GBP/RUB")))
-      (when brent (adw-charting:add-series "Brent last day futures"
-                                           (get-serie series "Brent")))
+    (adw-charting:with-line-chart ((+ 90 *chart-points*)
+                                   (floor (* 3 *chart-points*) 4))
+      (loop for serie in names
+         for idx from 1
+         do (adw-charting:add-series serie (get-serie series idx)))
       (adw-charting:set-axis
        :x "Time" :draw-gridlines-p t
        :label-formatter #'(lambda (v)