chatikbot/finance.lisp

(in-package #:chatikbot)

(defparameter +yahoo-url+ "https://query.yahooapis.com/v1/public/yql" "Yahoo Finance API endpoint")
(defparameter +yahoo-query+ "select Name,Rate from yahoo.finance.xchange where pair in (~{\"~A\"~^,~})")

(defparameter +brent-url+ "http://www.cmegroup.com/CmeWS/mvc/Quotes/Future/424/G")

(defvar *rate-pairs* '("USDRUB" "EURRUB" "GBPRUB"))

(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 get-rates (&optional (pairs *rate-pairs*))
  (let ((response (json-request
                   +yahoo-url+
                   :parameters (append '(("format" . "json")
                                         ("env" . "store://datatables.org/alltableswithkeys"))
                                       (list (cons "q" (format nil +yahoo-query+ pairs)))))))
    (when (aget "error" response)
      (error "Error in rates request"))
    (loop for rate in (aget "rate" (aget "results" (aget "query" response)))
       collect (cons (aget "Name" rate)
                     (read-from-string (aget "Rate" rate))))))

(defun get-brent ()
  (handler-case
      (let ((last (read-from-string
                   (aget "last" (first (aget "quotes" (json-request  +brent-url+)))))))
        (when (numberp last)
          last))
    (error (e) (log:error e))))

(defparameter +btc-e-usd-url+ "https://btc-e.com/api/2/btc_usd/ticker" "BTC-e BTC/USD ticker url")
(defun get-btc-e ()
  (handler-case
      (aget "last" (aget "ticker" (json-request +btc-e-usd-url+)))
    (error (e) (log:error e))))

(defun get-serie (series idx)
  (loop for row in series
     when (elt row idx)
     collect (list (first row) (elt row idx))))

(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))))

(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 ((+ 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)
                            (local-time:format-timestring
                             nil
                             (local-time:unix-to-timestamp v)
                             :format fmt)))
      (adw-charting:set-axis :y "RUB" :draw-gridlines-p t :label-formatter "~,2F")
      (adw-charting:save-file "chart.png"))))

;; Database
(def-db-init (db)
  (%db-execute db "create table if not exists finance (ts, usd, eur, gbp, brent, btc)")
  (%db-execute db "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
    (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)))))


;; Cron
(defcron process-rates ()
  (let ((ts (local-time:timestamp-to-unix (local-time:now)))
        (rates (get-rates))
        (brent (get-brent))
        (btc (get-btc-e)))
    (db/add-finance ts (aget "USD/RUB" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc)))

;;; Hooks
(def-message-cmd-handler handler-rates (:rates)
  (multiple-value-bind (ts usd eur gbp brent btc) (db/get-last-finance)
    (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")))

(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))
         (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, 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)))))))