chatikbot/forecast.lisp

(in-package #:chatikbot)

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

(defun forecast (lat lon &key time (currently t) minutely hourly daily alerts)
  (handler-case
      (bordeaux-threads:with-timeout (5)
        (yason:parse
         (flexi-streams:make-flexi-stream
          (drakma:http-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)
           :force-binary t :want-stream t :decode-content t)
          :external-format :utf8)
         :object-as :alist))
    (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))))