(in-package #:chatikbot) ;; Load config file (alexandria:when-let (file (probe-file (merge-pathnames "config.lisp" (asdf:component-pathname (asdf:find-system '#:chatikbot))))) (load file)) (defvar *telegram-last-update* nil "Telegram last update_id") (defvar *admins* nil "Admins chat-ids") (defun process-updates () (loop for update in (telegram-get-updates :offset (and *telegram-last-update* (1+ *telegram-last-update*)) :timeout 300) do (setf *telegram-last-update* (max (or *telegram-last-update* 0) (aget "update_id" update))) do (handle-message (aget "message" update)))) (defun send-response (chat-id response &optional reply-id) (if (consp response) (case (car response) (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id)) (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id))) (telegram-send-message chat-id response :reply-to reply-id))) (defun send-dont-understand (chat-id &optional text reply-id) (let ((resp (eliza text))) (log:info text resp) (when resp (send-response chat-id resp reply-id)))) (defvar *chat-locations* nil "ALIST of chat->location") (defun preprocess-input (text) (when text (let ((first-word (subseq text 0 (position #\Space text)))) (if (equal first-word "@chatikbot") (preprocess-input (subseq text 11)) (replace-all text "@chatikbot" "ты"))))) (defun handle-message (message) (let ((id (aget "message_id" message)) (chat-id (aget "id" (aget "chat" message))) (text (aget "text" message)) (location (aget "location" message)) (sticker (aget "file_id" (aget "sticker" message)))) (log:info "handle-message" message) (when text (if (equal #\/ (char text 0)) (let ((cmd (intern (string-upcase (subseq text 1 (position #\Space text))) "KEYWORD")) (args (when (position #\Space text) (split-sequence:split-sequence #\Space (subseq text (1+ (position #\Space text))))))) (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)) (:hourly (handle-cmd-weather chat-id id '("hourly"))) (:daily (handle-cmd-weather chat-id id '("daily"))) (:rates (handle-cmd-rates chat-id id args)) (otherwise (handle-admin-cmd chat-id text cmd args)))) (send-dont-understand chat-id (preprocess-input text)))) (when location (push (cons chat-id location) *chat-locations*) (telegram-send-message chat-id "Взял на карандаш")) (when sticker (send-dont-understand chat-id)))) (defmacro handling-errors (&body body) `(handler-case (progn ,@body) (simple-condition (err) (format *error-output* "~&~A: ~%" (class-name (class-of err))) (apply (function format) *error-output* (simple-condition-format-control err) (simple-condition-format-arguments err)) (format *error-output* "~&")) (condition (err) (format *error-output* "~&~A: ~% ~S~%" (class-name (class-of err)) err)))) (defun rep (input) (when input (with-output-to-string (*standard-output*) (let ((*package* (find-package 'chatikbot)) (*error-output* *standard-output*)) (handling-errors (format t "~{~S~^ ;~% ~}~%" (multiple-value-list (eval (read-from-string input))))))))) (defun handle-admin-cmd (chat-id text cmd args) (if (find chat-id *admins*) (case cmd (:eval (telegram-send-message chat-id (rep (format nil "~{~A~^ ~}" args)))) (otherwise (send-dont-understand chat-id (preprocess-input (subseq text 1))))) (send-dont-understand chat-id (preprocess-input (subseq text 1))))) (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") (defun handle-cmd-post-akb (chat-id message-id args) (log:info "handle-cmd-post-akb" chat-id message-id args) (let ((message "Хуярим аники")) (if (member chat-id *akb-send-to*) (setf message "Не хуярим больше аники" *akb-send-to* (set-difference *akb-send-to* (list chat-id))) (setf *akb-send-to* (cons chat-id *akb-send-to*))) (telegram-send-message chat-id message))) (defvar *akb-max-count* 5 "Max number of tweets to return per run") (defvar *akb-last-id* 0 "id of last AKB tweet") (defun format-akb (post) (let* ((id (aget "id" post)) (url (format nil "https://vk.com/~A?w=wall~A_~A" +akb-vk-domain+ (aget "from_id" post) id))) (format nil "~A~%~A" (aget "text" post) url))) (defun process-latest-akb () (handler-case (dolist (post (reverse (aget "items" (vk-wall-get :domain +akb-vk-domain+ :count *akb-max-count*)))) (let ((id (aget "id" post))) (when (> id *akb-last-id*) (send-akb (format-akb post)) (setf *akb-last-id* id)))) (condition (e) (log:error e)))) (defun send-akb (text) (log:info "send-akb: ~A" text) (dolist (chat-id *akb-send-to*) (handler-case (telegram-send-message chat-id text :disable-web-preview 1) (condition (e) (log:error e))))) (defun handle-cmd-akb (chat-id message-id args) (log:info "handle-cmd-akb" chat-id message-id args) (handler-case (progn (let ((total-aneks (aget "count" (vk-wall-get :domain +akb-vk-domain+ :count 1 :offset 10000000)))) (dolist (post (aget "items" (vk-wall-get :domain +akb-vk-domain+ :count (or (ignore-errors (parse-integer (car args))) 1) :offset (random total-aneks)))) (handler-case (telegram-send-message chat-id (format-akb post) :disable-web-preview 1) (condition (e) (log:error e)))))) (condition (e) (log:error e) (telegram-send-message chat-id "some shit happened")))) (defun handle-cmd-rates (chat-id message-id args) (log:info "handle-cmd-rates" chat-id message-id args) (let ((rates (get-rates))) (telegram-send-message chat-id (format nil "Зеленый ~A, гейро ~A" (cdar rates) (cdadr rates))))) (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 #'trivial-timers: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 (clon:make-typed-cron-schedule :minute '* :hour '*) :allow-now-p t) :thread t) (bordeaux-threads:make-thread (lambda () (in-package #:chatikbot) (loop-with-error-backoff #'process-updates)) :name "process-updates"))