chatikbot/plugins/nalunch.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.nalunch
  (:use :cl :chatikbot.common))
(in-package :chatikbot.plugins.nalunch)

(defparameter +api-uri+ "https://www.nalunch.ru/api/" "Nalunch API base url")
(defvar *calend* nil "Working calendar exceptions")
(defparameter +basicdata-calend-url+ "http://basicdata.ru/api/json/calend/")

;; poller methods
(defmethod poller-request ((module (eql :nalunch)) method &rest params)
  (handler-case
      (json-request (concatenate 'string +api-uri+ method)
                    :parameters (rest-parameters params)
                    :headers (filled `(("X-AUTH-SIGN" . ,*poller-token*))))
    (dex:http-request-failed (e) e)))
(defmethod poller-validate ((module (eql :nalunch)) response)
  (not (typep response 'dex:http-request-failed)))
(defmethod poller-authenticate ((module (eql :nalunch)) secret)
  (destructuring-bind (username . password) secret
    (agets (poller-request :nalunch "auth" :username username :password password)
           "token")))

;; API
(defun user-profile ()
  (poller-call :nalunch "user/profile"))

(defun user-balance ()
  (poller-call :nalunch "user/balance"))

(defun get-transactions (&optional month)
  (let ((month (or month (format-ts (local-time:now)))))
    (poller-call :nalunch "transactions/GetCHTransactions" :from month)))

(defun get-catering-points (lat lon &key page size)
  (poller-call :nalunch "cateringpoint/getpointlist" :latitude lat :longitude lon :page page "pageSize" size))

(defsetting *currency* "RUB")
(defsetting *expense-account* "expenses:Food:Work")
(defsetting *liabilities-account* "liabilities:nalunch")

;; Bot
(defun get-calend (year)
  (setf year (princ-to-string year))
  (unless (aget year *calend*)
    (setf *calend* (aget "data" (json-request +basicdata-calend-url+))))
  (aget year *calend*))

(defun get-working-days (year month)
  (let* ((exceptions (aget (princ-to-string month) (get-calend year)))
         (days-in-month (local-time:days-in-month month year)))
    (loop for day from 1 upto days-in-month
       for ts = (local-time:encode-timestamp 0 0 0 0 day month year)
       for dof = (local-time:timestamp-day-of-week ts)
       for exc = (aget "isWorking" (aget (princ-to-string day) exceptions))
       when (or (and (<= 1 dof 5)
                     (not (equal 2 exc)))
                (and (or (= dof 0) (= dof 6))
                     (or (equal 0 exc)
                         (equal 3 exc))))
       collect day)))

(defun format-balance-left (balance)
  (let* ((balance (aget "sum" balance))
         (now (local-time:now))
         (left-working-days (length (remove-if #'(lambda (d) (<= d (local-time:timestamp-day now)))
                                               (get-working-days (local-time:timestamp-year now)
                                                                 (local-time:timestamp-month now))))))
    (format nil "🍴 Баланс ~A руб~@[ на ~A дней, по ~$ руб~]."
            balance left-working-days (/ balance (max left-working-days 1)))))

(defun format-entries (changes)
  (text-chunks (mapcar #'pta-ledger:render changes)))

(defun flat-transactions (transactions)
  (loop for day in transactions
     appending (agets day "transactionList")))

(defun transaction->entry (tr)
  (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 (local-time:timestamp-to-universal
                (local-time:parse-timestring (agets tr "time"))))
         (payee (agets tr "catPointName"))
         (amount (agets tr "sum")))
    (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 transactions->entries (transactions)
  (mapcar #'transaction->entry (flat-transactions transactions)))

(defun process-new (diff)
  (let ((ledger-package (find-package :chatikbot.plugins.ledger)))
    (if ledger-package
        (let ((new-chat-entry (symbol-function
                               (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
          (dolist (tr diff)
            (funcall new-chat-entry *chat-id* tr)))
        (bot-send-message (format-entries diff)))))

;; Cron
(defcron process-nalunch (:minute '(member 0 10 20 30 40 50))
  (poller-poll-lists :nalunch
                     #'(lambda () (transactions->entries (get-transactions)))
                     #'(lambda (diff)
                         (bot-send-message (format-balance-left (user-balance)))
                         (process-new diff))
                     :key #'pta-ledger:entry-date))

;; Hooks
(defun handle-set-cron (enable)
  (lists-set-entry :nalunch *chat-id* enable)
  (bot-send-message (if enable
                        "Включил рассылку. '/nalunch off' чтобы выключить, /nalunch - показать последние."
                        "Без рассылки. '/nalunch on' - включить, /nalunch - последние.")))

(defun handle-auth (login pass)
  (let ((secret (cons login pass)))
    (unless (poller-authenticate :nalunch secret)
      (bot-send-message "Чот не смог, пропробуй другие."))
    (secret-set `(:nalunch ,*chat-id*) secret)
    (handle-set-cron t)))

(defun handle-recent (&optional month)
  (bot-send-message (format-balance-left (user-balance)))
  (bot-send-message
   (handler-case
       (let ((transactions (get-transactions month)))
         (format-entries (transactions->entries transactions)))
     (poller-no-secret () "Нужен логин-пароль. /nalunch <login> <pass>")
     (poller-cant-authenticate () "Не смог получить данные. Попробуй перелогинься. /nalunch <login> <pass>"))
   :parse-mode "markdown"))

(def-message-cmd-handler handle-cmd-nalunch (:nalunch)
  (let ((a0 (car *args*)))
    (cond
      ((= 2 (length *args*)) (apply 'handle-auth *args*))
      ((and (= 1 (length *args*)) (or (equal "on" a0) (equal "off" a0)))
       (handle-set-cron (equal "on" a0)))
      ((equal a0 "bal") (bot-send-message (format-balance-left (user-balance))))
      (:otherwise (handle-recent (spaced *args*))))))