/weather command, /help command, minor fixes

chatikbot.asd

@@ -8,6 +8,7 @@
                #:cl-oauth
                #:clon
                #:flexi-streams
+               #:local-time
                #:log4cl
                #:trivial-utf-8
                #:yason)
@@ -16,4 +17,5 @@
                (:file "utils")
                (:file "twitter")
                (:file "telegram")
+               (:file "forecast")
                (:file "chatikbot")))

chatikbot.lisp

@@ -11,30 +11,38 @@
 (defvar *telegram-last-update* nil "Telegram last update_id")
 
 (defun process-updates ()
-  (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
-                                                         (1+ *telegram-last-update*))
-                                            :timeout 300)
-     do (handle-message (aget "message" update))
-     do (setf *telegram-last-update*
-              (max (or *telegram-last-update* 0)
-                   (aget "update_id" update)))))
+  (handler-case
+      (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
+                                                             (1+ *telegram-last-update*))
+                                                :timeout 300)
+         do (handle-message (aget "message" update))
+         do (setf *telegram-last-update*
+                  (max (or *telegram-last-update* 0)
+                       (aget "update_id" update))))
+    (error (e)
+      (log:error e))))
 
 (defvar *responses*
   '("И чё?" "Сам-то понял?" "Ну хуй знает" "Бля..." "В душе не ебу" "Мне похуй")
   "Unknown command respond strings")
 
+(defun random-choice (messages)
+  (nth (random (length messages)) messages))
+
 (defun send-dont-understand (chat-id &optional text reply-id)
   (telegram-send-message chat-id
                          (if (and text (zerop (random 5)))
                              (format nil "Сам ~A"
                                      (replace-all text "@chatikbot" ""))
-                             (nth (random (length *responses*)) *responses*))
+                             (random-choice *responses*))
                          :reply-to reply-id))
+(defvar *chat-locations* nil "ALIST of chat->location")
 
 (defun handle-message (message)
   (let ((id (aget "message_id" message))
         (chat-id (aget "id" (aget "chat" message)))
-        (text (aget "text" message)))
+        (text (aget "text" message))
+        (location (aget "location" message)))
     (log:info "handle-message" message)
     (when text
       (if (equal #\/ (char text 0))
@@ -47,8 +55,13 @@
             (case cmd
               (:postakb (handle-cmd-post-akb chat-id id args))
               (:akb (handle-cmd-akb chat-id id args))
+              (:weather (handle-cmd-weather chat-id id args))
+              (:help (handle-cmd-help chat-id id args))
               (otherwise (send-dont-understand chat-id text))))
-          (send-dont-understand chat-id text)))))
+          (send-dont-understand chat-id text)))
+    (when location
+      (push (cons chat-id location) *chat-locations*)
+      (telegram-send-message chat-id "Взял на карандаш"))))
 
 (defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'")
 (defvar *akb-send-to* nil "List of chat-id's to send AKBs to")
@@ -103,8 +116,36 @@
         (error (e) (log:error e))))))
 
 
+(defvar *help-responses*
+  (list "Сам себе помоги, нахуй!" "Вот заняться мне больше нечем" "Нахуй пошел!"
+        "Хэлп, ай нид самбади, хелп нот джаст энибади."))
+
+(defun handle-cmd-help (chat-id message-id args)
+  (log:info "handle-cmd-help" chat-id message-id args)
+  (telegram-send-message chat-id (random-choice *help-responses*)))
+
+
+(defun handle-cmd-weather (chat-id message-id args)
+  (log:info "handle-cmd-weather" chat-id message-id args)
+  (let ((location (cdr (assoc chat-id *chat-locations*))))
+    (telegram-send-message
+     chat-id
+     (if location
+         (forecast-format (forecast
+                           (aget "latitude" location)
+                           (aget "longitude" location)
+                           :hourly (find "hourly" args :key #'string-downcase :test #'equal)
+                           :daily (find "daily" args :key #'string-downcase :test #'equal)))
+         "Так а ты чьих будешь?"))))
+
 (defun start ()
   (mapc #'sb-ext:unschedule-timer (trivial-timers:list-all-timers))
+  (let ((old-updates (find "process-updates"
+                            (bordeaux-threads:all-threads)
+                            :key #'bordeaux-threads:thread-name
+                            :test #'equal)))
+    (when old-updates
+      (bordeaux-threads:destroy-thread old-updates)))
   (clon:schedule-function
    (lambda () (process-latest-akb))
    (clon:make-scheduler

forecast.lisp

@@ -0,0 +1,74 @@
+(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)
+  (yason:parse
+   (flexi-streams:octets-to-string
+    (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))
+    :external-format :utf8)
+   :object-as :alist))
+
+(local-time:reread-timezone-repository :timezone-repository "/usr/share/zoneinfo/")
+
+(defvar *forecast-point-formats*
+  '((:current . (:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))
+    (:hour . ((:hour 2) ":" (:min 2)))
+    (:day . (:year "-" (:month 2) "-" (:day 2))))
+  "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))))