[ofd] Support inline cheque processing.

plugins/ledger.lisp

@@ -213,14 +213,16 @@
 
 (defun run-report (chat-id name query)
   (with-chat-journal (chat-id journal updated)
-    (bot-send-message (text-chunks (split-sequence:split-sequence
-                                    #\Newline
-                                    (format nil "*~A*~%~%~A" name
-                                            (pta-ledger:journal-balance journal query)))
-                                   :text-sep "
+    (let ((balance (pta-ledger:journal-balance journal query)))
+      (when balance
+        (bot-send-message (text-chunks (split-sequence:split-sequence
+                                        #\Newline
+                                        (format nil "*~A*~%~%~A" name balance))
+                                       :text-sep "
 ")
-                      :parse-mode "markdown"
-                      :chat-id chat-id)))
+                          :parse-mode "markdown"
+                          :chat-id chat-id))
+      t)))
 
 (def-chat-cron-handler handler-chat-cron (:ledger-report chat-id schedule name query)
   (run-report chat-id name query))
@@ -382,19 +384,65 @@
      :parse-mode "markdown"
      :reply-markup (keyboard/edit-entry chat-id message-id entry))))
 
+(defun merge-cheque (entry cheque)
+  (labels ((positive-posting (p)
+             (plusp (pta-ledger:amount-quantity (pta-ledger:posting-amount p)))))
+    (let ((postings (append
+                     (remove-if-not #'positive-posting (pta-ledger:entry-postings cheque))
+                     (remove-if #'positive-posting (pta-ledger:entry-postings entry))))
+          (default-account (symbol-value (intern "*DEFAULT-EXPENSE-ACCOUNT*"
+                                                 (find-package :chatikbot.plugins.ofd))))
+          (entry-positive (car (remove-if-not #'positive-posting (pta-ledger:entry-postings entry)))))
+      (log:info entry cheque entry-positive postings)
+      (when (zerop (pta-ledger:amount-quantity
+                    (car (pta-ledger::complement-amounts postings t))))
+        ;; Keep expense accounts if not specified in cheque
+        (when entry-positive
+          (loop for p in postings
+             when (positive-posting p)
+             when (equalp (pta-ledger:posting-account p) default-account)
+             do (setf (pta-ledger:posting-account p)
+                      (pta-ledger:posting-account entry-positive))))
+        (setf (pta-ledger:entry-postings entry) postings)
+        ;; Take comment from cheque if set
+        (alexandria:when-let (comment (pta-ledger:entry-comment cheque))
+          (setf (pta-ledger:entry-comment entry) comment))
+        entry))))
+
 (defun keyboard/entry (entry)
-  (get-inline-keyboard
-   (list
-    (list (inline-button ("➕")
-            (telegram-answer-callback-query *query-id* :text "Добавляю...")
-            (telegram-send-message *source-chat-id* (ledger/process-add-entry
-                                                     *source-chat-id* *from* entry))
-            (telegram-edit-message-reply-markup
-             nil :chat-id *source-chat-id* :message-id *source-message-id*))
-          (inline-button ("💲")
-            (entry-edit *source-chat-id* *source-message-id* entry))
-          (inline-button ("✖️")
-            (telegram-delete-message *source-chat-id* *source-message-id*))))))
+  (let* ((ofd-package (find-package :chatikbot.plugins.ofd))
+         (handle-next-cheque (when ofd-package (symbol-function (intern "HANDLE-NEXT-CHEQUE" ofd-package)))))
+    (get-inline-keyboard
+     (list
+      (list (inline-button ("➕")
+              (telegram-answer-callback-query *query-id* :text "Добавляю...")
+              (telegram-send-message *source-chat-id* (ledger/process-add-entry
+                                                       *source-chat-id* *from* entry))
+              (telegram-edit-message-reply-markup
+               nil :chat-id *source-chat-id* :message-id *source-message-id*))
+            (inline-button ("💲")
+              (entry-edit *source-chat-id* *source-message-id* entry))
+            (when handle-next-cheque
+              (inline-button ("🧾")
+                (let ((query-id *query-id*)
+                      (source-chat-id *source-chat-id*)
+                      (source-message-id *source-message-id*))
+                  (telegram-answer-callback-query query-id :text "Жду чек")
+                  (funcall handle-next-cheque
+                           (lambda (cheque-entry)
+                             (bot-send-message (format nil "Получил чек на сумму ~A"
+                                                       (pta-ledger:entry-total-amount cheque-entry)))
+                             (let ((merged (merge-cheque entry cheque-entry)))
+                               (if merged
+                                   (telegram-edit-message-text
+                                    (format-entry merged)
+                                    :chat-id source-chat-id
+                                    :message-id source-message-id
+                                    :parse-mode "markdown"
+                                    :reply-markup (keyboard/entry entry))
+                                   (bot-send-message "Суммы не сходятся :("))))))))
+            (inline-button ("✖️")
+              (telegram-delete-message *source-chat-id* *source-message-id*)))))))
 
 (defun def (str default)
   (if (or (null str) (string= "" str)) default

plugins/ofd.lisp

@@ -78,49 +78,51 @@
 
 (defun expense-comment (name &optional user address price quantity sum)
   (declare (ignorable name user address price quantity sum))
-  (format nil "item: ~A~@[, ~A @ ~A~]"
+  (format nil "item: ~A~@[, ~A @ ~$~]"
           name
           (unless (= quantity 1) quantity)
           (unless (= quantity 1) (/ price 100))))
 
-(defun asset-account (&optional user address)
+(defun expense-posting (item &optional user address)
+  (let ((name (agets item "name"))
+        (price (agets item "price"))
+        (quantity (agets item "quantity"))
+        (sum (agets item "sum")))
+    (pta-ledger:make-posting
+     :account (expense-account name user address)
+     :comment (expense-comment name user address price quantity sum)
+     :amount (pta-ledger:make-amount
+              :quantity (/ sum 100)
+              :commodity *default-currency*))))
+
+(defun asset-posting (amount &optional user address)
   (declare (ignorable user address))
-  *default-asset-account*)
+  (pta-ledger:make-posting
+   :account *default-asset-account*
+   :amount (pta-ledger:make-amount
+            :quantity (* -1 amount)
+            :commodity *default-currency*)))
 
 (defun not-empty (str)
   (unless (string= str "")
     str))
 
 (defun cheque->entry (c)
-  (let ((total-sum (agets c "totalSum"))
-        (date (local-time:timestamp-to-universal
-               (local-time:parse-timestring (agets c "dateTime") )))
-        (user (or (not-empty (agets c "retailPlace"))
-                  (not-empty (agets c "user"))
-                  (format nil "ИНН ~A" (agets c "userInn"))))
-        (address (not-empty (agets c "retailPlaceAddress")))
-        (items (agets c "items")))
+  (let* ((total-sum (agets c "totalSum"))
+         (date (local-time:timestamp-to-universal
+                (local-time:parse-timestring (agets c "dateTime"))))
+         (inn (not-empty (agets c "userInn")))
+         (user (or (not-empty (agets c "retailPlace"))
+                   (not-empty (agets c "user"))
+                   (format nil "ИНН ~A" inn)))
+         (address (not-empty (agets c "retailPlaceAddress")))
+         (items (agets c "items")))
     (pta-ledger:make-entry
      :date date
      :description user
-     :comment (when address (format nil "address: ~A" address))
-     :postings (append (loop for i in items
-                          collect
-                            (let ((name (agets i "name"))
-                                  (price (agets i "price"))
-                                  (quantity (agets i "quantity"))
-                                  (sum (agets i "sum")))
-                              (pta-ledger:make-posting
-                               :account (expense-account name user address)
-                               :comment (expense-comment name user address price quantity sum)
-                               :amount (pta-ledger:make-amount
-                                        :quantity (/ sum 100)
-                                        :commodity *default-currency*))))
-                       (list (pta-ledger:make-posting
-                              :account (asset-account user address)
-                              :amount (pta-ledger:make-amount
-                                       :quantity (* -1 (/ total-sum 100))
-                                       :commodity *default-currency*)))))))
+     :comment (format nil "~@[inn: ~A~]~@[, address: ~A~]" inn address)
+     :postings (append (mapcar #'expense-posting items)
+                       (list (asset-posting (/ total-sum 100) user address))))))
 
 
 (defun handle-auth (login pass)
@@ -135,18 +137,27 @@
     ((= 2 (length *args*)) (apply 'handle-auth *args*))
     (:otherwise (bot-send-message "/ofd <login> <pass>"))))
 
+(defvar *chat-next-cheque-handlers* (make-hash-table) "chat cheque handlers")
+(defun handle-next-cheque (handler)
+  (setf (gethash *chat-id* *chat-next-cheque-handlers*) handler))
+
 (def-message-handler ofd-handler (-10)
   (let ((parsed (parse-qt *text*)))
     (when parsed
       (telegram-send-chat-action *chat-id* "typing")
-      (let ((cheque (apply #'receive parsed)))
+      (let ((cheque (apply #'receive parsed))
+            (handler (gethash *chat-id* *chat-next-cheque-handlers*)))
         (if cheque
             (let ((ledger-package (find-package :chatikbot.plugins.ledger))
                   (entry (cheque->entry cheque)))
-              (if ledger-package
-                  (let ((new-chat-entry (symbol-function
-                                         (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
-                    (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry)))
-                  (bot-send-message (pta-ledger:render entry) :parse-mode "markdown")))
+              (cond
+                (handler
+                 (remhash *chat-id* *chat-next-cheque-handlers*)
+                 (funcall handler entry))
+                (ledger-package
+                      (let ((new-chat-entry (symbol-function
+                                             (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
+                        (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
+                (:otherwise (bot-send-message (pta-ledger:render entry) :parse-mode "markdown"))))
             (bot-send-message "Не смог в чек :(")))
       t)))