elbank/elbank-common.el

;;; elbank-common.el --- Elbank common use functions and variables  -*- lexical-binding: t; -*-

;; Copyright (C) 2017-2018  Nicolas Petton

;; Author: Nicolas Petton <nicolas@petton.fr>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file defines common data structures, variables and functions used in
;; Elbank.

;;; Code:

(require 'map)
(require 'seq)
(require 'json)
(require 'subr-x)
(eval-and-compile (require 'cl-lib))

;;;###autoload
(defgroup elbank nil
  "Elbank"
  :prefix "elbank-"
  :group 'tools)

;;;###autoload
(defcustom elbank-data-file (locate-user-emacs-file "elbank-data.el")
  "Location of the file used to store elbank data."
  :type '(file))

;;;###autoload
(defcustom elbank-categories nil
  "Alist of categories of transactions.

Each category has an associated list of regular expressions.
A transaction's category is found by testing each regexp in order.

Example of categories

 (setq elbank-categories
   \\='((\"Expenses:Groceries\" . (\"walmart\" \"city market\"))
     (\"Income:Salary\" . (\"paycheck\"))))"
  :type '(alist :key-type (string :tag "Category name")
		:value-type (repeat (string :tag "Regexp"))))

(defface elbank-header-face '((t . (:inherit font-lock-keyword-face
					     :height 1.3)))
  "Face for displaying header in elbank."
  :group 'elbank)

(defface elbank-subheader-face '((t . (:weight bold
				       :height 1.1)))
  "Face for displaying sub headers in elbank."
  :group 'elbank)

(defface elbank-positive-amount-face '((t . (:inherit success :weight normal)))
  "Face for displaying positive amounts."
  :group 'elbank)

(defface elbank-negative-amount-face '((t . (:inherit error :weight normal)))
  "Face for displaying positive amounts."
  :group 'elbank)

(defface elbank-entry-face '((t . ()))
  "Face for displaying entries in elbank."
  :group 'elbank)

(defvar elbank-data nil
  "Alist of all accounts and transactions.")

(defvar elbank-report-available-columns '(date rdate label raw category account amount)
  "List of all available columns in reports.")


(defun elbank-read-data ()
  "Return an alist of boobank data read from `elbank-data-file'.
Data is cached to `elbank-data'."
  (let ((file (expand-file-name elbank-data-file)))
   (when (file-exists-p file)
     (load file t))))

(defun elbank-write-data ()
  "Write `elbank-data' to `elbank-data-file'."
  (let ((print-circle t)
	(print-level nil)
	(print-length nil))
   (with-temp-file (expand-file-name elbank-data-file)
     (emacs-lisp-mode)
     (insert ";; This file is automatically generated by Indium.")
     (newline)
     (insert (format "(setq %s '%S)" "elbank-data" elbank-data)))))

(defun elbank-account-with-id (id)
  "Return the account with ID, or nil."
  (seq-find (lambda (acc)
	      (string= (map-elt acc 'id)
		       id))
	    (map-elt elbank-data 'accounts)))

(defun elbank-account-name (account)
  "Return a human-readable name for ACCOUNT."
  (format "%s@%s"
          (elbank-account-group account)
          (map-elt account 'label)))

(defun elbank-account-group (account)
  "Return the group into which ACCOUNT is classified."
  (cadr (split-string (map-elt account 'id) "@")))

(cl-defgeneric elbank-transaction-elt (transaction key &optional default)
  "Return the value of TRANSACTION at KEY.

If the result is nil, return DEFAULT."
  (map-elt transaction key default))

(cl-defmethod elbank-transaction-elt (transaction (key (eql account)) &optional default)
  "Return the account of TRANSACTION.

If TRANSACTION is a split transaction, return the account of its parent transaction."
  (if (elbank-sub-transaction-p transaction)
      (elbank-transaction-elt (elbank-transaction-elt transaction 'split-from) 'account)
    (cl-call-next-method transaction key default)))

(cl-defmethod elbank-transaction-elt (transaction (_key (eql category)) &optional default)
  "Return the category of TRANSACTION.

Split transactions (that hold an list of (CATEGORY . AMOUNT)
elements as category) have no category.

If the result is nil, return DEFAULT."
  (let ((case-fold-search t)
	(custom-category (map-elt transaction 'category)))
    (cond ((or (null custom-category)
	       (and (stringp custom-category)
		    (string-empty-p custom-category)))
	   (seq-find #'identity
		     (map-apply
		      (lambda (key category)
			(when (seq-find
			       (lambda (regexp)
				 (string-match-p
				  regexp
				  (map-elt transaction 'raw)))
			       category)
			  key))
		      elbank-categories)
		     default))
	  ((stringp custom-category) custom-category)
	  (t default))))

(cl-defgeneric (setf elbank-transaction-elt) (store transaction key)
  (if (map-contains-key transaction key)
      (setf (map-elt transaction key) store)
    ;; Always mutate transactions in place.
    (nconc transaction (list (cons key store)))))

(defun elbank-transaction-split-p (transaction)
  "Return non-nil if TRANSACTION is split.
Split transactions have an alist of (CATEGORY-NAME . AMOUNT) as
category."
  (let ((category (map-elt transaction 'category)))
    (and (not (null category))
	 (listp category))))

(defun elbank-sub-transaction-p (transaction)
  "Return non-nil if TRANSACTION is a sub transaction.

Sub transactions are built dynamically from
`elbank-all-transactions' from split transactions."
  (not (null (elbank-transaction-elt transaction 'split-from))))

(defmacro elbank-filter-transactions (collection &rest query)
    "Returned all transactions in COLLECTION that match QUERY.

QUERY is a plist of the form (:KEY1 VAL1 :KEY2 VAL2...) where
keys are keywords matching transaction keys.

Special keys in QUERY:

- `:category': Match transactions within the category name, using
  `elbank-transaction-in-category-p'.

- `:period': The value must be a list of the form (TYPE TIME),
  where TYPE is either year or month.

- `:account-id': Lookup an account with the queried id and match
  transactions for that account."
  (let* ((sym (make-symbol "transaction"))
	 (query (elbank--make-queries sym query)))
    `(seq-filter (lambda (,sym) ,query) ,collection)))

(defun elbank--make-queries (transaction queries)
  "Return a form for filtering TRANSACTION with QUERIES."
  (let ((filters (seq-map (lambda (query)
			    (elbank--make-query transaction
 						(car query)
						(cadr query)))
			  (seq-partition queries 2))))
    `(and ,@filters)))

(cl-defgeneric elbank--make-query (transaction key val)
  (unless (keywordp key)
    (error "Query KEY must be a keyword"))
  `(or (null ,val)
       (equal (elbank-transaction-elt ,transaction
				      ',(intern (seq-drop (symbol-name key) 1)))
	      ,val)))

(cl-defmethod elbank--make-query (transaction (_key (eql :category)) val)
  `(elbank-transaction-in-category-p ,transaction ,val))

(cl-defmethod elbank--make-query (transaction (_key (eql :account-id)) val)
  (elbank--make-query transaction :account `(elbank-account-with-id ,val)))

(cl-defmethod elbank--make-query (transaction (_key (eql :period)) period)
  "Return a period query for TRANSACTION.

PERIOD is a list of the form `(type time)', with `type' a
symbol (`month' or `year'), and `time' an encoded time."
  (let ((period-var (make-symbol "period")))
    `(let ((,period-var ,period))
       (pcase (car ,period-var)
	 (`year (elbank--make-period-query-format ,transaction
						  (cadr ,period-var)
						  "%Y"))
	 (`month (elbank--make-period-query-format ,transaction
						   (cadr ,period-var)
						   "%Y-%m"))
	 (`nil t)
	 (_ (error "Invalid period type %S" (car ,period-var)))))))

(defun elbank--make-period-query-format (transaction time format)
  "Return a period query for TRANSACTION and TIME.
Comparison is done by formatting times using FORMAT."
  (string= (format-time-string format time)
	   (format-time-string format (elbank--transaction-time transaction))))

(defun elbank--transaction-time (transaction)
  "Return the encoded time for TRANSACTION."
  (apply #'encode-time
	 (seq-map (lambda (el)
		    (or el 0))
		  (parse-time-string (elbank-transaction-elt transaction 'date)))))

(defun elbank-transaction-in-category-p (transaction category)
  "Return non-nil if TRANSACTION belongs to CATEGORY."
  (or (null category)
      (string-prefix-p category (elbank-transaction-elt transaction 'category "") t)))

(defun elbank-sum-transactions (transactions)
  "Return the sum of all TRANSACTIONS.
TRANSACTIONS are expected to all use the same currency."
  (seq-reduce (lambda (acc transaction)
		(+ acc
		   (string-to-number (elbank-transaction-elt transaction 'amount))))
	      transactions
	      0))

(defun elbank-transaction-years ()
  "Return all years for which there is a transaction."
  (seq-sort #'time-less-p
	    (seq-uniq
	     (seq-map (lambda (transaction)
			(encode-time 0 0 0 1 1
				     (seq-elt (decode-time
					       (elbank--transaction-time transaction))
					      5)))
		      (elbank-all-transactions)))))

(defun elbank-transaction-months ()
  "Return all months for which there is a transaction."
  (seq-sort #'time-less-p
	    (seq-uniq
	     (seq-map (lambda (transaction)
			(let ((time (decode-time
				     (elbank--transaction-time transaction))))
			  (encode-time 0 0 0 1 (seq-elt time 4) (seq-elt time 5))))
		      (elbank-all-transactions)))))

(defun elbank-all-transactions (&optional nosplit)
  "Return all transactions for all accounts.

When NOSPLIT is nil, split transactions that have multiple
categories into multiple transactions."
  (if nosplit
      (map-elt elbank-data 'transactions)
    (seq-mapcat (lambda (transaction)
		    (if (elbank-transaction-split-p transaction)
			(seq-map (lambda (cat)
				   (let ((sub-trans (copy-alist transaction)))
				     (map-put sub-trans 'amount (cdr cat))
				     (map-put sub-trans 'category (car cat))
				     (map-put sub-trans 'label
					      (format "[split] %s"
						      (elbank-transaction-elt
						       transaction
						       'label)))
				     (map-put sub-trans 'split-from transaction)
				     sub-trans))
				 (map-elt transaction 'category))
		      (list transaction)))
		(elbank-all-transactions t))))

(defun elbank--longest-account-label ()
  "Return the longest account label from all accounts."
  (seq-reduce (lambda (label1 label2)
		(if (> (seq-length label1)
		       (seq-length label2))
		    label1
		  label2))
	      (seq-map (lambda (account)
			 (map-elt account 'label))
		       (map-elt elbank-data 'accounts))
	      ""))

(defun elbank--insert-amount (amount &optional currency)
  "Insert AMOUNT as a float with a precision of 2 decimals.
When CURRENCY is non-nil, append it to the inserted text.
AMOUNT is fontified based on whether it is negative or positive."
  (let ((beg (point))
	(number (if (numberp amount)
		    amount
		  (string-to-number amount))))
    (insert (format "%.2f %s" number (or currency "")))
    (put-text-property beg (point)
		       'face
		       (if (< number 0)
			   'elbank-negative-amount-face
			 'elbank-positive-amount-face))))

(defun elbank--propertize-amount (amount &optional currency)
  "Fontify AMOUNT based on whether it is positive or not.
When CURRENCY is non-nil, append it to the inserted text."
  (with-temp-buffer
    (elbank--insert-amount amount currency)
    (buffer-string)))

(defun elbank-format-period (period)
  "Return the string representation of PERIOD."
  (pcase (car period)
    (`year (format-time-string "Year %Y" (cadr period)))
    (`month (format-time-string "%B %Y" (cadr period)))
    (`nil "")
    (`_ "Invalid period")))

(defun elbank-quit ()
  "Kill the current buffer."
  (interactive)
  (quit-window t))

;;;
;;; Common major-mode for reports
;;;

(defvar elbank-report-update-hook nil
  "Hook run when a report update is requested.")

(defvar elbank-report-period nil
  "Period filter used in a report buffer.")
(make-variable-buffer-local 'elbank-report-period)

(defvar elbank-base-report-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "q") #'elbank-quit)
    (define-key map (kbd "n") #'forward-button)
    (define-key map (kbd "p") #'backward-button)
    (define-key map [tab] #'forward-button)
    (define-key map [backtab] #'backward-button)
    (define-key map (kbd "M-n") #'elbank-base-report-forward-period)
    (define-key map (kbd "M-p") #'elbank-base-report-backward-period)
    (define-key map (kbd "g") #'elbank-base-report-refresh)
    map)
  "Keymap for `elbank-base-report-mode'.")

(define-derived-mode elbank-base-report-mode nil "Base elbank reports"
  "Base major mode for viewing a report.

\\{elbank-base-report-mode-map}"
  (setq-local truncate-lines nil)
  (read-only-mode))

(defun elbank-base-report-refresh ()
  "Request an update of the current report."
  (interactive)
  (run-hooks 'elbank-base-report-refresh-hook))

(defun elbank-base-report-forward-period (&optional n)
  "Select the next N period and update the current report.
If there is no period filter, signal an error."
  (interactive "p")
  (unless elbank-report-period
    (user-error "No period filter for the current report"))
  (let* ((periods (pcase (car elbank-report-period)
		    (`year (elbank-transaction-years))
		    (`month (elbank-transaction-months))))
	 (cur-index (seq-position periods (cadr elbank-report-period)))
	 (new-index (+ n cur-index))
	 (period (seq-elt periods new-index)))
    (if period
	(progn
	  (setq elbank-report-period (list (car elbank-report-period)
					   period))
	  (elbank-base-report-refresh))
      (user-error "No more periods"))))

(defun elbank-base-report-backward-period (&optional n)
  "Select the previous N period and update the current report.
If there is no period filter, signal an error."
  (interactive "p")
  (elbank-base-report-forward-period (- n)))

(provide 'elbank-common)
;;; elbank-common.el ends here