(add-to-load-path (in-vicinity (getenv "HOME") "ossaulib"))

(use-modules (ice-9 format)
	     (ice-9 regex)
	     (ossau ofx)
	     (srfi srfi-1)
	     (sxml simple)
	     (sxml match)
	     (srfi srfi-19))

;; (ossau ofx) provides 'get-transactions' to read transactions from a
;; single OFX file.  Let's build on that to read transactions from
;; multiple OFX files, assuming that the files given are already
;; ordered by date, so that the transactions in them follow on from
;; each other.

(define (read-transactions . files)
  (apply append (map get-transactions files)))

;; Return a date that is 00:00 UTC on the day of the given transaction.

(define (tx-date tx)
  (let ((d (string->date (tx:date tx) "~Y~m~d")))
    (make-date 0 0 0 0			; nsec sec min hr
	       (date-day d)
	       (date-month d)
	       (date-year d)
	       0			; zone offset, i.e. UTC
	       )))

;; Given a date, return a date that is the start of the next month.

(define (start-of-following-month d)
  (if (= (date-month d) 12)
      (make-date 0 0 0 0		; nsec sec min hr
		 1			; day of month
		 1			; month of year
		 (+ (date-year d) 1)
		 0			; zone offset, i.e. UTC
		 )
      (make-date 0 0 0 0		; nsec sec min hr
		 1			; day of month
		 (+ (date-month d) 1)
		 (date-year d)
		 0			; zone offset, i.e. UTC
		 )))

;; Given a date, return a date that is exactly N days later.

(define (n-days-later d n)
  (julian-day->date (+ (date->julian-day d) n)))

;; Compare two dates.

(define (date-before? d1 d2)
  (< (date->julian-day d1) (date->julian-day d2)))

;; Given a series of transactions, partition them into an alist of
;; smaller series according to time periods calculated from START-DATE
;; and NEXT-START-DATE-PROC: the start of the first period is
;; START-DATE, the start of the second period is (NEXT-START-DATE-PROC
;; START-DATE), the start of the third period is (NEXT-START-DATE-PROC
;; (NEXT-START-DATE-PROC START-DATE)), and so on.  In the returned
;; alist, each entry is (DATE . TX-LIST), where DATE is the exclusive
;; period end date (== the start date of the following period) for the
;; transactions in TX-LIST.

