chatikbot/plugins/forecast.lisp

(in-package #:chatikbot)

(defsetting *forecast-api-key* nil "forecast.io APIKEY")
(defparameter +forecast-api-url+ "https://api.darksky.net/forecast" "forecast.io API endpoint")

(defun forecast (lat lon &key time (currently t) minutely hourly daily alerts)
  (handler-case
      (bordeaux-threads:with-timeout (5)
        (json-request (format nil
                              "~A/~A/~A,~A~@[,~A~]?units=si&exclude=~:[currently,~;~]~:[minutely,~;~]~:[hourly,~;~]~:[daily,~;~]~:[alerts,~;~]flags&lang=ru"
                              +forecast-api-url+ *forecast-api-key* lat lon time
                              currently minutely hourly daily alerts)))
    (bordeaux-threads:timeout () (error "Timeout"))))

(defvar *forecast-point-formats*
  '((:current . (:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))
    (:hour . ((:hour 2) ":" (:min 2)))
    (:day . ((:day 2) " " :short-month " " :short-weekday)))
  "local-time:format-timestring formats for different points")

(defvar *forecast-emojis*
  '(("clear-day" . "☀")
    ("clear-night" . "⭐")
    ("rain" . "☔")
    ("snow" . "❄")
    ("sleet" . "❄☔")
    ("wind" . "💨")
    ("fog" . "🌁")
    ("cloudy" . "☁")
    ("partly-cloudy-day" . "⛅")
    ("partly-cloudy-night" . "⛅"))
  "Weather-to-emoji mapping")

(defun forecast-format-unixtime (unix format tz)
  (local-time:format-timestring nil (local-time:unix-to-timestamp unix)
                                :format format :timezone tz))

(defun forecast-format-point (type point tz)
  (format nil "~A -~@[ ~A~]~@[ ~A~]~:[ ~A-~A~;~:* ~A~2*~]°C"
          (forecast-format-unixtime (aget "time" point)
                                    (aget type *forecast-point-formats*)
                                    tz)
          (aget (aget "icon" point) *forecast-emojis*)
          (aget "summary" point)
          (aget "temperature" point) (aget "temperatureMin" point) (aget "temperatureMax" point)))

(defun forecast-format-currently (currently &optional (tz local-time:*default-timezone*))
  (when currently
    (forecast-format-point :current currently tz)))

(defun forecast-format-hourly (hourly &optional (tz local-time:*default-timezone*))
  (when hourly
    (format nil "~@[~A~]~{~&~A~}"
            (aget "summary" hourly)
            (mapcar #'(lambda (point) (forecast-format-point :hour point tz))
                    (subseq (aget "data" hourly) 0 24)))))

(defun forecast-format-daily (daily &optional (tz local-time:*default-timezone*))
  (when daily
    (format nil "~@[~A~]~{~&~A~}"
            (aget "summary" daily)
            (mapcar #'(lambda (point) (forecast-format-point :day point tz))
                    (subseq (aget "data" daily) 0 7)))))

(defun forecast-format (forecast)
  (let* ((timezone (local-time:find-timezone-by-location-name
                    (aget "timezone" forecast))))
    (format nil "~@[Сейчас: ~A~]~@[~&Сегодня: ~A~]~@[~&Неделя: ~A~]"
            (forecast-format-currently (aget "currently" forecast) timezone)
            (forecast-format-hourly (aget "hourly" forecast) timezone)
            (forecast-format-daily (aget "daily" forecast) timezone))))

;;; Hooks
(defvar *chat-locations* nil "ALIST of chat->location")

(def-message-handler handle-location (message)
  (let ((chat-id (aget "id" (aget "chat" message)))
        (location (aget "location" message)))
    (when location
      (log:info "handler-location" chat-id location)
      (set-setting '*chat-locations* (cons (cons chat-id location) *chat-locations*))
      (bot-send-message chat-id "Взял на карандаш")
      t)))

(def-message-cmd-handler handle-cmd-weather (:weather :hourly :daily)
  (let* ((location (cdr (assoc chat-id *chat-locations*)))
         (response (if location
                       (forecast-format
                        (forecast
                         (aget "latitude" location)
                         (aget "longitude" location)
                         :hourly (find "hourly" (cons (string cmd) args) :key #'string-downcase :test #'equal)
                         :daily (find "daily" (cons (string cmd) args) :key #'string-downcase :test #'equal)))
                       "Так а ты чьих будешь?")))
    (bot-send-message chat-id response)))