chatikbot/plugins/zhanna.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.zhanna
  (:use :cl :chatikbot.common :chatikbot.gsheets))
(in-package :chatikbot.plugins.zhanna)

(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 y from 0
                 for item = (get-item row start)
                 when (car item)
                 collect (list (subseq (car item) 0 5) (cdr item) (cons start y))))))

(defparameter +zhanna-dows+ '("вс" "пн" "вт" "ср" "чт" "пт" "сб"))
(defun zhanna-get-schedule (&rest days)
  (labels ((dow-range (dow)
             (format nil "'~A'!A3:F30" (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 zhanna-set-schedule (token-id name dow time &optional (count 1))
  (let* ((schedule (cdar (zhanna-get-schedule dow)))
         (start (member time schedule :key #'car :test #'equal))
         (positions (loop for (time name pos) in start
                       while (null name)
                       collect pos)))
    (cond
      ((null schedule) "Плохой день")
      ((null start) "Плохое время")
      ((< (length positions) count) (format nil "~[В ~A занято~:;Есть только ~:*~A с ~A~]"
                                            (length positions) time))
      (:otherwise
       (labels ((range-value (pos)
                  (cons
                   (format nil "'~A'!~A~A"
                           (elt +zhanna-dows+ dow)
                           (code-char (+ (car pos)
                                         (char-code #\B)))
                           (+ 3 (cdr pos)))
                   (list (list name)))))
         (let* ((resp (gsheets-put-sheet-values token-id *zhanna-sheet-id*
                                                (mapcar #'range-value (subseq positions 0 count))))
                (err (aget "error" resp)))
           (when (equal 403 (aget "code" err))
             "Нет сил писать")))))))

(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 = (car (aget time new-s))
       for old = (car (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 ()
  (alexandria:when-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 #'second :test-not #'eql))))))
    (bot-send-message chat-id (format nil "Жанна свободна:~%~{~A~^~%~}" texts) :parse-mode "markdown")))

(def-message-cmd-handler zhanna-set-handler (:set :записать)
  (if (null (gsheets-get-tokens from-id))
      (%gsheets-send-auth chat-id from-id)
      (handler-case
          (destructuring-bind (name day time &optional (sets "1")) args
            (let ((dow (position day +zhanna-dows+ :test #'equal))
                  (count (parse-integer sets :junk-allowed t)))
              (cond
                ((null dow) (bot-send-message chat-id "День надо кратко: 'пн', 'вт', 'ср' и т.д"))
                ((null count) (bot-send-message chat-id "Число сетов - числом!"))
                (:otherwise
                 (let ((err (zhanna-set-schedule from-id name dow time count)))
                   (bot-send-message chat-id (or err "Записал!")))))))
        (error (e)
          (log:info e)
          (bot-send-message chat-id "Надо: /set <имя> <день> <время> [кол-во]")))))