Hook system. Cron pending

admin.lisp

@@ -0,0 +1,30 @@
+(in-package #:chatikbot)
+
+(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)))))))))
+
+(def-message-handler handler-admin (message)
+  (when (member from-id *admins*)
+    (multiple-value-bind (cmd args) (parse-cmd text)
+      (case cmd
+        (:eval (bot-send-message chat-id (rep (format nil "~{~A~^ ~}" args))))
+        (otherwise (send-dont-understand chat-id (preprocess-input (subseq text 1))))))
+    t))

chatikbot.asd

@@ -22,6 +22,7 @@
   :serial t
   :components ((:file "package")
                (:file "utils")
+               (:file "hooks")
                (:file "db")
                (:file "telegram")
                (:file "forecast")

chatikbot.lisp

@@ -13,6 +13,8 @@
 (defvar *telegram-last-update* nil "Telegram last update_id")
 (defvar *admins* nil "Admins chat-ids")
 
+
+;; getUpdates handling
 (defun process-updates ()
   (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
                                                          (1+ *telegram-last-update*))
@@ -20,9 +22,14 @@
      do (setf *telegram-last-update*
               (max (or *telegram-last-update* 0)
                    (aget "update_id" update)))
-     do (handle-message (aget "message" update))))
-
-
+     do (handle-update update)))
+
+(defun handle-update (update)
+  (log:info update)
+  (loop for (key . value) in update
+     unless (equal "update_id" key)
+     do (run-update-hooks (key-to-hook-name key) value)))
+;;
 (defun send-response (chat-id response &optional reply-id)
   (if (consp response)
       (if (keywordp (car response))
@@ -33,576 +40,27 @@
           (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
       (telegram-send-message chat-id response :reply-to reply-id)))
 
+(defun bot-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
+  (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
+                                       :disable-web-preview disable-web-preview
+                                       :reply-to reply-to
+                                       :reply-markup reply-markup)
+    (error (e)
+      (log:error e))))
+
 (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 parse-cmd (text)
-  (let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))
-         (cmd (subseq (car args) 0 (position #\@ (car args)))))
-    (values (intern (string-upcase cmd) "KEYWORD") (rest args))))
-
-(defun handle-message (message)
-  (let ((id (aget "message_id" message))
-        (from-id (aget "id" (aget "from" 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))
-          (multiple-value-bind (cmd args) (parse-cmd 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))
-              (:charts (handle-cmd-charts chat-id id args))
-              (:postcheckins (handle-cmd-post-checkins chat-id id args))
-              (:friends (handle-cmd-fsq-friends chat-id id args))
-              (:checkins (handle-cmd-checkins chat-id id args))
-              (:rss (handle-cmd-rss chat-id id args))
-              (:feeds (handle-cmd-feeds chat-id id args))
-              (:lastrss (handle-cmd-last-rss chat-id id args))
-              (:wall (handle-cmd-wall chat-id id args))
-              (:nalunch (handle-cmd-nalunch chat-id id args))
-              (:g (handle-cmd-google chat-id id args))
-              (:г (handle-cmd-google chat-id id args))
-              (otherwise (handle-admin-cmd from-id 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 "Взял на карандаш")
-      (save-settings))
-    (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 (from-id chat-id text cmd args)
-  (if (find from-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)))))
-
-
-;; AKB
-(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)
-    (save-settings)))
-
-(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)
-            (save-settings))))
-    (error (e) (log:error "~A" 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)
-      (error (e) (log:error "~A" 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)
-          (error (e) (log:error e))))))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id "Ошибочка вышла"))))
-
-;; Finance
-(defun process-rates ()
-  (handler-case
-      (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))
-    (error (e) (log:error "~A" e))))
-
-(defun handle-cmd-rates (chat-id message-id args)
-  (log:info "handle-cmd-rates" chat-id message-id args)
-  (multiple-value-bind (ts usd eur gbp brent btc) (db-get-last-finance)
-    (telegram-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")))
-
-(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 handle-cmd-charts (chat-id message-id args)
-  (log:info "handle-cmd-charts" chat-id message-id args)
-  (telegram-send-chat-action chat-id "upload_photo")
-  (handler-case
-      (let* ((args (mapcar 'string-downcase args))
-             (all-fields (mapcar #'car +db-finance-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))))))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id "Хуйня какая-то"))))
-
-;; Weather
-(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
-     (handler-case
-         (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)))
-       (error (e)
-         (log:error "~A" e)
-         "Ошибочка вышла"))
-     "Так а ты чьих будешь?"))))
-
-
-;; Foursquare
-(defun fsq-user-name (user)
-  (when user
-    (format nil "~@[~A~]~@[ ~A~]"
-            (aget "firstName" user)
-            (aget "lastName" user))))
-
-(defun handle-cmd-post-checkins (chat-id message-id args)
-  (log:info "handle-cmd-post-checkins" chat-id message-id args)
-  (handler-case
-      (let ((users (db-fsq-get-chat-users chat-id))
-            (friends (fsq-fetch-friends)))
-        (if (null args)
-            (telegram-send-message chat-id
-                                   (if (null users)
-                                       "Пока никого не палим"
-                                       (format nil "Палим ~{~A~^, ~}"
-                                               (loop for user in friends
-                                                  when (member (aget "id" user)
-                                                               users :test #'equal)
-                                                  collect (fsq-user-name user)))))
-            (progn
-              (dolist (user args)
-                (let ((username (fsq-user-name
-                                 (find user friends
-                                       :test #'equal
-                                       :key #'(lambda (f) (aget "id" f))))))
-                  (when username
-                    (if (member user users :test #'equal)
-                        (progn
-                          (setf users (remove user users :test #'equal))
-                          (telegram-send-message chat-id
-                                                 (format nil "Больше не палим ~A" username)))
-                        (progn
-                          (push user users)
-                          (telegram-send-message chat-id (format nil "Теперь палим ~A" username)))))))
-              (db-fsq-set-chat-users chat-id users))))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id "Ошибочка вышла"))))
-
-(defun handle-cmd-fsq-friends (chat-id message-id args)
-  (log:info "handle-cmd-fsq-friends" chat-id message-id args)
-  (handler-case
-      (let ((users (db-fsq-get-chat-users chat-id))
-            (friends (fsq-fetch-friends)))
-        (telegram-send-message
-         chat-id
-         (format
-          nil "~{~A: ~:[~;📍 ~]~A~^~%~}"
-          (loop for user in friends
-             append (list
-                     (aget "id" user)
-                     (member (aget "id" user) users :test #'equal)
-                     (fsq-user-name user))))))
-    (error (e) (log:error "~A" e))))
-
-
-(defun handle-cmd-checkins (chat-id message-id args)
-  (log:info "handle-cmd-checkins" chat-id message-id args)
-  (handler-case
-      (let ((users (db-fsq-get-chat-users chat-id)))
-        (when users
-          (telegram-send-message
-           chat-id
-           (format nil "~{~A~^~%~}"
-                   (loop for checkin in (fsq-fetch-checkins)
-                      if (member (aget "id" (aget "user" checkin)) users :test #'equal)
-                      collect (fsq-format-checkin checkin t))))))
-    (error (e) (log:error "~A" e))))
-
-
-(defun process-latest-checkins ()
-  (handler-case
-      (let ((checkins (make-hash-table))
-            (ts (princ-to-string (1+ (or (db-fsq-last-created) -1)))))
-        (dolist (checkin (fsq-fetch-checkins ts))
-          (let ((id (aget "id" checkin))
-                (created-at (aget "createdAt" checkin))
-                (user (aget "id" (aget "user" checkin))))
-            (unless (db-fsq-has-seen id)
-              (dolist (chat-id (db-fsq-get-user-chats user))
-                (push (fsq-format-checkin checkin)
-                      (gethash chat-id checkins)))
-              (db-fsq-add-seen id created-at))))
-        (loop for chat-id being the hash-keys in checkins using (hash-value texts)
-           do (log:info "Sending checkins" chat-id texts)
-             (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts))))
-    (error (e) (log:error "~A" e))))
-
-
-;; RSS
-(defun handle-cmd-feeds (chat-id message-id args)
-  (log:info "handle-cmd-feeds" chat-id message-id args)
-  (handler-case
-      (telegram-send-message
-       chat-id
-       (if (null args)
-           "URL давай"
-           (format nil "~:[Не нашел RSS там~;~:*~{~{~A - ~A~}~^~%~}~]"
-                   (find-rss-links (car args))))
-       :disable-web-preview 1)
-    (condition (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id "Ошибочка вышла"))))
-
-(defun %send-feeds (chat-id feeds)
-  (telegram-send-message
-   chat-id
-   (if (null feeds)
-       "Пока ничего не постим"
-       (format nil "Постим~%~{~A) ~A: ~A~^~%~}"
-               (loop for feed in feeds
-                  for index from 1
-                  append (list index (feed-title feed) (feed-url feed)))))
-   :disable-web-preview 1))
-
-(defun %fetch-new-items (feed)
-  (loop for item in (refresh-feed feed #'db-rss-item-exists)
-     do (db-rss-add-item item)
-     collect item))
-
-(defun %get-feed (url)
-  (when url
-    (or (db-rss-get-feed-by-url url)
-        (alexandria:when-let (feed (build-feed url))
-          (log:info "Added feed" feed)
-          (db-rss-add-feed feed)
-          (%fetch-new-items feed)
-          feed))))
-
-(defun handle-cmd-rss (chat-id message-id args)
-  (log:info "handle-cmd-rss" chat-id message-id args)
-  (handler-case
-      (let ((feeds (db-rss-get-chat-feeds chat-id)))
-        (if (null args)
-            (%send-feeds chat-id feeds)
-            (progn
-              (dolist (url args)
-                (handler-case
-                    (let ((idx (parse-integer url)))
-                      (when (<= idx (length feeds))
-                        (setf feeds (remove (nth (1- idx) feeds) feeds))))
-                  (parse-error ()
-                    (alexandria:when-let (feed (%get-feed
-                                                (or (cadar (find-rss-links url))
-                                                    url)))
-                      (let ((existing (find (feed-url feed) feeds :key #'feed-url :test #'equal)))
-                        (if existing
-                            (setf feeds (remove existing feeds))
-                            (push feed feeds)))))
-                  (error (e) (log:error "~A" e))))
-              (db-rss-set-chat-feeds chat-id feeds)
-              (%send-feeds chat-id (db-rss-get-chat-feeds chat-id)))))
-    (condition (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id (format nil "Ошибочка вышла: ~A" e)))))
-
-(defun handle-cmd-last-rss (chat-id message-id args)
-  (log:info "handle-cmd-last-rss" chat-id message-id args)
-  (handler-case
-      (let ((feeds (db-rss-get-chat-feeds chat-id)))
-        (if (null args)
-            (%send-feeds chat-id feeds)
-            (let* ((idx (1- (parse-integer (car args))))
-                   (limit (min 20 (if (> (length args) 1) (parse-integer (second args)) 5)))
-                   (items (db-rss-last-feed-items (nth idx feeds) limit)))
-              (telegram-send-message chat-id
-                                     (format nil "~{~A~^~%~%~}"
-                                             (mapcar #'format-feed-item items))
-                                     :parse-mode "Markdown"
-                                     :disable-web-preview 1))))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id "Ошибочка вышла"))))
-
-(defun process-feeds ()
-  (handler-case
-      (dolist (feed (remove-if-not #'need-fetch-p (db-rss-get-active-feeds)))
-        (log:info "Fetching new items" (feed-url feed))
-        (dolist (item (%fetch-new-items feed))
-          (dolist (chat-id (db-rss-get-feed-chats feed))
-            (telegram-send-message chat-id
-                                   (format-feed-item item)
-                                   :parse-mode "Markdown"
-                                   :disable-web-preview 1)))
-        (db-rss-update-feed feed)) ;; Update next fetch and period
-    (error (e) (log:error "~A" e))))
-
-;; VK walls
-(defun %send-domains (chat-id domains)
-  (telegram-send-message
-   chat-id
-   (if (null domains)
-       "Пока ничего не постим"
-       (format nil "Постим~%~{~A) https://vk.com/~A~^~%~}"
-               (loop for d in domains for i from 1 append (list i d))))
-   :disable-web-preview 1))
-
-(defun %find-vk-domain (url)
-  (let ((path (puri:uri-path (puri:parse-uri url))))
-    (if (equal #\/ (elt path 0))
-        (subseq path 1)
-        path)))
-
-(defun %ensure-domain (domain)
-  (let* ((res (vk-wall-get :domain domain :count 1))
-         (last-id (aget "id" (first (aget "items" res)))))
-    (db-vk-ensure-domain domain last-id)
-    domain))
-
-(defun %vk-find-best-photo (attach)
-  (when attach
-    (let* ((photo (aget "photo" attach))
-           (sizes (loop for (k . v) in photo
-                    when (equal "photo_" (subseq k 0 (min 6 (length k))))
-                    collect (cons (parse-integer (subseq k 6)) v))))
-      (cdr (assoc (apply #'max (mapcar #'car sizes)) sizes)))))
-
-(defun %vk-find-video (attach)
-  (when attach
-    (let ((video (aget "video" attach)))
-      (format nil "https://vk.com/video~A_~A"
-              (aget "owner_id" video)
-              (aget "id" video)))))
-
-(defun %vk-find-preview (attachments)
-  (labels ((find-type (type)
-             (find type attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
-    (or
-     (%vk-find-best-photo (find-type "photo"))
-     (%vk-find-video (find-type "video")))))
-
-(defparameter +vk-link-scanner+ (cl-ppcre:create-scanner "\\[((id|club)\\d+)\\|([^\\]]*?)\\]") "vk linking regex")
-
-(defun %vk-post-text (post)
-  (let* ((history (aget "copy_history" post))
-         (reposts (loop for p in history
-                     collect (let* ((owner (aget "owner_id" p))
-                                    (type (if (> owner 0) "id" "club"))
-                                    (id (abs owner)))
-                               (format nil "[~A](https://vk.com/~A~A)"
-                                       (vk-get-name owner) type id)))))
-    (when history
-      (setf post (car (last history))))
-    (values
-     (cl-ppcre:regex-replace-all +vk-link-scanner+
-                                 (aget "text" post)
-                                 "[\\3](https://vk.com/\\1)")
-     (%vk-find-preview (aget "attachments" post))
-     reposts)))
-
-(defun %format-wall-post (domain name post)
-  (multiple-value-bind (text preview reposts) (%vk-post-text post)
-    (values
-     (format nil "~@[[✅](~A) ~][~A](https://vk.com/~A?w=wall~A_~A)~@[ ~{↩ ~A~}~]~@[ @ ~A~]~%~A"
-             preview name domain (aget "from_id" post) (aget "id" post)
-             reposts (format-ts (local-time:unix-to-timestamp (aget "date" post)))
-             text)
-     (if preview 0 1))))
-
-(defun handle-cmd-wall (chat-id message-id args)
-  (log:info "handle-cmd-wall" chat-id message-id args)
-  (handler-case
-      (let ((domains (db-vk-get-chat-domains chat-id)))
-        (if (null args)
-            (%send-domains chat-id domains)
-            (progn
-              (dolist (url args)
-                (handler-case
-                    (let ((idx (parse-integer url)))
-                      (db-vk-remove-chat-domain chat-id (nth (1- idx) domains)))
-                  (parse-error ()
-                    (let* ((domain (%ensure-domain (%find-vk-domain url)))
-                           (existing (find domain domains :test #'equal)))
-                      (if existing
-                          (db-vk-remove-chat-domain chat-id domain)
-                          (db-vk-add-chat-domain chat-id domain))))
-                  (error (e) (log:error "~A" e))))
-              (%send-domains chat-id (db-vk-get-chat-domains chat-id)))))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id (format nil "Ошибочка вышла: ~A" e)))))
-
-(defun process-walls ()
-  (handler-case
-      (loop for (domain last-id next-fetch period) in (db-vk-get-active-walls)
-         when (or (null next-fetch)
-                  (local-time:timestamp> (local-time:now) (local-time:unix-to-timestamp next-fetch)))
-         do (progn
-              (log:info "Fetching wall" domain)
-              (handler-case
-                  (let ((new-posts
-                         (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
-                                 :test #'>= :key (lambda (p) (aget "id" p))))
-                        name)
-                    (setf period (adjust-period period (length new-posts)))
-                    (when new-posts
-                      (setf name (vk-get-name domain)))
-                    (dolist (post new-posts)
-                      (multiple-value-bind (text disable)
-                          (%format-wall-post domain name post)
-                        (dolist (chat-id (db-vk-get-domain-chats domain))
-                          (ignore-errors
-                            (telegram-send-message chat-id text
-                                                   :parse-mode "Markdown"
-                                                   :disable-web-preview disable))))
-                      (setf last-id (max last-id (aget "id" post)))))
-                (error (e) (log:error "~A" e)))
-              (db-vk-update-wall domain last-id
-                                 (local-time:timestamp-to-unix
-                                  (local-time:timestamp+ (local-time:now) period :sec))
-                                 period))) ;; Update last-id, next-fetch and period
-    (error (e) (log:error "~A" e))))
-
-(defun handle-cmd-nalunch (chat-id message-id args)
-  (log:info "handle-cmd-nalunch" chat-id message-id args)
-  (handler-case
-      (if (member chat-id *admins*)
-          (send-response chat-id (nalunch-format
-                                  (or *nalunch-last-result*
-                                      (setf *nalunch-last-result*
-                                            (nalunch-recent)))))
-          (send-dont-understand chat-id))
-    (error (e)
-      (log:error "~A" e)
-      (telegram-send-message chat-id (format nil "~A" e)))))
-
-(defvar *nalunch-last-result* nil "Last check result")
-(defun process-nalunch ()
-  (handler-case
-      (let ((result (nalunch-recent)))
-        (unless (equal (aget :balance *nalunch-last-result*)
-                       (aget :balance result))
-          (send-response (car *admins*) (nalunch-format result t))
-          (setf *nalunch-last-result* result)))
-    (error (e) (log:error "~A" e))))
-
-(defun handle-cmd-google (chat-id message-id args)
-  (log:info "handle-cmd-google" chat-id message-id args)
-  (handler-case
-      (telegram-send-message chat-id
-                             (google-format-search-results
-                              (subseq
-                               (google-search (format nil "~{~A~^ ~}" args))
-                               0 3))
-                             :parse-mode "markdown"
-                             :disable-web-preview 1)
-    (error (e)
-           (log:error "~A" e)
-           (telegram-send-message chat-id (format nil "~A" e)))))
+(defun handle-unknown-message (message)
+  (let ((chat-id (aget "id" (aget "chat" message)))
+        (text (aget "text" message)))
+    (log:info "handle-unknown-message" message)
+    (send-dont-understand chat-id (preprocess-input text))
+    t))
+(add-update-hook :message 'handle-unknown-message t)
 
 (defun process-watchdog ()
   (ignore-errors

finance.lisp

@@ -7,6 +7,12 @@
 
 (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+
@@ -68,3 +74,44 @@
                              :format fmt)))
       (adw-charting:set-axis :y "RUB" :draw-gridlines-p t :label-formatter "~,2F")
       (adw-charting:save-file "chart.png"))))
+
+;; Cron
+(defun process-rates ()
+  (handler-case
+      (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))
+    (error (e) (log:error "~A" e))))
+
+;;; 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 +db-finance-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)))))))

forecast.lisp

@@ -69,3 +69,28 @@
             (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 handler-location (message)
+  (let ((chat-id (aget "id" (aget "chat" message)))
+        (location (aget "location" message)))
+    (when location
+      (log:info "handler-location" chat-id location)
+      (push (cons chat-id location) *chat-locations*)
+      (bot-send-message chat-id "Взял на карандаш")
+      (save-settings)
+      t)))
+
+(def-message-cmd-handler handler-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)))

foursquare.lisp

@@ -20,7 +20,7 @@
          (meta (aget "meta" resp)))
     (when (not (= 200 (aget "code" meta)))
       (error (format nil "Foursquare API error, code ~A, errorType '~A', errorDetail '~A'"
-                     (aget "code" meta) (aget "errorType" meta) (aget "errorDetail" meta))))    
+                     (aget "code" meta) (aget "errorType" meta) (aget "errorDetail" meta))))
     (aget "response" resp)))
 
 (defun fsq-fetch-checkins (&optional after-timestamp limit)
@@ -37,6 +37,14 @@
                (%fsq-api-call "users/self/friends"
                               (list (cons "offset" (or offset "0"))))))))
 
+;; Formatting
+
+(defun fsq-user-name (user)
+  (when user
+    (format nil "~@[~A~]~@[ ~A~]"
+            (aget "firstName" user)
+            (aget "lastName" user))))
+
 (defun fsq-format-checkin (checkin &optional with-dates)
   (when checkin
     (let ((user (aget "user" checkin))
@@ -50,3 +58,74 @@
                nil
                (local-time:unix-to-timestamp (aget "createdAt" checkin))
                :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))))))
+
+;; Cron
+(defun process-latest-checkins ()
+  (handler-case
+      (let ((checkins (make-hash-table))
+            (ts (princ-to-string (1+ (or (db-fsq-last-created) -1)))))
+        (dolist (checkin (fsq-fetch-checkins ts))
+          (let ((id (aget "id" checkin))
+                (created-at (aget "createdAt" checkin))
+                (user (aget "id" (aget "user" checkin))))
+            (unless (db-fsq-has-seen id)
+              (dolist (chat-id (db-fsq-get-user-chats user))
+                (push (fsq-format-checkin checkin)
+                      (gethash chat-id checkins)))
+              (db-fsq-add-seen id created-at))))
+        (loop for chat-id being the hash-keys in checkins using (hash-value texts)
+           do (log:info "Sending checkins" chat-id texts)
+             (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts))))
+    (error (e) (log:error "~A" e))))
+
+;; Hooks
+(def-message-cmd-handler handler-post-checkins (:postcheckins)
+  (let ((users (db-fsq-get-chat-users chat-id))
+        (friends (fsq-fetch-friends)))
+    (if (null args)
+        (bot-send-message chat-id
+                          (if (null users)
+                              "Пока никого не палим"
+                              (format nil "Палим ~{~A~^, ~}"
+                                      (loop for user in friends
+                                         when (member (aget "id" user)
+                                                      users :test #'equal)
+                                         collect (fsq-user-name user)))))
+        (progn
+          (dolist (user args)
+            (let ((username (fsq-user-name
+                             (find user friends
+                                   :test #'equal
+                                   :key #'(lambda (f) (aget "id" f))))))
+              (when username
+                (if (member user users :test #'equal)
+                    (progn
+                      (setf users (remove user users :test #'equal))
+                      (bot-send-message chat-id
+                                        (format nil "Больше не палим ~A" username)))
+                    (progn
+                      (push user users)
+                      (bot-send-message chat-id (format nil "Теперь палим ~A" username)))))))
+          (db-fsq-set-chat-users chat-id users)))))
+
+(def-message-cmd-handler handler-friends (:friends)
+  (let ((users (db-fsq-get-chat-users chat-id))
+        (friends (fsq-fetch-friends)))
+    (bot-send-message chat-id
+                      (format
+                       nil "~{~A: ~:[~;📍 ~]~A~^~%~}"
+                       (loop for user in friends
+                          append (list
+                                  (aget "id" user)
+                                  (member (aget "id" user) users :test #'equal)
+                                  (fsq-user-name user)))))))
+
+
+(def-message-cmd-handler handle-checkins (:checkins)
+  (let ((users (db-fsq-get-chat-users chat-id)))
+    (when users
+      (bot-send-message chat-id
+                        (format nil "~{~A~^~%~}"
+                                (loop for checkin in (fsq-fetch-checkins)
+                                   if (member (aget "id" (aget "user" checkin)) users :test #'equal)
+                                   collect (fsq-format-checkin checkin t)))))))

google.lisp

@@ -25,3 +25,13 @@
                                   (aget :url result)
                                   (replace-all (aget :desc result)
                                                '(#\Newline) ""))))))
+
+;;; Hooks
+(def-message-cmd-handler handler-cmd-google (:google :g :г :q)
+  (bot-send-message chat-id
+                    (google-format-search-results
+                     (subseq
+                      (google-search (format nil "~{~A~^ ~}" args))
+                      0 3))
+                    :parse-mode "markdown"
+                    :disable-web-preview 1))

hooks.lisp

@@ -0,0 +1,51 @@
+(in-package #:chatikbot)
+
+(defvar *update-hooks* (make-hash-table) "Update hooks storage")
+
+(defun run-update-hooks (hook-name update)
+  (let ((hooks (gethash hook-name *update-hooks*)))
+    (labels ((try-handle (func)
+               (funcall func update)))
+      (unless (some #'try-handle hooks)
+        (log:info "unhandled" update)))))
+
+(defun add-update-hook (hook-name handler &optional append)
+  (let ((existing (gethash hook-name *update-hooks*))
+        (func (if (functionp handler) handler (symbol-function handler))))
+    (unless (member func existing)
+      (setf (gethash hook-name *update-hooks*)
+            (if append (append existing (list func))
+                (cons func existing))))))
+
+(defun delete-update-hook (hook-name handler)
+  (setf (gethash hook-name *update-hooks*)
+        (remove (if (functionp handler) handler (symbol-function handler))
+                (gethash hook-name *update-hooks*))))
+
+(defun key-to-hook-name (key)
+  (intern (string-upcase (substitute #\- #\_ key)) :keyword))
+
+(defmacro def-message-handler (name (message) &body body)
+  `(progn
+     (defun ,name (,message)
+       (let ((message-id (aget "message_id" ,message))
+             (from-id (aget "id" (aget "from" ,message)))
+             (chat-id (aget "id" (aget "chat" ,message)))
+             (text (aget "text" ,message)))
+         (declare (ignorable message-id from-id chat-id text))
+         (handler-case (progn ,@body)
+           (error (e)
+             (log:error "~A" e)
+             (bot-send-message chat-id
+                               (format nil "Ошибочка вышла~@[: ~A~]"
+                                       (when (member chat-id *admins*) e)))))))
+     (add-update-hook :message ',name)))
+
+(defmacro def-message-cmd-handler (name (&rest commands) &body body)
+  `(def-message-handler ,name (message)
+     (when (and text (equal #\/ (char text 0)))
+       (multiple-value-bind (cmd args) (parse-cmd text)
+         (when (member cmd (list ,@commands))
+           (log:info cmd message-id chat-id from-id args)
+           ,@body
+           t)))))

nalunch.lisp

@@ -87,3 +87,23 @@
             (mapcar (lambda (meal) (format nil "~A @ ~A — ~A руб."
                                            (aget :time meal) (aget :place meal) (aget :price meal)))
                     recent))))
+
+;; Cron
+(defvar *nalunch-last-result* nil "Last check result")
+(defun process-nalunch ()
+  (handler-case
+      (let ((result (nalunch-recent)))
+        (unless (equal (aget :balance *nalunch-last-result*)
+                       (aget :balance result))
+          (send-response (car *admins*) (nalunch-format result t))
+          (setf *nalunch-last-result* result)))
+    (error (e) (log:error "~A" e))))
+
+;; Hooks
+(def-message-cmd-handler handler-cmd-nalunch (:nalunch)
+  (if (member chat-id *admins*)
+      (send-response chat-id (nalunch-format
+                              (or *nalunch-last-result*
+                                  (setf *nalunch-last-result*
+                                        (nalunch-recent)))))
+      (send-dont-understand chat-id)))

rss.lisp

@@ -70,6 +70,30 @@
 (defun clean-text (text)
   (when text (trim-nil (plump:text (plump:parse text)))))
 
+(defun %send-feeds (chat-id feeds)
+  (bot-send-message chat-id
+                    (if (null feeds)
+                        "Пока ничего не постим"
+                        (format nil "Постим~%~{~A) ~A: ~A~^~%~}"
+                                (loop for feed in feeds
+                                   for index from 1
+                                   append (list index (feed-title feed) (feed-url feed)))))
+                    :disable-web-preview 1))
+
+(defun %fetch-new-items (feed)
+  (loop for item in (refresh-feed feed #'db-rss-item-exists)
+     do (db-rss-add-item item)
+     collect item))
+
+(defun %get-feed (url)
+  (when url
+    (or (db-rss-get-feed-by-url url)
+        (alexandria:when-let (feed (build-feed url))
+          (log:info "Added feed" feed)
+          (db-rss-add-feed feed)
+          (%fetch-new-items feed)
+          feed))))
+
 (defun fetch-feed-items (feed)
   (let ((plump:*tag-dispatchers* plump:*xml-tags*))
     (loop for item in (get-by-tag (xml-request (feed-url feed)) "item")
@@ -104,3 +128,62 @@
 (defun feed-item-published-unix (item)
   (alexandria:when-let (ts (feed-item-published item))
     (local-time:timestamp-to-unix ts)))
+
+;; Cron
+(defun process-feeds ()
+  (handler-case
+      (dolist (feed (remove-if-not #'need-fetch-p (db-rss-get-active-feeds)))
+        (log:info "Fetching new items" (feed-url feed))
+        (dolist (item (%fetch-new-items feed))
+          (dolist (chat-id (db-rss-get-feed-chats feed))
+            (telegram-send-message chat-id
+                                   (format-feed-item item)
+                                   :parse-mode "Markdown"
+                                   :disable-web-preview 1)))
+        (db-rss-update-feed feed)) ;; Update next fetch and period
+    (error (e) (log:error "~A" e))))
+
+;; Hooks
+(def-message-cmd-handler handler-cmd-feeds (:feeds)
+  (bot-send-message
+   chat-id
+   (if (null args)
+       "URL давай"
+       (format nil "~:[Не нашел RSS там~;~:*~{~{~A - ~A~}~^~%~}~]"
+               (find-rss-links (car args))))
+   :disable-web-preview 1))
+
+(def-message-cmd-handler handler-cmd-rss (:rss)
+  (let ((feeds (db-rss-get-chat-feeds chat-id)))
+    (if (null args)
+        (%send-feeds chat-id feeds)
+        (progn
+          (dolist (url args)
+            (handler-case
+                (let ((idx (parse-integer url)))
+                  (when (<= idx (length feeds))
+                    (setf feeds (remove (nth (1- idx) feeds) feeds))))
+              (parse-error ()
+                (alexandria:when-let (feed (%get-feed
+                                            (or (cadar (find-rss-links url))
+                                                url)))
+                  (let ((existing (find (feed-url feed) feeds :key #'feed-url :test #'equal)))
+                    (if existing
+                        (setf feeds (remove existing feeds))
+                        (push feed feeds)))))
+              (error (e) (log:error "~A" e))))
+          (db-rss-set-chat-feeds chat-id feeds)
+          (%send-feeds chat-id (db-rss-get-chat-feeds chat-id))))))
+
+(def-message-cmd-handler handler-cmd-last-rss (:lastrss)
+  (let ((feeds (db-rss-get-chat-feeds chat-id)))
+    (if (null args)
+        (%send-feeds chat-id feeds)
+        (let* ((idx (1- (parse-integer (car args))))
+               (limit (min 20 (if (> (length args) 1) (parse-integer (second args)) 5)))
+               (items (db-rss-last-feed-items (nth idx feeds) limit)))
+          (telegram-send-message chat-id
+                                 (format nil "~{~A~^~%~%~}"
+                                         (mapcar #'format-feed-item items))
+                                 :parse-mode "Markdown"
+                                 :disable-web-preview 1)))))

utils.lisp

@@ -83,6 +83,18 @@ is replaced with replacement."
        (nreverse (push (car cur) result)))
     (push (car cur) result)))
 
+(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 parse-cmd (text)
+  (let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))
+         (cmd (subseq (car args) 0 (position #\@ (car args)))))
+    (values (intern (string-upcase cmd) "KEYWORD") (rest args))))
+
 (defun http-default (url)
   (let ((uri (puri:uri url)))
     (puri:render-uri

vk.lisp

@@ -44,3 +44,142 @@
   (if (and (numberp id) (> id 0))
       (vk-get-user-name id)
       (vk-get-group-name id)))
+
+;; Cron
+(defun process-walls ()
+  (handler-case
+      (loop for (domain last-id next-fetch period) in (db-vk-get-active-walls)
+         when (or (null next-fetch)
+                  (local-time:timestamp> (local-time:now) (local-time:unix-to-timestamp next-fetch)))
+         do (progn
+              (log:info "Fetching wall" domain)
+              (handler-case
+                  (let ((new-posts
+                         (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
+                                 :test #'>= :key (lambda (p) (aget "id" p))))
+                        name)
+                    (setf period (adjust-period period (length new-posts)))
+                    (when new-posts
+                      (setf name (vk-get-name domain)))
+                    (dolist (post new-posts)
+                      (multiple-value-bind (text disable)
+                          (%format-wall-post domain name post)
+                        (dolist (chat-id (db-vk-get-domain-chats domain))
+                          (ignore-errors
+                            (telegram-send-message chat-id text
+                                                   :parse-mode "Markdown"
+                                                   :disable-web-preview disable))))
+                      (setf last-id (max last-id (aget "id" post)))))
+                (error (e) (log:error "~A" e)))
+              (db-vk-update-wall domain last-id
+                                 (local-time:timestamp-to-unix
+                                  (local-time:timestamp+ (local-time:now) period :sec))
+                                 period))) ;; Update last-id, next-fetch and period
+    (error (e) (log:error "~A" e))))
+
+;; Hooks
+(defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'")
+
+(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)))
+
+(def-message-cmd-handler handler-akb (:akb)
+  (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))))
+      (bot-send-message chat-id (format-akb post) :disable-web-preview 1))))
+
+;; VK walls
+(defun %send-domains (chat-id domains)
+  (bot-send-message
+   chat-id
+   (if (null domains)
+       "Пока ничего не постим"
+       (format nil "Постим~%~{~A) https://vk.com/~A~^~%~}"
+               (loop for d in domains for i from 1 append (list i d))))
+   :disable-web-preview 1))
+
+(defun %find-vk-domain (url)
+  (let ((path (puri:uri-path (puri:parse-uri url))))
+    (if (equal #\/ (elt path 0))
+        (subseq path 1)
+        path)))
+
+(defun %ensure-domain (domain)
+  (let* ((res (vk-wall-get :domain domain :count 1))
+         (last-id (aget "id" (first (aget "items" res)))))
+    (db-vk-ensure-domain domain last-id)
+    domain))
+
+(defun %vk-find-best-photo (attach)
+  (when attach
+    (let* ((photo (aget "photo" attach))
+           (sizes (loop for (k . v) in photo
+                    when (equal "photo_" (subseq k 0 (min 6 (length k))))
+                    collect (cons (parse-integer (subseq k 6)) v))))
+      (cdr (assoc (apply #'max (mapcar #'car sizes)) sizes)))))
+
+(defun %vk-find-video (attach)
+  (when attach
+    (let ((video (aget "video" attach)))
+      (format nil "https://vk.com/video~A_~A"
+              (aget "owner_id" video)
+              (aget "id" video)))))
+
+(defun %vk-find-preview (attachments)
+  (labels ((find-type (type)
+             (find type attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
+    (or
+     (%vk-find-best-photo (find-type "photo"))
+     (%vk-find-video (find-type "video")))))
+
+(defparameter +vk-link-scanner+ (cl-ppcre:create-scanner "\\[((id|club)\\d+)\\|([^\\]]*?)\\]") "vk linking regex")
+
+(defun %vk-post-text (post)
+  (let* ((history (aget "copy_history" post))
+         (reposts (loop for p in history
+                     collect (let* ((owner (aget "owner_id" p))
+                                    (type (if (> owner 0) "id" "club"))
+                                    (id (abs owner)))
+                               (format nil "[~A](https://vk.com/~A~A)"
+                                       (vk-get-name owner) type id)))))
+    (when history
+      (setf post (car (last history))))
+    (values
+     (cl-ppcre:regex-replace-all +vk-link-scanner+
+                                 (aget "text" post)
+                                 "[\\3](https://vk.com/\\1)")
+     (%vk-find-preview (aget "attachments" post))
+     reposts)))
+
+(defun %format-wall-post (domain name post)
+  (multiple-value-bind (text preview reposts) (%vk-post-text post)
+    (values
+     (format nil "~@[[✅](~A) ~][~A](https://vk.com/~A?w=wall~A_~A)~@[ ~{↩ ~A~}~]~@[ @ ~A~]~%~A"
+             preview name domain (aget "from_id" post) (aget "id" post)
+             reposts (format-ts (local-time:unix-to-timestamp (aget "date" post)))
+             text)
+     (if preview 0 1))))
+
+(def-message-cmd-handler handler-cmd-wall (:wall)
+  (let ((domains (db-vk-get-chat-domains chat-id)))
+    (if (null args)
+        (%send-domains chat-id domains)
+        (progn
+          (dolist (url args)
+            (handler-case
+                (let ((idx (parse-integer url)))
+                  (db-vk-remove-chat-domain chat-id (nth (1- idx) domains)))
+              (parse-error ()
+                (let* ((domain (%ensure-domain (%find-vk-domain url)))
+                       (existing (find domain domains :test #'equal)))
+                  (if existing
+                      (db-vk-remove-chat-domain chat-id domain)
+                      (db-vk-add-chat-domain chat-id domain))))
+              (error (e) (log:error "~A" e))))
+          (%send-domains chat-id (db-vk-get-chat-domains chat-id))))))