(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 #'(lambda (tr) (local-time:timestamp-to-universal (local-time:parse-timestring (agets tr "time")))))) ;; 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 (handler-case (let ((transactions (get-transactions month))) (format-entries (transactions->entries transactions))) (poller-no-secret () "Нужен логин-пароль. /nalunch ") (poller-cant-authenticate () "Не смог получить данные. Попробуй перелогинься. /nalunch ")) :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*))))))