Innocenty Enikeew пре 10 година
родитељ
комит
50ecb5abec
7 измењених фајлова са 93 додато и 35 уклоњено
  1. 1 0
      .gitignore
  2. 2 0
      chatikbot.asd
  3. 25 27
      chatikbot.lisp
  4. 44 0
      db.lisp
  5. 11 4
      finance.lisp
  6. 5 4
      foursquare.lisp
  7. 5 0
      utils.lisp

+ 1 - 0
.gitignore

@@ -1,5 +1,6 @@
 config.lisp
 config.lisp
 settings.lisp
 settings.lisp
 chart.png
 chart.png
+db.sqlite
 *.fasl
 *.fasl
 *~
 *~

+ 2 - 0
chatikbot.asd

@@ -13,11 +13,13 @@
                #:local-time
                #:local-time
                #:log4cl
                #:log4cl
                #:plump
                #:plump
+               #:sqlite
                #:trivial-utf-8
                #:trivial-utf-8
                #:yason)
                #:yason)
   :serial t
   :serial t
   :components ((:file "package")
   :components ((:file "package")
                (:file "utils")
                (:file "utils")
+               (:file "db")
                (:file "telegram")
                (:file "telegram")
                (:file "forecast")
                (:file "forecast")
                (:file "vk")
                (:file "vk")

+ 25 - 27
chatikbot.lisp

@@ -7,6 +7,8 @@
                                               (asdf:find-system '#:chatikbot)))))
                                               (asdf:find-system '#:chatikbot)))))
   (load file))
   (load file))
 
 
+;; Init database
+(db-init)
 
 
 (defvar *telegram-last-update* nil "Telegram last update_id")
 (defvar *telegram-last-update* nil "Telegram last update_id")
 (defvar *admins* nil "Admins chat-ids")
 (defvar *admins* nil "Admins chat-ids")
@@ -173,29 +175,25 @@
       (telegram-send-message chat-id "Ошибочка вышла"))))
       (telegram-send-message chat-id "Ошибочка вышла"))))
 
 
 ;; Finance
 ;; Finance
