VK photos support

chatikbot.lisp

@@ -460,39 +460,36 @@
     (db-vk-ensure-domain domain last-id)
     domain))
 
-(defun %vk-find-best-photo (photo)
-  (let ((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-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 %format-attachment (item)
-  (cond
-    ((equal "photo" (aget "type" item))
-     (%vk-find-best-photo (aget "photo" item)))))
+(defun %vk-find-picture (attachments)
+  (%vk-find-best-photo (find "photo" attachments :key #'(lambda (a) (aget "type" a)) :test #'equal)))
 
 (defparameter +vk-link-scanner+ (cl-ppcre:create-scanner "\\[((id|club)\\d+)\\|([^\\]]*?)\\]") "vk linking regex")
-(defun %vk-format-text (text)
-  (cl-ppcre:regex-replace-all +vk-link-scanner+ text "[\\3](https://vk.com/\\1)"))
 
 (defun %vk-post-text (post)
   (alexandria:when-let (reposts (aget "copy_history" post))
     (setf post (car (last reposts))))
-  (let ((text (%vk-format-text (aget "text" post)))
-        (attachs (format nil "~{~A~^~%~}"
-                         (remove nil (mapcar #'%format-attachment
-                                             (aget "attachments" post))))))
-    (format nil "~{~A~^~%~}" (remove "" (list text attachs) :test #'equal))))
+  (values
+   (cl-ppcre:regex-replace-all +vk-link-scanner+
+                               (aget "text" post)
+                               "[\\3](https://vk.com/\\1)")
+   (%vk-find-picture (aget "attachments" post))))
 
 (defun %format-wall-post (domain post)
-  (format nil "[~A](https://vk.com/~A?w=wall~A_~A)~@[ @ _~A_~]~%~A~%"
-          domain domain (aget "from_id" post) (aget "id" post)
-          (alexandria:when-let (ts (local-time:unix-to-timestamp (aget "date" post)))
-            (local-time:format-timestring
-             nil ts
-             :format '((:year 2) "-" (:month 2) "-" (:day 2)
-                       " " (:hour 2) ":" (:min 2))))
-          (%vk-post-text post)))
+  (multiple-value-bind (text preview) (%vk-post-text post)
+    (values
+     (format nil "~@[[✅](~A)~] [~A](https://vk.com/~A?w=wall~A_~A)~@[ @ ~A~]~%~A"
+             preview domain domain (aget "from_id" post) (aget "id" post)
+             (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)
@@ -532,10 +529,11 @@
                     (dolist (post new-posts)
                       (dolist (chat-id (db-vk-get-domain-chats domain))
                         (ignore-errors
-                          (telegram-send-message chat-id
-                                                 (%format-wall-post domain post)
-                                                 :parse-mode "Markdown"
-                                                 :disable-web-preview 1)))
+                          (multiple-value-bind (text disable) (%format-wall-post domain post)
+                            (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 e)))
               (db-vk-update-wall domain last-id