[finance] per-chat ticker support

plugins/finance.lisp

@@ -6,7 +6,7 @@
 (defparameter +yahoo-url+ "https://query1.finance.yahoo.com/v7/finance/quote?lang=en-US&region=US&corsDomain=finance.yahoo.com&fields=regularMarketPrice" "Yahoo Finance API endpoint")
 (defparameter +brent-url+ "http://www.cmegroup.com/CmeWS/mvc/Quotes/Future/424/G")
 
-(defvar *rate-pairs* '("USDRUB=X" "EURRUB=X" "GBPRUB=X"))
+(defvar *default-symbols* '("USDRUB=X" "EURRUB=X" "GBPRUB=X"))
 
 (defparameter +chart-ranges+ (list (cons "day" (* 24 60))
                                    (cons "week" (* 7 24 60))
@@ -14,15 +14,15 @@
                                    (cons "quarter" (* 91 24 60))
                                    (cons "year" (* 365 24 60))))
 
-(defun get-rates (&optional (pairs *rate-pairs*))
+(defun get-rates (&optional (symbols *default-symbols*))
   (let ((response (agets (json-request
                           +yahoo-url+
-                          :parameters `(("symbols" . ,(format nil "~{~A~^,~}" pairs))))
+                          :parameters `(("symbols" . ,(format nil "~{~A~^,~}" symbols))))
                          "quoteResponse")))
     (when (aget "error" response)
       (error "Error in rates request"))
     (loop for rate in (agets response "result")
-       collect (cons (or (aget "shortName" rate) (aget "symbol" rate))
+       collect (cons (aget "symbol" rate)
                      (aget "regularMarketPrice" rate)))))
 
 (defun get-brent ()
@@ -46,10 +46,34 @@
              "bpi" "USD" "rate_float")
     (error (e) (log:error "~A" e))))
 
-(defun get-serie (series idx)
-  (loop for row in series
-     when (elt row idx)
-     collect (list (first row) (elt row idx))))
+
+;; Formatting
+(defvar *symbol-aliases*
+  (alexandria:plist-hash-table
+   '("BTCUSD" ("btc" "bitcoin" "биток")
+     "BRENT" ("чёрная" "нефть" "brent" "oil")
+     "USDRUB=X" ("зелёный" "бакс" "доллар" "usd")
+     "EURRUB=X" ("гейро" "eur" "евро")
+     "GBPRUB=X" ("британец" "gbp" "фунт" "стерлинг")
+     "CZKRUB=X" ("чешка" "czk")
+     "DKKRUB=X" ("дашка" "dkk"))
+   :test #'equal))
+
+(defun get-symbol-label (symbol)
+  (let ((aliases (gethash symbol *symbol-aliases*)))
+    (if aliases
+        (car aliases)
+        (let ((lower (string-downcase symbol)))
+          (when (equal "=x" (subseq lower (- (length lower) 2)))
+            (setf lower (subseq lower 0 (- (length lower) 2))))
+          (if (= 6 (length lower))
+              (format nil "~A/~A" (subseq lower 0 3) (subseq lower 3))
+              lower)))))
+
+;; Charts
+(defun get-serie (series symbol)
+  (mapcar #'(lambda (r) (list (car r) (caddr r)))
+          (remove symbol series :key #'cadr :test-not #'equal)))
 
 (defun range (seq &key (key 'identity))
   (loop
@@ -60,8 +84,7 @@
      finally (return (values min max))))
 
 (defvar *chart-points* 800 "Data points in chart")
-
-(defun make-chart (series names)
+(defun make-chart (series symbols)
   (let* ((r (multiple-value-list (range series :key #'car)))
          (fmt (if (<= (- (second r) (first r))
                       (* 60 60 36))
@@ -69,9 +92,9 @@
                   '((:day 2) "." (:month 2) " " (:hour 2) ":" (:min 2)))))
     (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)))
+      (loop for symbol in symbols
+         do (adw-charting:add-series (get-symbol-label symbol)
+                                     (get-serie series symbol)))
       (adw-charting:set-axis
        :x "Time" :draw-gridlines-p t
        :label-formatter #'(lambda (v)
@@ -84,54 +107,86 @@
 
 ;; Database
 (def-db-init
-  (db-execute "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
-  (db-execute "create index if not exists fin_ts_ids on finance (ts)"))
-
-(defun db/add-finance (ts usd eur gbp brent btc)
-  (db-execute "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)"
-              ts usd eur gbp brent btc))
-
-(defun db/get-last-finance ()
-  (values-list (first (db-select "select ts, usd, eur, gbp, brent, btc from finance order by ts desc limit 1"))))
-
-(defparameter +finance-db-map+ '(("usd" . "USD/RUB")
-                                 ("eur" . "EUR/RUB")
-                                 ("gbp" . "GBP/RUB")
-                                 ("brent" . "Brent")
-                                 ("btc" . "BTC/USD")))
-
-(defun db/get-series (after-ts &optional (fields '("usd" "eur" "gbp" "brent")) (avg 60))
-  (when fields
+  (db-execute "create table if not exists finance_ticker (ts, symbol, price, primary key (ts, symbol)) without rowid")
+  (db-execute "create table if not exists finance_chat_symbols (chat_id, symbol, primary key (chat_id, symbol)) without rowid"))
+
+(defun migrate ()
+  (db-execute "delete from finance_ticker")
+  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, usd from finance where usd is not null" "USDRUB=X")
+  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, eur from finance where eur is not null" "EURRUB=X")
+  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, gbp from finance where gbp is not null" "GBPRUB=X")
+  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, brent from finance where brent is not null" "BRENT")
+  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, btc from finance where btc is not null" "BTCUSD"))
+
+(defun db/add-finance (ts symbol price)
+  (db-execute "insert into finance_ticker (ts, symbol, price) values (?, ?, ?)" ts symbol price))
+
+(defun db/get-last-finance (&optional (symbols *default-symbols*))
+  (loop for symbol in symbols
+       for last = (db-select "select ts, symbol, price from finance_ticker where symbol = ? order by ts desc limit 1"
+                             symbol)
+       when last append last))
+
+(defun db/get-chat-symbols (&optional chat-id)
+  (mapcar #'car
+          (if chat-id
+              (db-select "select symbol from finance_chat_symbols where chat_id = ?" chat-id)
+              (db-select "select distinct symbol from finance_chat_symbols"))))
+
+(defun db/set-chat-symbols (chat-id symbols)
+  (db-transaction
+    (db-execute "delete from finance_chat_symbols where chat_id = ?" chat-id)
+    (dolist (symbol symbols)
+      (db-execute "insert into finance_chat_symbols (chat_id, symbol) values (?, ?)"
+                  chat-id symbol))))
+
+(defun db/get-series (after-ts &optional (symbols *default-symbols*) (avg 60))
+  (when symbols
     (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)))
-      (values
-       (db-select sql (local-time:timestamp-to-unix after-ts))
-       (sublis +finance-db-map+ fields :test #'equal)))))
-
+                       "select ts/~a*~:*~a, symbol, avg(price) from finance_ticker where ts >= ? and symbol in (~{?~*~^, ~}) group by ts/~a, symbol order by ts"
+                       avg symbols avg)))
+      (apply #'db-select sql (local-time:timestamp-to-unix after-ts) symbols))))
 
 ;; Cron
 (defcron process-rates ()
-  (let ((ts (local-time:timestamp-to-unix (local-time:now)))
-        (rates (get-rates))
-        (brent (get-brent))
-        (btc (get-coindesk-btc-usd)))
-    (db/add-finance ts (aget "USDRUB=X" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc)))
+  (let* ((ts (local-time:timestamp-to-unix (local-time:now)))
+         (symbols (db/get-chat-symbols))
+         (rates (when symbols (get-rates symbols)))
+         (brent (get-brent))
+         (btc (get-coindesk-btc-usd)))
+    (loop for (symbol . price) in rates
+       do (db/add-finance ts symbol price))
+    (when brent
+      (db/add-finance ts "BRENT" brent))
+    (when btc
+      (db/add-finance ts "BTCUSD" btc))))
 
 ;;; Hooks
+(defun get-label-symbol (label)
+  (or
+   (loop for symbol being the hash-keys in *symbol-aliases* using (hash-value aliases)
+      when (member label aliases :test #'string-equal)
+      do (return symbol))
+   (string-upcase label)))
+
 (def-message-cmd-handler handler-rates (:rates)
-  (multiple-value-bind (ts usd eur gbp brent btc) (db/get-last-finance)
+  (when args
+    (db/set-chat-symbols chat-id (mapcar #'get-label-symbol args)))
+  (let ((last (db/get-last-finance (or (db/get-chat-symbols chat-id) *default-symbols*))))
     (bot-send-message chat-id
-                      (format nil "Зеленый *~,2F*, гейро *~,2F*, британец *~,2F*, чёрная *~,2F*, btc *~,2F* @ _~A_"
-                              usd eur gbp brent btc
-                              (format-ts (local-time:unix-to-timestamp ts)))
-                      :parse-mode "Markdown")))
+                      (if last
+                          (format nil "~{~A *~$*~^, ~} @ _~A_"
+                                  (loop for (ts symbol price) in last
+                                     append (list (get-symbol-label symbol) price))
+                                  (format-ts (local-time:unix-to-timestamp (caar last))))
+                          "Пока нет данных. Если тикер реальный, проверь через минуту")
+                      :parse-mode "markdown")))
 
 (def-message-cmd-handler handler-charts (:charts)
   (telegram-send-chat-action chat-id "upload_photo")
   (let* ((args (mapcar 'string-downcase args))
-         (all-fields (mapcar #'car +finance-db-map+))
-         (fields (or (intersection args all-fields :test 'equal) all-fields))
+         (all-symbols (db/get-chat-symbols))
+         (symbols (or (intersection (mapcar #'get-label-symbol args) all-symbols :test 'equal) all-symbols))
          (day-range (some #'(lambda (a) (aget a +chart-ranges+)) args))
          (number (some #'(lambda (a) (parse-integer a :junk-allowed t)) args))
          (avg (* 60 (cond
@@ -140,11 +195,11 @@
                       (: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)))))
+         (rates (db/get-last-finance symbols))
+         (chart (make-chart (db/get-series after-ts symbols avg) symbols)))
     (telegram-send-photo chat-id chart
                          :caption
-                         (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F, btc ~,2F @ ~A"
-                                 (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4) (elt rates 5)
-                                 (format-ts (local-time:unix-to-timestamp (elt rates 0)))))))
+                         (format nil "~{~A ~$~^, ~} @ ~A"
+                                 (loop for (ts symbol price) in rates
+                                    append (list (get-symbol-label symbol) price))
+                                 (format-ts (local-time:unix-to-timestamp (caar rates)))))))