chatikbot/plugins/zhanna.lisp

(in-package #:chatikbot)

(defsetting *zhanna-token-id* nil)
(defsetting *zhanna-sheet-id* "1kLBodFUwcfbpdqe_d2d01MHij95NAVcKrmpjotYsUQk")

(defun %zh-parse-values (rows)
  (labels ((non-empty (s)
             (unless (equal s "") s))
           (get-el (row idx)
             (when (> (length row) idx)
               (non-empty (elt row idx))))
           (get-item (row start)
             (cons (get-el row start) (get-el row (1+ start)))))
    (loop for start to 4 by 2
       append (loop for row in rows
                 for item = (get-item row start)
                 when (car item)
                 collect (cons (subseq (car item) 0 5) (cdr item))))))

(defparameter +zhanna-dows+ '("вс" "пн" "вт" "ср" "чт" "пт" "сб"))
(defun zhanna-get-schedule (&rest days)
  (labels ((dow-range (dow)
             (format nil "'~A'!A3:F22" (elt +zhanna-dows+ dow))))
    (let* ((ranges (mapcar #'dow-range days))
           (resp (gsheets-get-sheet-values *zhanna-token-id* *zhanna-sheet-id* ranges)))
      (loop for vr in (aget "valueRanges" resp)
         collect (cons (subseq (aget "range" vr) 1 3)
                       (%zh-parse-values (aget "values" vr)))))))

(defun %zh-diff-schedule (old-s new-s)
  (let ((times (mapcar #'car (union old-s new-s :key #'car :test #'equal))))
    (loop for time in times
       for new = (aget time new-s)
       for old = (aget time old-s)
       unless (equal new old)
       collect (list (cons new old) time))))

(defun %zh-format-diff (diff)
  (labels ((join (joined value)
             (destructuring-bind (change time) value
               (let ((existing (aget change joined)))
                 (if existing
                     (progn
                       (setf (cdr existing) (append (cdr existing) (list time)))
                       joined)
                     (append joined (list value))))))
           (text-change (change)
             (destructuring-bind (new . old) change
               (cond
                 ((null old) (format nil "🏄 ~A" new))
                 ((null new) (format nil "💔 ~A" old))
                 (:otherwise (format nil "~A 🔁 ~A" old new))))))
    (let ((joined (reduce #'join diff :initial-value (list))))
      (format nil "~{~A~^~%~}" (loop for (change . times) in joined
                                  collect (format nil "~A: ~{~A~^, ~}" (text-change change) times))))))

(defsetting *zhanna-subscriptions* nil "chat-ids of schedule changes receivers")
(defvar *zhanna-last-schedule* nil "Schedule from last cron run")
(defcron process-zhanna ()
  (let ((schedule (zhanna-get-schedule 1 2 3 4 5 6 0)))
    (when *zhanna-last-schedule*
      (handler-case
          (let* ((day-changes (loop for dow in +zhanna-dows+
                                 for new-s = (aget dow schedule)
                                 for old-s = (aget dow *zhanna-last-schedule*)
                                 for diff = (%zh-diff-schedule old-s new-s)
                                 when diff
                                 collect (format nil "*~A:*~%~A" dow (%zh-format-diff diff))))
                 (msg (format nil "~{~A~^~%~%~}" day-changes)))
            (when day-changes
              (log:info msg)
              (dolist (chat-id *zhanna-subscriptions*)
                (bot-send-message chat-id msg :parse-mode "markdown"))))
        (error (e) (log:error e))))
    (setf *zhanna-last-schedule* schedule)
    (values)))

(def-message-cmd-handler zhanna-free-handler (:free :свободна :свободно)
  (let* ((dows (if args (remove nil (mapcar
                                     #'(lambda (a) (position a +zhanna-dows+ :test #'equal))
                                     args))
                   (list (mod (1+ (local-time:timestamp-day-of-week (local-time:now))) 7))))
         (schedule (apply #'zhanna-get-schedule dows))
         (texts (loop for (dow . day-schedule) in schedule
                   collect (format nil "*~A*~%~{~A~^, ~}" dow
                                   (mapcar #'car (remove nil day-schedule :key #'cdr :test-not #'eql))))))
    (bot-send-message chat-id (format nil "Жанна свободна:~%~{~A~^~%~}" texts) :parse-mode "markdown")))