(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")))