[ledger] add entry, minor refactor

inline.lisp

@@ -35,9 +35,13 @@
                  +ttl+)
          do (remhash id *inline-buttons*)))))
 
+(defcron process-prune-buttons ()
+  (prune-buttons))
+
 (defmacro inline-button ((text) &body body)
   `(cons ,text
          (lambda (callback)
+
            (with-parsed-callback callback
              (handler-case (progn ,@body)
                (error (e)
@@ -45,7 +49,7 @@
                  (telegram-answer-callback-query
                   query-id
                   :text (format nil "Ошибочка вышла~@[: ~A~]"
-                                (when (member chat-id *admins*) e)))))))))
+                                (when (member source-chat-id *admins*) e)))))))))
 
 (defun get-inline-keyboard (chat-id buttons)
   (telegram-inline-keyboard-markup

macros.lisp

@@ -80,18 +80,18 @@
          (handler-case (progn ,@body)
            (error (e)
              (log:error "~A" e)
-             (bot-send-message (or chat-id from-id)
+             (bot-send-message (or source-chat-id from-id)
                                (format nil "Ошибочка вышла~@[: ~A~]"
-                                       (when (member chat-id *admins*) e)))))))
+                                       (when (member source-chat-id *admins*) e)))))))
      (when ,prio (setf (get ',name :prio) ,prio))
      (add-hook :update-callback-query ',name)))
 
 (defmacro def-callback-section-handler (name (&rest sections) &body body)
   `(def-callback-handler ,name (callback)
-     (when chat-id
-       (multiple-value-bind (data section) (decode-callback-data chat-id raw-data)
+     (when source-chat-id
+       (multiple-value-bind (data section) (decode-callback-data source-chat-id raw-data)
          (when (member section (list ,@sections))
-           (log:info query-id from-id chat-id message-id section data)
+           (log:info query-id from-id source-chat-id source-message-id section data)
            ,@body
            t)))))
 

plugins/gsheets.lisp

@@ -227,14 +227,14 @@
 (def-callback-section-handler cb-handle-gss (:gs)
   (destructuring-bind (type id) (split-sequence:split-sequence #\- data :count 2)
     (case (intern (string-upcase type) "KEYWORD")
-      (:s (let* ((file (elt (car (aget chat-id *gsheets-chat-sheet-sessions*)) (parse-integer id)))
-                 (title (%gsheets-get-file-title-update-session chat-id from-id (aget "id" file))))
+      (:s (let* ((file (elt (car (aget source-chat-id *gsheets-chat-sheet-sessions*)) (parse-integer id)))
+                 (title (%gsheets-get-file-title-update-session source-chat-id from-id (aget "id" file))))
             (telegram-edit-message-text
              (if title (format nil "Выбран 📑 ~A" title) "Чот лажа")
-             :chat-id chat-id :message-id message-id)
-            (update-alist-settings '*gsheets-chat-sheet-sessions* chat-id nil)))
-      (:n (let* ((token-next (cdr (aget chat-id *gsheets-chat-sheet-sessions*)))
-                 (files-markup (%gsheets-files-markup-update-session chat-id from-id token-next)))
+             :chat-id source-chat-id :message-id source-message-id)
+            (update-alist-settings '*gsheets-chat-sheet-sessions* source-chat-id nil)))
+      (:n (let* ((token-next (cdr (aget source-chat-id *gsheets-chat-sheet-sessions*)))
+                 (files-markup (%gsheets-files-markup-update-session source-chat-id from-id token-next)))
             (if files-markup
-                (telegram-edit-message-reply-markup files-markup :chat-id chat-id :message-id message-id)
-                (telegram-edit-message-text "Чот лажа" :chat-id chat-id :message-id message-id)))))))
+                (telegram-edit-message-reply-markup files-markup :chat-id source-chat-id :message-id source-message-id)
+                (telegram-edit-message-text "Чот лажа" :chat-id source-chat-id :message-id source-message-id)))))))

plugins/ledger.lisp

@@ -178,7 +178,8 @@
 
 (defun ledger/handle-journal (chat-id query)
   (with-chat-journal (chat-id journal updated)
-    (let* ((entries (pta-ledger:journal-print journal query))
+    (let* ((pta-ledger:*posting-length* 40)
+           (entries (pta-ledger:journal-print journal query))
            (len (length entries))
            (count (min len 20)))
       (bot-send-message chat-id (format nil "```~%~{~A~^ ~%~%~}```Обновлено: ~A"
@@ -191,6 +192,47 @@
     ((null args) (ledger/handle-journal chat-id "date:thisweek"))
     (:otherwise (ledger/handle-journal chat-id (spaced args)))))
 
+(defun match-entry (text journal)
+  (labels ((two-post (entries)
+             (remove-if-not #'(lambda (e)
+                                (= 2 (length (pta-ledger:entry-postings e))))
+                            entries)))
+    (let ((desc (two-post
+                 (pta-ledger:journal-entries journal (format nil "desc:'~A'" text)))))
+      (if desc (car (last desc))
+          (let ((comment (two-post
+                          (pta-ledger:journal-entries journal (format nil "comment:'~A'" text)))))
+            (when comment (car (last comment))))))))
+
+(defun create-entry (chat-id text amount currency)
+  (with-chat-journal (chat-id journal updated)
+    (let* ((old (match-entry text journal))
+           (new (or (when old (pta-ledger:clone-entry old))
+                    (pta-ledger:make-entry
+                     :description text
+                     :postings (list
+                                (pta-ledger:make-posting :account "expenses")
+                                (pta-ledger:make-posting)))))
+           (postings (pta-ledger:entry-postings new)))
+      (setf (pta-ledger:entry-date new) (get-universal-time)
+            (pta-ledger:posting-amount (car postings)) (pta-ledger:make-amount
+                                                        :quantity amount
+                                                        :commodity currency)
+            (pta-ledger:posting-amount (cadr postings)) (pta-ledger:make-amount
+                                                         :quantity (- amount)
+                                                         :commodity currency)
+            (pta-ledger:posting-account (cadr postings)) (format nil "assets:Cash:~A" currency))
+      new)))
+
+(def-message-cmd-handler handler-create (:rub :usd :eur :thb :btc)
+  (cond
+    ((>= (length args) 2)
+     (ledger/new-chat-entry chat-id (create-entry chat-id
+                                                  (spaced (subseq args 1))
+                                                  (parse-float (car args))
+                                                  (symbol-name cmd))))
+    (:otherwise (send-response chat-id (format nil "/~A <amount> <description>" cmd)))))
+
 (def-webhook-handler ledger/handle-webhook ("ledger")
   (when (= 2 (length paths))
     (destructuring-bind (chat-id hmac) paths
@@ -209,13 +251,12 @@
   (let ((pta-ledger:*posting-length* 40))
     (format nil "```~%~A```" (pta-ledger:render entry))))
 
-
 (defun ledger/format-add-entry-message (from)
   (format nil "Ledger add from ~A ~A at ~A"
           (aget "first_name" from) (aget "last_name" from)
           (ledger/format-time (get-universal-time))))
 
-(defun ledger/process-add-entry (chat-id callback)
+(defun ledger/process-add-entry (chat-id from entry)
   (with-secret (info (list :ledger chat-id))
     (if info
         (cond
@@ -224,8 +265,8 @@
                            (ledger/add-git
                             chat-id
                             (car info) (cadr info)
-                            (agets callback "message" "text")
-                            (ledger/format-add-entry-message (agets callback "from")))
+                            (pta-ledger:render entry)
+                            (ledger/format-add-entry-message from))
                            "Добавил!")
              (error (e)
                (log:error "~A" e)
@@ -253,7 +294,7 @@
     (list (inline-button ("➕")
             (telegram-answer-callback-query query-id :text "Добавляю...")
             (telegram-send-message source-chat-id (ledger/process-add-entry
-                                                   source-chat-id callback))
+                                                   source-chat-id from entry))
             (telegram-edit-message-reply-markup
              nil :chat-id source-chat-id :message-id source-message-id))
           (inline-button ("💲")

plugins/transmission.lisp

@@ -129,7 +129,7 @@
   (destructuring-bind (type val id)
       (split-sequence:split-sequence #\- data :count 3)
     (case (intern (string-upcase type) "KEYWORD")
-      (:l (%handle-torrent-move query-id chat-id (parse-integer id) val)))))
+      (:l (%handle-torrent-move query-id source-chat-id (parse-integer id) val)))))
 
 ;; Cron
 (defvar *transmission-last-results* (make-hash-table) "Last check results for each chat-id")