(define (partition-by-period txs start-date next-start-date-proc)
  (let loop ((txs txs)
	     (partition-end-date-exclusive (next-start-date-proc start-date))
	     (previous-partitions '())
	     (current-partition '()))
    (if (null? txs)
	(reverse (acons partition-end-date-exclusive current-partition previous-partitions))
	(let* ((tx (car txs)))
	  (if (date-before? (tx-date tx) partition-end-date-exclusive)
	      ;; This transaction is within the current partition.
	      (loop (cdr txs)
		    partition-end-date-exclusive
		    previous-partitions
		    (cons tx current-partition))
	      ;; This transaction is after the current partition.  But
	      ;; bear in mind that it might not be in the immediate
	      ;; next partition either.  The safest thing to do is to
	      ;; close out the current partition, advance the limit
	      ;; date, then loop round to look at the transaction in
	      ;; hand again.
	      (loop txs
		    (next-start-date-proc partition-end-date-exclusive)
		    (acons partition-end-date-exclusive current-partition previous-partitions)
		    '()))))))

;; Given a series of transactions, use SORT-FUNCTION to partition them
;; into an alist of smaller series.  We call SORT-FUNCTION on each
;; transaction, and it returns a string indicating the name of the
;; partition that that transaction should belong to.  In the result
;; alist, each entry is (PARTITION-NAME . TX-LIST).

(define (partition-by-sort-function txs sort-function)
  (let loop ((txs txs)
	     (partitions '()))
    (if (null? txs)
	(map (lambda (name-list-pair)
	       (cons (car name-list-pair) (reverse (cdr name-list-pair))))
	     (sort partitions
		   (lambda (x y)
		     (string<? (car x) (car y)))))
	(loop (cdr txs)
	      (let* ((tx (car txs))
		     (partition-name (sort-function tx)))
		(assoc-set! partitions
			    partition-name
			    (cons tx (or (assoc-ref partitions partition-name) '()))))))))

;; Given an alist of regexps and partition names, build a
;; SORT-FUNCTION that partitions transactions by matching the
;; transaction description against the regexps.

(define (regexp-alist->sort-function regexp-alist)
  (lambda (tx)
    (let ((description (tx:description tx)))
      (let loop ((regexp-alist regexp-alist))
	(cond ((null? regexp-alist)
	       "")
	      ((string-match (caar regexp-alist) description)
	       (cdar regexp-alist))
	      (else
	       (loop (cdr regexp-alist))))))))

;; In this file, an amount at rest is always represented as a string
;; with 2 decimal places.  Convert from that to an integer number of
;; pence:

(define (amount->pence amount)
  (inexact->exact (round (* 100 (string->number amount)))))

;; And the reverse:

(define (pence->amount pence)
  (format-2dp (/ (exact->inexact pence) 100)))

;; Given a series of transactions, return the sum of their amounts.

(define (sum-transactions initial-pence txs)
  (pence->amount (fold (lambda (tx previous-total-pence)
			 (+ previous-total-pence
			    (amount->pence (tx:amount tx))))
		       initial-pence
		       txs)))

;; Given a series of transactions, return an array suitable for Org
;; display that shows their total followed by the constituent
;; transactions and amounts.

(define (display-txs-with-initial-sum txs partition-name)
  (cons (list (string-append "\"" partition-name "\"") (sum-transactions 0 txs) "" "")
	(map (lambda (tx)
	       (list "" "" (tx:description tx) (tx:amount tx)))
	     txs)))

;; Examples to put the whole thing together.

(define (categorize-transactions-by-period sources next-start-date-proc regexp-alist show-all-txs)
  (let ((txs (apply read-transactions (map cadr sources)))
	(categorizer (regexp-alist->sort-function regexp-alist)))
    (apply append
	   (map (lambda (period-partition)
		  (cons* 'hline
			 (list (string-append "Period ending "
					     (date->string (car period-partition) "~1"))
			      "" "" "")
			(apply append
			       (map (lambda (name-list-pair)
				      (let ((detailed-display
					     (display-txs-with-initial-sum (cdr name-list-pair)
									   (car name-list-pair))))
					(if show-all-txs
					    detailed-display
					    (list (car detailed-display)))))
				    (partition-by-sort-function (cdr period-partition)
								categorizer)))))
		(partition-by-period txs
				     (tx-date (car txs))
				     next-start-date-proc)))))

(define (categorize-transactions-by-week sources regexp-alist show-all-txs)
  (categorize-transactions-by-period sources
				     (lambda (start-date)
				       (n-days-later start-date 7))
				     regexp-alist
				     show-all-txs))

(define (categorize-transactions-by-month sources regexp-alist show-all-txs)
  (categorize-transactions-by-period sources
				     start-of-following-month
				     regexp-alist
				     show-all-txs))

(define (periodic-balance sources initial-date initial-balance next-start-date-proc)
  (let* ((txs (apply read-transactions (map cadr sources))))
    (let loop ((partitions (partition-by-period txs
						(tx-date (car txs))
						next-start-date-proc))
	       (balance-pence (amount->pence initial-balance))
	       (output (list (list initial-date initial-balance))))
      (if (null? partitions)
	  (reverse output)
	  (let ((partition-end-balance (sum-transactions balance-pence (cdar partitions))))
	    (loop (cdr partitions)
		  (amount->pence partition-end-balance)
		  (cons (list (date->string (caar partitions) "~1")
			      partition-end-balance)
			output)))))))

(define (weekly-balance sources initial-date initial-balance)
  (periodic-balance sources
		    initial-date
		    initial-balance
		    (lambda (start-date)
		      (n-days-later start-date 7))))

(define (monthly-balance sources initial-date initial-balance)
  (periodic-balance sources
		    initial-date
		    initial-balance
		    start-of-following-month))

(define (two-column-table->alist table)
  (map (lambda (row)
	 (cons (car row) (cadr row)))
       table))

;; Comparison against a budget.

(define (sum-transactions-by-month-and-category sources regexp-alist)
  (let ((txs (apply read-transactions (map cadr sources)))
	(categorizer (regexp-alist->sort-function regexp-alist)))
    (let ((period-category-alist
	   (map (lambda (period-partition)
		  (cons (date->string (car period-partition) "~1")
			(map (lambda (name-list-pair)
			       (cons (car name-list-pair)
				     (sum-transactions 0 (cdr name-list-pair))))
			     (partition-by-sort-function (cdr period-partition) categorizer))))
		(partition-by-period txs
				     (tx-date (car txs))
				     start-of-following-month))))
      period-category-alist)))