Splurge — Track your expenses with a simple Org table (Emacs package)

(use-package splurge
  ;; Example, if you want to customize some variable here:
  :custom
  (splurge-input-extras
   ;; Column  Default  Alignment
   '(("With"  "card"   left)
     ("Notes" "---"    left))))

(require 'splurge)

;;; splurge.el --- Track your expenses with a simple Org table -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Code:
;;;; Libraries
;;;; Package metadata
;;;; Customizable variables
;;;;; Input table
;;;;; Report table
;;;;; Types and subtypes
;;;; Functions
;;;;; Input table: new
;;;;;; Internal
;;;;; Expense: new or edit
;;;;;; Internal
;;;;;;; Edit
;;;;;;; Ask
;;;;;;; Org table
;;;;; Types: update
;;;;;; Internal
;;;;; Report: show
;;;;;; Internal
;;;;;;; Display report
;;;;;;; Hash tables
;;;;;;; Calculation
;;;;;;; Whats, types and subtypes
;;;;;;; Dates
;;;;; See README
;;;;; See News
;;;; Wrapping up
;;; splurge.el ends here

;;; splurge.el --- Track your expenses with a simple Org table -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Created:   2023-12-10
;; Updated:   2025-03-18
;; Keywords:  outlines
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.2.1
;; Package-Requires: ((emacs "25.1") (xht "1.0.5") (dash "2.18") (org "9.0.3"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; With Splurge you can track your annual expenses with a simple Org table.
;;
;; Add to the Org table a line for every expense you have on a calendar year.
;;
;; Then run ‘splurge-report’ and a buffer comes up with a summary table:
;; - Rows:  categories (food, transport, etc.)
;; - Cols:  months, running total, running average
;; - Cells: the respective sums
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x splurge-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-splurge.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;; Code:
;;;; Libraries

(require 'org)
(require 'xht)       ; <--- also by the author of this package
(require 'lisp-mnt)  ; ‘lm-summary’, ‘lm-homepage’, ‘lm-version’, ‘lm-header’


;;;; Package metadata

(defvar splurge--name "Splurge")

(defvar splurge--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar splurge--readme-org
  (expand-file-name "README.org" (file-name-directory splurge--dot-el)))

(defvar splurge--summary  (lm-summary   splurge--dot-el))
(defvar splurge--homepage (lm-homepage  splurge--dot-el))
(defvar splurge--version  (lm-with-file splurge--dot-el
                           (or (lm-header "package-version")
                               (lm-version))))


;;;; Customizable variables

(defgroup splurge nil
  (format "%s." splurge--summary)
  :group 'org
  :link  '(emacs-library-link :tag "Lisp file" "splurge.el")
  :link  `(file-link :tag "README.org" ,splurge--readme-org)
  :link  `(url-link  :tag "Homepage"   ,splurge--homepage))

;;;;; Input table

(defcustom splurge-input-date "Date"
  "A string to represent date in Input table.
This is a column label for the (org) date when the expense
happened. This exact same string must be used in your input table."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-amount "Amount"
  "A string to represent amount in Input table.
This is a column label for the amount of the expense. This exact
same string must be used in your input table."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-what "What"
  "A string to represent what in Input table.
This is a column label for a description of the expense. This exact
same string must be used in your input table."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-type "Type"
  "A string to represent type in Input table.
This is a column label for the expense type. This exact same string
must be used in your input table."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-subtype "Subtype"
  "A string to represent subtype in Input table.
This is a column label for the expense subtype. This exact same
string must be used in your input table."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-extras
  '(("With"  "card" left)
    ("Notes" "okay" left))
  "An alist of extra columns in Input table.
The keys are extra columns that you may have in your Input table. The
values are, respectively, the default value and the alignment that you'd
like to be automatically added when running ‘splurge-expense-new’.

Edit this if you want to have additional columns with your personal
notes — which will be ignored, except for autofilling them with these
default values when adding a new expense.

If you set this to nil, it won't autofill — but you can still add
extra columns if you like and it won't affect the results."
  :package-version '(splurge "0.2.0")
  :type '(alist :key-type string
                :value-type (group string (choice (const left)
                                                  (const right)))))

(defcustom splurge-input-name-prefix "expenses"
  "A string prefix for #+name at the top of the Input table.
This is used when creating new Input tables.
You can edit it directly on the table later if you want."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-input-tblfm-line
  "#+tblfm: $2='(format \"%.2f\" $2);N"
  "A string for #+tblfm at the bottom of the Input table.
This is used when creating new Input tables.
You can edit it directly on the table later if you want."
  :package-version '(splurge "0.2.0")
  :type 'string)


;;;;; Report table

(defcustom splurge-report-language-months :en
  "Language for displaying month abbreviations in Report table.
Choose :user to use your own abbreviations, which you can specify
in ‘splurge-report-language-months-user’."
  :package-version '(splurge "0.2.0")
  :type '(choice (const :tag "English" :en)
                 (const :tag "User-defined" :user)))

(defcustom splurge-report-language-months-user
  [jan feb mar apr may jun jul aug sep oct nov dec]
  "User-defined month abbreviations in Report table.
You can define here your own month abbreviations. To use them,
change the variable ‘splurge-report-language-months’ to :user."
  :package-version '(splurge "0.2.0")
  :type '(vector symbol symbol symbol symbol symbol symbol
                 symbol symbol symbol symbol symbol symbol))

(defcustom splurge-report-separator " — "
  "Separator between type and subtype in Report table."
  :package-version '(splurge "0.2.0")
  :type '(choice (const :tag "—" " — ")
                 (const :tag "·" " · ")))

(defcustom splurge-report-total "Total"
  "A string to represent total in Report table.
This is a row label representing the total amount spent in each month."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-report-ytd "YTD"
  "A string to represent year-to-date in Report table.
This is a column label representing the total amount spent in the
year so far."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-report-avg "Avg"
  "A string to represent average in Report table.
This is a column label representing the average monthly amount
spent in the year so far."
  :package-version '(splurge "0.2.0")
  :type 'string)

(defcustom splurge-report-normalize-avg t
  "Whether to normalize the average when in the same year.
If non-nil, and only if the year is the current one, do not
normalize using 365 days, but use instead the number of elapsed
days in the year until today."
  :package-version '(splurge "0.2.0")
  :type 'boolean)


;;;;; Types and subtypes

(defvar splurge--expenses-types-example
  '(("food"      "supermarket" "restaurant")
    ("transport" "taxi" "flights" "subway" "bus" "gasoline")
    ("utilities" "electricity"))
  "Alist of types and subtypes of expenses.
This is just an example of the format.")

(defcustom splurge-expenses-types splurge--expenses-types-example
  "Alist of types and subtypes of expenses.
The first item in each list is the type, and the remaining items
are its subtype. Edit it to your liking."
  :package-version '(splurge "0.2.0")
  :type '(alist :key-type string
                :value-type (repeat string)))


;;;; Functions
;;;;; Input table: new

;;;###autoload
(defun splurge-table-new ()
  "Create a new input Org table at point."
  (interactive)
  (save-excursion (insert (splurge--table-new-str)))
  (forward-line 1)
  (orgtbl-ctrl-c-ctrl-c nil))

;;;;;; Internal

(defun splurge--table-new-str ()
  "String for new input Org table."
  (let* ((year (format-time-string "%Y"))
         (name (format "#+name: %s-%s\n" splurge-input-name-prefix year))
         (xtra (mapcar #'car splurge-input-extras))
         (cols (append (splurge--expense-input-colnames) xtra))
         (hedr (xht--list-to-orgtbl-row cols))
         (hlin "|------+------+------+------+------+------|\n")
         (tblf splurge-input-tblfm-line))
    (concat name hedr hlin tblf "\n")))


;;;;; Expense: new or edit

;;;###autoload
(defun splurge-expense-new ()
  "Add new expense line to Org table at point.
Ask for each mandatory value."
  (interactive)
  (splurge--orgtbl-new-line)
  (splurge--expense-edit-date)
  (splurge--expense-edit-amount)
  (splurge--expense-edit-what)
  (splurge--expense-edit-type-and-subtype)
  (splurge--expense-edit-maybe-fill-rest))

;;;###autoload
(defun splurge-expense-edit (&optional var)
  "Add or edit a value in the current line.
If VAR is nil, ask which."
  (interactive)
  (splurge--expense-edit-able)
  (let ((ops (->> (splurge--expense-input-colnames)
                  (-remove-item splurge-input-subtype))))
    (if var
        (unless (member var ops)
          (user-error "%s: invalid variable" var))
      (setq var (completing-read "Value to edit: " ops)))
    (-let [(da am wh _) ops]
      (cond ((equal var da) (splurge--expense-edit-date))
            ((equal var am) (splurge--expense-edit-amount))
            ((equal var wh) (splurge--expense-edit-what))
            (:otherwise     (splurge--expense-edit-type-and-subtype))))))

;;;;;; Internal
;;;;;;; Edit

(defun splurge--expense-edit-able ()
  "Whether at editable Org table line, otherwise error."
  (unless (org-at-table-p)
    (user-error "Not at a table"))
  (when (org-at-table-hline-p)
    (user-error "At a hline"))
  (if (> (org-table-current-dline) 1) t
    (user-error "Not at a regular table line")))

(defun splurge--expense-input-colnames ()
  "Currently meaningful input table column names."
  (list splurge-input-date
        splurge-input-amount
        splurge-input-what
        splurge-input-type
        splurge-input-subtype))

(defun splurge--expense-edit-date ()
  "Add or edit date in current line."
  (splurge--expense-edit-variable
   splurge-input-date (splurge--expense-ask-date) 'left))

(defun splurge--expense-edit-amount ()
  "Add or edit amount in current line."
  (splurge--expense-edit-variable
   splurge-input-amount (splurge--expense-ask-amount) 'right))

(defun splurge--expense-edit-what ()
  "Add or edit description in current line."
  (splurge--expense-edit-variable
   splurge-input-what (splurge--expense-ask-what) 'left))

(defun splurge--expense-edit-type-and-subtype ()
  "Add or edit type and subtype in current line."
  (-let [(typ . sub) (splurge--expense-ask-type-and-subtype)]
    (splurge--expense-edit-variable splurge-input-type    typ 'left)
    (splurge--expense-edit-variable splurge-input-subtype sub 'left)))

(defun splurge--expense-edit-maybe-fill-rest ()
  "Maybe autofill extra columns with default values."
  (let* ((extra (-difference (splurge--orgtbl-header)
                             (splurge--expense-input-colnames)))
         (args nil))
    (--each extra
      (setq args (assoc it splurge-input-extras))
      (when args (apply #'splurge--expense-edit-variable args)))))

(defun splurge--expense-edit-variable (varstr varval align)
  "Add or edit variable in current line."
  (let* ((varidx (splurge--orgtbl-colname-to-colindex varstr))
         (curval (org-no-properties (org-table-get-field varidx)))
         (lenval (length curval))
         (varval (splurge--expense-pad-string (or varval "") lenval align)))
    (ignore (org-table-get-field varidx varval))))

(defun splurge--expense-pad-string (s len align)
  "Pad string S to length LEN leaving one blank space.
ALIGN is either \\='right or \\='left."
  (pcase-exhaustive align
    ('left  (s-pad-right len " " (format " %s" s)))
    ('right (s-pad-left  len " " (format "%s " s)))))


;;;;;;; Ask

(defun splurge--expense-ask-date ()
  "Prompt for date, return org time string."
  (let* ((fmts "[%Y-%m-%d %a]")
         (date (org-read-date))
         (time (date-to-time date)))
    (format-time-string fmts time)))

(defun splurge--expense-ask-amount ()
  "Prompt for amount, return string with two decimal digits."
  (let ((read (--> (format "%s: " splurge-input-amount)
                   (read-from-minibuffer it)
                   (if (s-blank? it)
                       (splurge--expense-ask-amount)
                     (read it)))))
    (when (consp read)  ; e.g. Amount: (+ 20 22)
      (setq read (eval read)))
    (if (numberp read)
        (format "%.2f" read)
      (splurge--expense-ask-amount))))

(defun splurge--expense-ask-what ()
  "Prompt for description, return it."
  (let* ((tbl (splurge--ht-from-orgtbl-at-point))
         (ops (splurge--list-whats tbl))
         (pmp (format "%s: " splurge-input-what)))
    (completing-read pmp ops)))

(defun splurge--expense-ask-type-and-subtype ()
  "Prompt for type–subtype pair, return cons cell."
  (let* ((sep splurge-report-separator)
         (new "*NEW*")
         (str (with-output-to-string
                (h--each (h<-alist splurge-expenses-types)
                  (--each (-list value)
                    (princ (format "%s%s%s\n" key sep it))))))
         (ops (cons new (s-lines (s-chomp str))))
         (pmp (concat splurge-input-type sep
                      splurge-input-subtype ": "))
         (t-s (completing-read pmp ops nil t)))
    (if (string= t-s new)
        (splurge--expense-ask-new-type-and-subtype)
      (apply #'cons (s-split sep t-s)))))

(defun splurge--expense-ask-new-type-and-subtype ()
  "Prompt for new type–subtype pair, return cons cell."
  (let* ((typ (format "%s: " splurge-input-type))
         (typ (format "%s"  (read-from-minibuffer typ)))
         (sub (format "%s: " splurge-input-subtype))
         (sub (format "%s"  (read-from-minibuffer sub)))
         (pmp (format "Add %s + %s to ‘splurge-expenses-types’? " typ sub))
         (add (y-or-n-p pmp)))
    (when add
      (-some--> splurge-expenses-types
        h<-alist
        (let* ((cur (h-get it typ))
               (new (if cur (cons sub cur) (-list sub))))
          (h-put it typ new))
        h->alist
        (setq splurge-expenses-types it)))
    (cons typ sub)))


;;;;;;; Org table

(defun splurge--orgtbl-new-line ()
  "Add a clean entry line below the table header.
Does not recalculate"
  (unless (org-at-table-p) (user-error "Not at a table"))
  (goto-char (org-table-begin))
  ;; ‘org-table-insert-row’ would recalculate (slower)
  (let* ((line (buffer-substring-no-properties
                (point) (line-end-position)))
         (newl (org-table-clean-line line)))
    (forward-line 1)
    (unless (org-at-table-hline-p) (org-table-insert-hline 'above))
    (while  (org-at-table-hline-p) (forward-line 1))
    (save-excursion (insert newl ?\n))))

(defun splurge--orgtbl-goto-col (col)
  "Given COL number, go to that column in this same line."
  (org-table-goto-column (splurge--orgtbl-colname-to-colindex col)))

(defun splurge--orgtbl-colname-to-colindex (colname)
  "Given COLNAME, return column index."
  (let ((idx (-elem-index colname (splurge--orgtbl-header))))
    (if idx (1+ idx) (error "Could not find column “%s”" colname))))

(defun splurge--orgtbl-header ()
  "Return a list of column names of Org table at point."
  (unless (org-at-table-p) (user-error "Not at a table"))
  (let ((orgtbl-str (xht--do-as-string-orgtbl-at-point)))
    (->> orgtbl-str
         (s-replace-regexp "\\(\r\n\\|[\n\r]\\).*" "")
         org-table-to-lisp  car)))


;;;;; Types: update

;;;###autoload
(defun splurge-expenses-types-update (&optional arg)
  "Update ‘splurge-expenses-types’ with Org table at point.
If optional ARG is
- nil, merge types and subtypes of Org table at point into
  ‘splurge-expenses-types’.
- non-nil, ask: clear ‘splurge-expenses-types’ before updating?"
  (interactive "P")
  (let* ((poi-ht (splurge--expenses-types-at-point-ht))
         (cur-ht (h<-alist splurge-expenses-types))
         (curval nil)
         (newval nil)
         (msg "Clear ‘splurge-expenses-types’ before update? ")
         (new-ht (if (or (h-empty? cur-ht)
                         (and arg (y-or-n-p msg)))
                     poi-ht
                   (h--each poi-ht
                     (setq curval (-list (h-get cur-ht key))
                           newval (append value curval))
                     (h-put! cur-ht key (-uniq newval)))
                   cur-ht)))
    (unless (h-empty? new-ht)
      (let* ((new-al (h->alist new-ht)))
        (when (setq splurge-expenses-types new-al)
          (message "%S" new-al))))))

;;;;;; Internal

(defun splurge--expenses-types-at-point-ht ()
  "Hash table of types and subtypes of orgtbl at point."
  (let* ((htble (splurge--ht-from-orgtbl-at-point))
         (types (splurge--list-types htble))
         (res-ht (h-new (length types))))
    (--each types
      (h-put! res-ht it (splurge--list-subtypes htble it)))
    res-ht))

(defun splurge--expenses-types-at-point-alist ()
  "Alist of types and subtypes of orgtbl at point."
  (h->alist (splurge--expenses-types-at-point-ht)))


;;;;; Report: show

;;;###autoload
(defun splurge-report ()
  "Show in a new buffer a report of the expenses Org table at point."
  (interactive)
  (let* ((sep    splurge-report-separator)
         (htbl   (splurge--ht-from-orgtbl-at-point))
         (year   (splurge--year htbl))
         (types  (splurge--list-types htbl))
         (res    (splurge--ht-populate htbl types sep))
         (report (splurge--report-make-str res year sep)))
    (splurge--report-display report sep)))

;;;;;; Internal
;;;;;;; Display report

(defun splurge--report-make-str (res year sep)
  "Given populated hashtbl RES, YEAR, and separator SEP, make string."
  (concat "[" year "]" "\n\n"
          (h->orgtbl
           ;; The below sorts into a hash table where subtypes
           ;; appear at the end. That order is then preserved
           ;; upon conversion to Org table.
           (h-mix (h--rej (s-contains-p sep key) res)
                  (h--sel (s-contains-p sep key) res)))))

(defun splurge--report-display (report sep &optional buffer-name)
  "Given orgtbl REPORT and separator SEP, display it in a new buffer.
Unless optional BUFFER-NAME is given, use default."
  (unless buffer-name
    (setq buffer-name "*splurge — expenses report*"))
  ;;(xht--to-display-buffer buffer-name)
  (let ((buffer (get-buffer-create buffer-name)))
    (pop-to-buffer buffer)
    (text-mode)
    (goto-char (point-min)))
  (when (> (point-max) 3)
    (save-excursion (insert "\n\n\f\n\n")))
  (when (fboundp 'olivetti-mode)
    (let ((pr (make-progress-reporter "Turning off olivetti-mode...")))
      (olivetti-mode -1)
      (progress-reporter-done pr)))
  (let ((pr (make-progress-reporter "Turning on orgtbl-mode...")))
    (ignore-errors (orgtbl-mode))
    (progress-reporter-done pr))
  (save-excursion
    (xht--non-aggressively-insert-str-from-here report)
    (splurge--report-post-process sep))
  (forward-line 1)
  (toggle-truncate-lines 1)
  (message "Report"))

(defun splurge--report-post-process (sep)
  "Make adjustments to expenses report buffer before displaying it.
SEP is the separator between types and subtypes of expenses."
  (splurge--report-add-hlines sep)
  (splurge--report-clean-zeroed-cells)
  (splurge--report-sort-types-reverse-numerically)
  (splurge--report-sort-subtypes-reverse-numerically))

(defun splurge--report-add-hlines (sep)
  "Add hlines between total, high-level, detailed."
  (goto-char (point-min))
  (search-forward "|---" nil t 1)
  (search-forward splurge-report-total nil t 1)
  (org-table-insert-hline)
  (search-forward sep nil t 1)
  (forward-line -1)
  (org-table-insert-hline))

(defun splurge--report-clean-zeroed-cells ()
  "Clean zeroed cells."
  (goto-char (point-min))
  (while (search-forward " 0 " nil t)
    (replace-match "   ")))

(defun splurge--report-sort-types-reverse-numerically ()
  "Sort types reverse-numerically."
  (splurge--report-sort-table 2 ?N))

(defun splurge--report-sort-subtypes-reverse-numerically ()
  "Sort subtypes reverse-numerically."
  (splurge--report-sort-table 3 ?N))

(defun splurge--report-sort-table (section sorting-type)
  "Sort SECTION of table by SORTING-TYPE.
SECTION is an integer."
  (goto-char (point-min))
  (search-forward "|---" nil t section)
  (forward-line 1)
  (end-of-line)
  (forward-char -2)
  (org-table-sort-lines nil sorting-type))


;;;;;;; Hash tables

(defun splurge--ht-populate (htbl types sep)
  "Given HTBL, TYPES and SEP, output hash table with values."
  (let ((res (h-new 30)))
    (h-put! res splurge-report-total
            (splurge--ht-add-by-month htbl splurge-report-total))
    (-each types
      (lambda (type)
        (let ((ttbl (splurge--ht-this-type htbl type))
              (Type (capitalize type)))
          (h-put! res Type
                  (splurge--ht-add-by-month ttbl Type))
          (let ((subtypes (splurge--list-subtypes ttbl)))
            (-each subtypes
              (lambda (subtype)
                (let ((stbl  (splurge--ht-this-subtype ttbl subtype))
                      (label (capitalize (concat type sep subtype))))
                  (h-put! res label
                          (splurge--ht-add-by-month stbl label)))))))))
    res))

(defun splurge--ht-from-orgtbl-at-point ()
  "Convert Org table at point to a hash table.
The hash table will have unique numerical keys."
  (unless (org-at-table-p) (user-error "Not at a table"))
  (let* ((lol (->> (xht--do-as-string-orgtbl-at-point)
                   (org-table-to-lisp)
                   (-remove-item 'hline)))
         (len (length lol))
         (ids (-iota len)))
    (h<-lol (-zip-pair ids lol))))

(defun splurge--ht-this-month (htbl month)
  "New hash table with only the entries of numeric MONTH of HTBL."
  (h--sel (equal month (splurge--month-from-org-time-string
                        (h-get value splurge-input-date)))
          htbl))

(defun splurge--ht-this-type (htbl type)
  "New hash table with only the entries of TYPE in HTBL."
  (if (equal type splurge-report-total)
      htbl
    (splurge--ht-this-type-1 htbl type)))

(defun splurge--ht-this-type-1 (htbl type)
  "Helper for ‘splurge--ht-this-type’ and ‘splurge--list-subtypes’."
  (h--sel (equal type (h-get value splurge-input-type))
          htbl))

(defun splurge--ht-this-subtype (htbl subtype)
  "New hash table with only the entries of SUBTYPE in HTBL."
  (h--sel (equal subtype (h-get value splurge-input-subtype))
          htbl))

(defun splurge--ht-add-by-month (htbl label)
  "New hash table with sum of “Expenses” of HTBL for each month of year.
LABEL is the description of the item.
Also calculate a total for the year, plus a monthly average."
  (let* ((res (h-new 15))
         (YTD (splurge--add htbl))
         (Avg (splurge--avg htbl YTD)))
    (h-put! res "" label)
    (--each (-iota 12 1)
      (h-put! res
              (splurge--month-abbrev it)
              (splurge--add (splurge--ht-this-month htbl it))))
    (h-put! res splurge-report-ytd YTD)
    (h-put! res splurge-report-avg Avg)
    res))


;;;;;;; Calculation

(defun splurge--add-1 (htbl)
  "Add the values of field “Expenses” of hash-table HTBL."
  (->> (h-2d-col htbl splurge-input-amount)  cdr
       (-map #'string-to-number)  -sum))

(defun splurge--add (htbl)
  "Add the values of field “Expenses” of hash-table HTBL.
Round it to the closest integer."
  (format "%.0f" (splurge--add-1 htbl)))

(defun splurge--avg (htbl &optional YTD)
  "Monthly average of field “Expenses” of hash-table HTBL.
It's rounded to the closest integer.
If YTD is given, use it instead of redoing ‘splurge--add’'s work."
  (setq YTD (pcase YTD
              ("" (splurge--add-1 htbl))
              ((pred numberp) YTD)
              ((pred stringp) (string-to-number YTD))))
  (let* (;; If ‘splurge-report-normalize-avg’ is non-nil and expenses are for
         ;; current year, calculate day of year; else 365.
         (days (if (and splurge-report-normalize-avg
                        (equal (format-time-string "%Y")  ; this-Y
                               (splurge--year htbl)))     ; htbl-Y
                   (string-to-number (format-time-string "%j"))
                 365))
         (Avg  (-> YTD (* 365) (/ days) (/ 12))))
    (format "%.0f" Avg)))


;;;;;;; Whats, types and subtypes

(defun splurge--list-var (htbl var)
  "List all items VAR in expenses hash-table HTBL."
  (->> (h-2d-col htbl var)  -uniq  cdr  (-sort #'string<)))

(defun splurge--list-whats (htbl)
  "List all whats in expenses hash-table HTBL."
  (splurge--list-var htbl splurge-input-what))

(defun splurge--list-types (htbl)
  "List all types in expenses hash-table HTBL."
  (splurge--list-var htbl splurge-input-type))

(defun splurge--list-subtypes (htbl &optional type)
  "List all subtypes in expenses hash-table HTBL.
If optional arg TYPE is given, filter to only those."
  (unless (equal type splurge-report-total)
    (-> (if type (splurge--ht-this-type-1 htbl type) htbl)
        (splurge--list-var splurge-input-subtype))))


;;;;;;; Dates

(defun splurge--year (htbl)
  "Year of hash table HTBL."
  (--> (h-2d-col htbl splurge-input-date)                cdr
       (-map #'splurge--year-from-org-time-string it)  -uniq
       (pcase (length it)
         (1 (format "%s" (car it)))
         (0 (error "No year?"))
         (_ (error "More than one year?")))))

(defun splurge--year-from-org-time-string (s)
  "Year as number from an org time string S."
  (nth 5 (org-parse-time-string s)))

(defun splurge--month-from-org-time-string (s)
  "Month as number from an org time string S."
  (nth 4 (org-parse-time-string s)))

(defun splurge--month-abbrev (month &optional lang)
  "Abbreviation of MONTH-given-as-number in language LANG.
If LANG is nil, default to ‘splurge-report-language-months’, which in turn
defaults to English."
  (-> (splurge--months-abbrevs-ht)
      (h-get (or lang splurge-report-language-months))
      (aref  (1- month))
      symbol-name))

(defun splurge--months-abbrevs-ht ()
  "Hash table of months abbrevs."
  (h* :en [Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]
      :user splurge-report-language-months-user))


;;;;; See README

;;;###autoload
(defun splurge-see-readme (&optional heading narrow)
  "Open splurge's README.org file.
Search for the file in splurge.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme splurge--readme-org))
    (if (file-exists-p readme)
        (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (splurge--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" splurge--name))))

(defun splurge--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)
                    (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)
      (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;;; See News

;;;###autoload
(defun splurge-see-news ()
  "See the News in splurge's README.org file."
  (interactive)
  (splurge-see-readme "News" 'narrow)
  (splurge--display-org-subtree))

(defun splurge--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '(outline-hide-subtree
                outline-show-children
                outline-next-heading
                outline-show-branches)))
    (and (fboundp (nth 0 cmds))
         (fboundp (nth 1 cmds))
         (fboundp (nth 2 cmds))
         (fboundp (nth 3 cmds))
         (mapc #'funcall cmds))))


;;;; Wrapping up

(provide 'splurge)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; splurge.el ends here