;; ;; bank-account.scm ;; ;; Generic bank account records. ;; ;; ISC License ;; ;; Copyright 2023 Brmlab, z.s. ;; Dominik Pantůček ;; ;; Permission to use, copy, modify, and/or distribute this software ;; for any purpose with or without fee is hereby granted, provided ;; that the above copyright notice and this permission notice appear ;; in all copies. ;; ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL ;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED ;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE ;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR ;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS ;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;; (declare (unit bank-account)) (module bank-account ( make-bank-account bank-account-transactions bank-account-number bank-account-bank bank-account-insert make-bank-transaction bank-transaction-varsym bank-transaction-amount bank-transaction-currency bank-transaction-date bank-transaction-id bank-transaction-message bank-transaction-type bank-transaction-account bank-transaction-bank bank-transaction-specsym bank-accounts-member? ) (import scheme (chicken base) (chicken format) util-tag) ;; Unique tag (define TAG-BANK-TRANSACTION (make-tag bank-transaction)) ;; Bank account is represented as a list with list with the following ;; elements: list of transactions, account number, bank code. This ;; allows cheap transaction prepending. (define (make-bank-account number bank . maybe-transactions) (let ((transactions (if (null? maybe-transactions) '() (car maybe-transactions)))) (list transactions number bank))) ;; Trivial accessors (define bank-account-transactions car) (define bank-account-number cadr) (define bank-account-bank caddr) ;; Prepends given transaction to given bank account. It expects the ;; transactions list to be the first element of the bank account ;; list. (define (bank-account-insert account transaction) (cons (cons transaction (car account)) (cdr account))) ;; Creates new record (define (make-bank-transaction . args) (apply vector (cons TAG-BANK-TRANSACTION args))) ;; Defines one accessor (define-syntax define-accessor (syntax-rules () ((_ num) (void)) ((_ num acc accs ...) (begin (define (acc t) (vector-ref t num)) (define-accessor (add1 num) accs ...))))) ;; Defines all accessors (define-syntax define-accessors (syntax-rules () ((_ accs ...) (define-accessor 1 accs ...)))) ;; Define accessors for bank-transaction (define-accessors bank-transaction-id bank-transaction-date bank-transaction-amount bank-transaction-currency bank-transaction-varsym bank-transaction-message bank-transaction-type bank-transaction-account bank-transaction-bank bank-transaction-specsym) ;; Returns true if given acc/bc is in the list of accounts (define (bank-accounts-member? bas acc bc) (let loop ((bas bas)) (if (null? bas) #f (let ((ba (car bas))) (if (and (equal? acc (bank-account-number ba)) (equal? bc (bank-account-bank ba))) #t (loop (cdr bas))))))) )