1
0
Переглянути джерело

[nalunch] use plugins/ledger

Innocenty Enikeew 8 роки тому
батько
коміт
d9ba83d7b3
1 змінених файлів з 55 додано та 5 видалено
  1. 55 5
      plugins/nalunch.lisp

+ 55 - 5
plugins/nalunch.lisp

@@ -54,14 +54,57 @@
                         append (loop for el across (clss:select ".media" day)
                                   for date = (select-text day ".day-feed_date")
                                   for time = (select-text el ".transaction_time")
-                                  for price = (parse-integer (select-text el ".transaction_price"))
+                                  for price = (parse-float (select-text el ".transaction_price"))
                                   for place = (select-text el ".transaction-title")
-                                  collect (list (cons :time (format nil "~A ~A" date time))
+                                  collect (list (cons :date date)
+                                                (cons :time time)
                                                 (cons :price price)
                                                 (cons :place place))))))
         (list (cons :balance balance)
               (cons :recent recent))))))
 
+(defsetting *currency* "RUB")
+(defsetting *expense-account* "expenses:Food:Work")
+(defsetting *liabilities-account* "liabilities:nalunch")
+(defparameter +months+ '("" "января" "февраля" "марта" "апреля" "мая" "июня" "июля" "августа" "сентября" "октября" "декабря"))
+
+(defun date-time->ut (date time)
+  (let* ((decoded-now (multiple-value-list
+                       (decode-universal-time (get-universal-time) *chat-default-timezone*)))
+         (year (nth 5 decoded-now))
+         (hour (parse-integer time :start 0 :end 2))
+         (minute (parse-integer time :start 3 :end 5))
+         (day (if (string= date "Сегодня")
+                  (nth 3 decoded-now)
+                  (parse-integer date :start 0 :end 2)))
+         (month (if (string= date "Сегодня")
+                  (nth 4 decoded-now)
+                  (position (subseq date 3) +months+ :test #'equal))))
+    (encode-universal-time 0 minute hour day month year *chat-default-timezone*)))
+
+(defun recent->entry (recent)
+  (let* ((pta-ledger (find-package :pta-ledger))
+         (make-entry (symbol-function (intern "MAKE-ENTRY" pta-ledger)))
+         (make-posting (symbol-function (intern "MAKE-POSTING" pta-ledger)))
+         (make-amount (symbol-function (intern "MAKE-AMOUNT" pta-ledger)))
+         (date (date-time->ut (agets recent :date) (agets recent :time)))
+         (payee (agets recent :place))
+         (amount (agets recent :price)))
+    (funcall make-entry
+     :date date
+     :description payee
+     :postings (list
+                (funcall make-posting
+                 :account *expense-account*
+                 :amount (funcall make-amount
+                          :quantity amount
+                          :commodity *currency*))
+                (funcall make-posting
+                 :account *liabilities-account*
+                 :amount (funcall make-amount
+                          :quantity (* -1 amount)
+                          :commodity *currency*))))))
+
 (defun %nalunch/get-calend (year)
   (setf year (princ-to-string year))
   (unless (aget year *nalunch/calend*)
@@ -92,8 +135,9 @@
                                                                           (local-time:timestamp-month now))))))
     (format nil "🍴 Баланс ~A руб~@[ на ~A дней, по ~$ руб~].~{~&~A~}"
             balance left-working-days (/ balance (max left-working-days 1))
-            (mapcar (lambda (meal) (format nil "~A @ ~A — ~A руб."
-                                           (aget :time meal) (aget :place meal) (aget :price meal)))
+            (mapcar (lambda (meal) (format nil "~A ~A @ ~A — ~A руб."
+                                           (aget :date meal) (aget :time meal)
+                                           (aget :place meal) (aget :price meal)))
                     recent))))
 
 ;; Cron
@@ -105,12 +149,18 @@
       (if login-pass
           (let* ((cookie-jar (or (gethash chat-id *nalunch/jars*)
                                  (cl-cookie:make-cookie-jar)))
+                 (ledger-package (find-package :chatikbot.plugins.ledger))
                  (old (gethash chat-id *nalunch/last-results*))
                  (new (nalunch/recent (car login-pass) (cdr login-pass) cookie-jar)))
             (when new
               (when (and old (not (equal (aget :balance old)
                                          (aget :balance new))))
-                (bot-send-message chat-id (%nalunch/format new t)))
+                (bot-send-message chat-id (%nalunch/format new t))
+                (when ledger-package
+                  (let ((new-chat-entry (symbol-function
+                                         (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
+                    (dolist (recent (set-difference (agets new :recent) (agets old :recent) :test #'equalp))
+                      (funcall new-chat-entry chat-id (recent->entry recent))))))
               (setf (gethash chat-id *nalunch/last-results*) new
                     (gethash chat-id *nalunch/jars*) cookie-jar)))
           (progn