/set for zhanna

plugins/gsheets.lisp

@@ -85,11 +85,11 @@
                     :reply-markup (telegram-inline-keyboard-markup
                                    (list (list (list :text "Авторизоваться!"
                                                      :url (gsheets-get-authorization-url token-id)))))))
-(defun google-api-call (token-id path base-url &key (method :get) parameters body is-retry)
+(defun google-api-call (token-id path base-url &key (method :get) parameters hash-body is-retry)
   (alexandria:when-let (access-token (gsheets-get-tokens token-id))
-    (let* ((content (when body
+    (let* ((content (when hash-body
                       (with-output-to-string (stream)
-                        (yason:encode (alexandria:plist-hash-table body) stream))))
+                        (yason:encode hash-body stream))))
            (response (json-request
                       (quri:render-uri (quri:merge-uris (quri:make-uri :path path) (quri:uri base-url)))
                       :method method :parameters parameters :content content
@@ -97,7 +97,7 @@
            (err (aget "error" response)))
       (if (and err (equal 401 (aget "code" err)) (not is-retry) (gsheets-refresh-access-token token-id))
           ;; Retry in case of auth error and successful token refresh
-          (google-api-call token-id path base-url :method method :parameters parameters :body body :is-retry t)
+          (google-api-call token-id path base-url :method method :parameters parameters :hash-body hash-body :is-retry t)
           response))))
 
 (defun gsheets-find-files (token-id &optional next-page-token)
@@ -110,17 +110,19 @@
   (google-api-call token-id
                    (format nil "files/~A/watch" file-id) +gdrive-base-uri+
                    :method :post
-                   :body (append
-                          (list "kind" "api#channel"
-                                "id" (princ-to-string (uuid:make-v4-uuid))
-                                "type" "web_hook"
-                                "address" (quri:render-uri
-                                           (quri:merge-uris (quri:uri (format nil "/hook/~A" webhook))
-                                                            (quri:uri *web-path*))))
-                          (when token (list "token" token))
-                          (when expiration (list "expiration" expiration))
-                          (when payload (list "payload" "true"))
-                          (when params (list "params" params)))))
+                   :hash-body
+                   (alexandria:plist-hash-table
+                    (append
+                     (list "kind" "api#channel"
+                           "id" (princ-to-string (uuid:make-v4-uuid))
+                           "type" "web_hook"
+                           "address" (quri:render-uri
+                                      (quri:merge-uris (quri:uri (format nil "/hook/~A" webhook))
+                                                       (quri:uri *web-path*))))
+                     (when token (list "token" token))
+                     (when expiration (list "expiration" expiration))
+                     (when payload (list "payload" "true"))
+                     (when params (list "params" params))))))
 
 (defun gsheets-get-sheet (token-id sheet-id &key fields ranges include-grid-data)
   (google-api-call token-id
@@ -139,12 +141,20 @@
                                 (when fields (list (cons "fields" fields)))
                                 (when major-dimension (list (cons "majorDimension" major-dimension))))))
 
-(defun gsheets-put-sheet-values (token-id sheet-id range values &key raw)
+(defun gsheets-put-sheet-values (token-id sheet-id range-values &key raw major-dimension)
   (google-api-call token-id
-                   (format nil "spreadsheets/~A/values/~A" sheet-id range) +gsheets-base-uri+
-                   :method :put
-                   :parameters (list (cons "valueInputOption" (if raw "RAW" "USER_ENTERED")))
-                   :body (list "values" values)))
+                   (format nil "spreadsheets/~A/values:batchUpdate" sheet-id) +gsheets-base-uri+
+                   :method :post
+                   :hash-body
+                   (alexandria:plist-hash-table
+                    (list "valueInputOption" (if raw "RAW" "USER_ENTERED")
+                          "data" (loop for (range . values) in range-values
+                                    collect (alexandria:plist-hash-table
+                                             (append
+                                              (list "range" range
+                                                    "values" values)
+                                              (when major-dimension
+                                                (list "majorDimension" major-dimension)))))))))
 
 (defvar *gsheets-chat-sheets* nil "ALIST of (chat-id . sheet-id)")
 (defvar *gsheets-chat-sheet-sessions* nil "ALIST of (chat-id . (files . next)) for sheet selection")
@@ -213,7 +223,7 @@
     (if sheet-id
         (let* ((range (car args))
                (values (list (cdr args)))
-               (resp (gsheets-put-sheet-values from-id sheet-id range values)))
+               (resp (gsheets-put-sheet-values from-id sheet-id (list (cons range values)))))
           (bot-send-message chat-id (format nil "Записал в ~A" (aget "updatedRange" resp))))
         (bot-send-message chat-id "Выбери документ сначала: /sheets"))))
 

plugins/zhanna.lisp

@@ -13,25 +13,52 @@
              (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 (cons (subseq (car item) 0 5) (cdr 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:F22" (elt +zhanna-dows+ 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 = (aget time new-s)
-       for old = (aget time old-s)
+       for new = (car (aget time new-s))
+       for old = (car (aget time old-s))
        unless (equal new old)
        collect (list (cons new old) time))))
 
@@ -66,7 +93,7 @@
                                  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)))
+                 (msg (format nil "У Жанны сменились планы~%~{~A~^~%~}" day-changes)))
             (when day-changes
               (log:info msg)
               (dolist (chat-id *zhanna-subscriptions*)
@@ -83,5 +110,22 @@
          (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))))))
+                                   (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 <имя> <день> <время> [кол-во]")))))