2024-07-13 15:10:36 +01:00
|
|
|
#!/usr/bin/env -S guile -e main -s
|
|
|
|
!#
|
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Script for updating current account and credit card statements
|
|
|
|
;; downloaded from Nationwide, who use a date and currency format
|
|
|
|
;; that Gnucash does not support.
|
2024-07-13 15:10:36 +01:00
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
(use-modules (ice-9 getopt-long)
|
|
|
|
((srfi srfi-1) #:select (drop))
|
|
|
|
(dsv))
|
2024-07-13 15:10:36 +01:00
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Date appears in Nationwide statements in the format
|
|
|
|
;; "10 Jan 2024", but this is not understood by Gnucash
|
|
|
|
;; so we convert it to YYYY-MM-DD format.
|
2024-07-13 15:10:36 +01:00
|
|
|
(define date-input-format "%d %b %Y")
|
|
|
|
(define date-output-format "%Y-%m-%d")
|
|
|
|
|
|
|
|
(define (format-date d)
|
|
|
|
(strftime date-output-format
|
|
|
|
(car (strptime date-input-format d))))
|
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Characters we expect to see in a numeric amount field. The
|
|
|
|
;; Nationwide statements contain a non-ASCII currency character
|
|
|
|
;; that we want to delete.
|
|
|
|
(define currency-charset (string->char-set "0123456789.-"))
|
|
|
|
|
|
|
|
(define (format-amount s)
|
|
|
|
(string-filter currency-charset s))
|
|
|
|
|
|
|
|
;; Profiles for the different statemnets.
|
|
|
|
;; skip: the number of leading rows to skip
|
|
|
|
;; header: boolean indicating whether or not the first unskipped
|
|
|
|
;; row is a header
|
|
|
|
;; date-cols: list of columns containing dates
|
|
|
|
;; amount-cols: list columns containing amounts
|
|
|
|
(define profiles
|
|
|
|
'(("credit-card" . ((skip . 4)
|
|
|
|
(header . #t)
|
|
|
|
(date-cols . (0))
|
|
|
|
(amount-cols . (3 4))))
|
|
|
|
("current-account" . ((skip . 4)
|
|
|
|
(header . #t)
|
|
|
|
(date-cols . (0))
|
|
|
|
(amount-cols . (3 4 5))))))
|
|
|
|
|
|
|
|
;; Predicate for validating the profile option.
|
|
|
|
(define (valid-profile? p)
|
|
|
|
(if (assoc p profiles) #t #f))
|
|
|
|
|
|
|
|
;; Update a list by applying the given function to each of the
|
|
|
|
;; listed columns.
|
|
|
|
(define (update-list lst cols f)
|
|
|
|
(for-each (lambda (k)
|
|
|
|
(let ((v (list-ref lst k)))
|
|
|
|
(list-set! lst k (f v))))
|
|
|
|
cols))
|
|
|
|
|
|
|
|
;; Given a spec listing the date and amount columns, return a
|
|
|
|
;; function that will apply the corresponding formats to a row.
|
|
|
|
(define (process-row spec)
|
|
|
|
(let ((date-cols (assq-ref spec 'date-cols))
|
|
|
|
(amount-cols (assq-ref spec 'amount-cols)))
|
|
|
|
(lambda (row)
|
|
|
|
(when date-cols
|
|
|
|
(update-list row date-cols format-date))
|
|
|
|
(when amount-cols
|
|
|
|
(update-list row amount-cols format-amount)))))
|
|
|
|
|
|
|
|
;; Read a CSV from the given path.
|
2024-07-13 15:10:36 +01:00
|
|
|
(define (read-statement path)
|
|
|
|
(call-with-input-file path
|
|
|
|
(lambda (port)
|
|
|
|
(dsv->scm port #:format 'rfc4180))))
|
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Write data to the given path in CSV format.
|
|
|
|
(define (write-statement data path)
|
|
|
|
(call-with-output-file path
|
|
|
|
(lambda (port)
|
|
|
|
(scm->dsv data port #:format 'rfc4180))))
|
2024-07-13 15:10:36 +01:00
|
|
|
|
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
(define (update-data spec data)
|
|
|
|
(let* ((data (drop data (or (assq-ref spec 'skip) 0)))
|
|
|
|
(header (if (assq-ref spec 'header) (car data) #f))
|
|
|
|
(data (if header (cdr data) data)))
|
|
|
|
(for-each (process-row spec) data)
|
|
|
|
(if header
|
|
|
|
(cons header data)
|
|
|
|
data)))
|
|
|
|
|
|
|
|
;; Apply the updates defined in `spec` to the statement read
|
|
|
|
;; from input-path and write the updated data to output-path.
|
|
|
|
(define (process-statement spec input-path output-path)
|
|
|
|
(let ((data (read-statement input-path)))
|
|
|
|
(write-statement (update-data spec data) output-path)))
|
2024-07-13 15:10:36 +01:00
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Display a usage message and (optional) error message to STDERR
|
|
|
|
;; and exit. If an error message is given the exit code will be
|
|
|
|
;; non-zero.
|
2024-07-13 15:10:36 +01:00
|
|
|
(define* (usage #:optional errmsg)
|
|
|
|
(with-output-to-port (current-error-port)
|
|
|
|
(lambda ()
|
|
|
|
(when errmsg
|
|
|
|
(display "Error: ")
|
|
|
|
(display errmsg)
|
|
|
|
(newline))
|
|
|
|
(display "\
|
|
|
|
Usage: fix-credit-card-statement [options]
|
|
|
|
-h, --help Display this help.
|
|
|
|
-i, --input=FILENAME Input file path.
|
|
|
|
-o, --output=FILENAME Output file path. Required unless --overwrite is given.
|
|
|
|
-w, --overwrite Overwrite the input file with the updated data.
|
2024-07-13 16:55:52 +01:00
|
|
|
-p, --profile=PROFILE Profile name [credit-card|current-account].
|
2024-07-13 15:10:36 +01:00
|
|
|
")
|
|
|
|
(exit (if errmsg EXIT_FAILURE EXIT_SUCCESS)))))
|
|
|
|
|
2024-07-13 16:55:52 +01:00
|
|
|
;; Process command-line arguments and validate options.
|
|
|
|
;; If valid, run process-statement with the given options.
|
2024-07-13 15:10:36 +01:00
|
|
|
(define (main args)
|
2024-07-13 16:55:52 +01:00
|
|
|
(let* ((option-spec `((help (single-char #\h) (value #f))
|
2024-07-13 15:10:36 +01:00
|
|
|
(input (single-char #\i) (value #t))
|
|
|
|
(output (single-char #\o) (value #t))
|
2024-07-13 16:55:52 +01:00
|
|
|
(overwrite (single-char #\w) (value #f))
|
|
|
|
(profile (single-char #\p) (value #t) (predicate ,valid-profile?))))
|
2024-07-13 15:10:36 +01:00
|
|
|
(options (getopt-long args option-spec))
|
|
|
|
(help-wanted (option-ref options 'help #f))
|
2024-07-13 16:55:52 +01:00
|
|
|
(profile (option-ref options 'profile #f))
|
2024-07-13 15:10:36 +01:00
|
|
|
(input (option-ref options 'input #f))
|
|
|
|
(output (option-ref options 'output #f))
|
|
|
|
(overwrite (option-ref options 'overwrite #f)))
|
|
|
|
(cond
|
|
|
|
(help-wanted (usage))
|
2024-07-13 16:55:52 +01:00
|
|
|
((not profile) (usage "profile is required"))
|
2024-07-13 15:10:36 +01:00
|
|
|
((not input) (usage "input filename is required"))
|
|
|
|
((and overwrite output) (usage "output filename cannot be given with --overwrite"))
|
|
|
|
((not (or overwrite output)) (usage "output filename is required without --overwrite")))
|
2024-07-13 16:55:52 +01:00
|
|
|
(process-statement (assoc-ref profiles profile) input (or output input))))
|