-(defvar *per-minute-rates* (make-circular (make-list 1440))
-  "Circular list for 24h per minute rates")
-
 (defun process-rates ()
 (defun process-rates ()
   (handler-case
   (handler-case
-      (progn
-        (push-circular (cons (local-time:timestamp-to-unix (local-time:now))
-                             (list* (cons "Brent"
-                                          (get-brent))
-                                    (get-rates)))
-                       *per-minute-rates*)
-        (save-settings))
+      (let ((ts (local-time:timestamp-to-unix (local-time:now)))
+            (rates (get-rates))
+            (brent (get-brent)))
+        (db-add-finance ts
+                        (aget "USD/RUB" rates)
+                        (aget "EUR/RUB" rates)
+                        (aget "GBP/RUB" rates)
+                        brent))
     (error (e) (log:error e))))
     (error (e) (log:error e))))
 
 
 (defun handle-cmd-rates (chat-id message-id args)
 (defun handle-cmd-rates (chat-id message-id args)
   (log:info "handle-cmd-rates" chat-id message-id args)
   (log:info "handle-cmd-rates" chat-id message-id args)
-  (let ((rates (rest (peek-circular *per-minute-rates*))))
+  (multiple-value-bind (ts usd eur gbp brent) (db-get-last-finance)
     (telegram-send-message chat-id
     (telegram-send-message chat-id
-                           (format nil "Зеленый ~A, гейро ~A, британец ~A, чёрная ~A"
-                                   (aget "USD/RUB" rates)
-                                   (aget "EUR/RUB" rates)
-                                   (aget "GBP/RUB" rates)
-                                   (aget "Brent" rates)))))
+                           (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F @ ~A"
+                                   usd eur gbp brent
+                                   (format-ts (local-time:unix-to-timestamp ts))))))
 
 
 (defun handle-cmd-charts (chat-id message-id args)
 (defun handle-cmd-charts (chat-id message-id args)
   (log:info "handle-cmd-charts" chat-id message-id args)
   (log:info "handle-cmd-charts" chat-id message-id args)
@@ -205,18 +203,18 @@
              (eur (or (null args) (find "eur" args :test #'equal)))
              (eur (or (null args) (find "eur" args :test #'equal)))
              (gbp (or (null args) (find "gbp" args :test #'equal)))
              (gbp (or (null args) (find "gbp" args :test #'equal)))
              (brent (or (null args) (find "brent" args :test #'equal)))
              (brent (or (null args) (find "brent" args :test #'equal)))
-             (rates (rest (peek-circular *per-minute-rates*))))
+             (rates (multiple-value-list (db-get-last-finance))))
         (if (or usd eur gbp brent)
         (if (or usd eur gbp brent)
-          (telegram-send-photo chat-id
-                               (make-chart *per-minute-rates*
-                                           :usd usd :eur eur
-                                           :gbp gbp :brent brent)
-                               :caption (format nil "Зеленый ~A, гейро ~A, британец ~A, чёрная ~A"
-                                                (aget "USD/RUB" rates)
-                                                (aget "EUR/RUB" rates)
-                                                (aget "GBP/RUB" rates)
-                                                (aget "Brent" rates)))
-          (telegram-send-message chat-id "Хуй тебе")))
+            (let ((data (db-get-series
+                         (local-time:timestamp- (local-time:now) 1 :day)
+                         usd eur gbp brent)))
+              (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 "Хуй тебе")))
     (error (e)
     (error (e)
       (log:error e)
       (log:error e)
       (telegram-send-message chat-id "Хуйня какая-то"))))
       (telegram-send-message chat-id "Хуйня какая-то"))))

+ 44 - 0
db.lisp

@@ -0,0 +1,44 @@
+(in-package #:chatikbot)
+
+(defvar *db-name* "db.sqlite" "SQLite database name")
+
+(defun db-path ()
+  (merge-pathnames *db-name*
+                   (asdf:component-pathname
+                    (asdf:find-system '#:chatikbot))))
+
+(defun db-init ()
+  (unless (probe-file (db-path))
+    (sqlite:with-open-database (db (db-path))
+      (sqlite:execute-non-query db "create table finance (ts, usd, eur, gbp, brent)")
+      (sqlite:execute-non-query db "create index fin_ts_ids on finance (ts)"))))
+
+(defun db-add-finance (ts usd eur gbp brent)
+  (sqlite:with-open-database (db (db-path) :busy-timeout 10)
+    (sqlite:execute-non-query db "insert into finance (ts, usd, eur, gbp, brent) values (?, ?, ?, ?, ?)"
+                              ts usd eur gbp brent)))
+
+(defun db-get-last-finance ()
+  (sqlite:with-open-database (db (db-path) :busy-timeout 10)
+    (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)
+  (let ((sql (format nil "select ts~:[~;,usd~]~:[~;,eur~]~:[~;,gbp~]~:[~;,brent~] from finance where ts >= ? order by ts" usd eur gbp brent)))
+    (sqlite:with-open-database (db (db-path))
+      (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)))))
+
+

+ 11 - 4
finance.lisp

@@ -28,10 +28,17 @@
     (error (e) (log:error e))))
     (error (e) (log:error e))))
 
 
 (defun get-serie (series name)
 (defun get-serie (series name)
-  (sort (loop for (time . rates) in series
-           when (numberp (aget name rates))
-           collect (list time (aget name rates)))
-        #'> :key #'car))
+  (loop for (time . rates) in series
+     when (numberp (aget name rates))
+     collect (list time (aget name rates))))
+
+(defun range (seq &key (key 'identity))
+  (loop
+     for item in seq
+     for value = (funcall key item)
+     minimizing value into min
+     maximizing value into max
+     finally (return (values min max))))
 
 
 (defun make-chart (series &key (usd t) (eur t) (gbp t) (brent t))
 (defun make-chart (series &key (usd t) (eur t) (gbp t) (brent t))
   (let ((flat (remove-if #'null (if (alexandria:circular-list-p series)
   (let ((flat (remove-if #'null (if (alexandria:circular-list-p series)

+ 5 - 4
foursquare.lisp

@@ -52,7 +52,8 @@
               (aget "firstName" user) (aget "lastName" user)
               (aget "firstName" user) (aget "lastName" user)
               (aget "name" venue) (first (aget "formattedAddress" (aget "location" venue)))
               (aget "name" venue) (first (aget "formattedAddress" (aget "location" venue)))
               (aget "shout" checkin)
               (aget "shout" checkin)
-	      with-dates (local-time:format-timestring
-			  nil
-			  (local-time:unix-to-timestamp (aget "createdAt" checkin))
-			  :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))))))
+              with-dates
+              (local-time:format-timestring
+               nil
+               (local-time:unix-to-timestamp (aget "createdAt" checkin))
+               :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))))))

+ 5 - 0
utils.lisp

@@ -129,6 +129,11 @@ is replaced with replacement."
            (values (yason:parse stream :object-as object-as) uri))
            (values (yason:parse stream :object-as object-as) uri))
       (ignore-errors (close http-stream)))))
       (ignore-errors (close http-stream)))))
 
 
+(defun format-ts (ts)
+  (local-time:format-timestring nil ts
+                                :format '(:year "-" (:month 2) "-" (:day 2) " "
+                                          (:hour 2) ":" (:min 2) ":" (:sec 2))))
+
 ;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
 ;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
 ;; leads to bad cutoff)
 ;; leads to bad cutoff)
 (in-package #:local-time)
 (in-package #:local-time)