Start fees table rework using new primitives.

This commit is contained in:
Dominik Pantůček 2023-04-03 12:01:14 +02:00
parent ea9c76d2fc
commit f2e47b9ad3
5 changed files with 101 additions and 88 deletions

View file

@ -174,7 +174,7 @@ MEMBERS-PRINT-SOURCES=members-print.scm dictionary.import.scm \
table.import.scm listing.import.scm ansi.import.scm \ table.import.scm listing.import.scm ansi.import.scm \
period.import.scm primes.import.scm members-base.import.scm \ period.import.scm primes.import.scm members-base.import.scm \
configuration.import.scm bank-account.import.scm \ configuration.import.scm bank-account.import.scm \
member-fees.import.scm member-fees.import.scm members-payments.import.scm
members-print.o: members-print.import.scm members-print.o: members-print.import.scm
members-print.import.scm: $(MEMBERS-PRINT-SOURCES) members-print.import.scm: $(MEMBERS-PRINT-SOURCES)
@ -218,7 +218,8 @@ members-payments.o: members-payments.import.scm
members-payments.import.scm: $(MEMBERS-PAYMENTS-SOURCES) members-payments.import.scm: $(MEMBERS-PAYMENTS-SOURCES)
WEB-STATIC-SOURCES=web-static.scm member-record.import.scm \ WEB-STATIC-SOURCES=web-static.scm member-record.import.scm \
utils.import.scm configuration.import.scm utils.import.scm configuration.import.scm \
members-payments.import.scm
web-static.o: web-static.import.scm web-static.o: web-static.import.scm
web-static.import.scm: $(WEB-STATIC-SOURCES) web-static.import.scm: $(WEB-STATIC-SOURCES)

View file

@ -67,8 +67,6 @@
member-record-add-payment member-record-add-payment
member-payments member-payments
member-balance
member-total-balance
member-record-tests! member-record-tests!
) )
@ -357,19 +355,6 @@
(define (member-payments mr) (define (member-payments mr)
(dict-ref mr 'payments '())) (dict-ref mr 'payments '()))
;; Balances totals
(define (member-balance mr)
(dict-ref mr 'balance (make-dict)))
;; Computes total member balance from credit, fees and payment
;; information
(define (member-total-balance mr)
(let* ((bal (member-balance mr))
(fees (dict-ref bal 'fees 0))
(credit (dict-ref bal 'credit 0))
(payment (dict-ref bal 'payment)))
(- (+ credit payment) fees)))
;; Self-tests ;; Self-tests
(define (member-record-tests!) (define (member-record-tests!)
(run-tests (run-tests

View file

@ -30,6 +30,8 @@
( (
member-payments-total member-payments-total
members-payments-process members-payments-process
member-balance
member-total-balance
) )
(import scheme (import scheme
@ -110,26 +112,35 @@
(let* ((accounts (load-accounts (let* ((accounts (load-accounts
(load-accounts-list apikeys-file) (load-accounts-list apikeys-file)
dir))) dir)))
(map member-add-balance (map member-sort-payments
(foldl members-payments-process-bank (foldl members-payments-process-bank
mb mb
accounts))) accounts)))
mb)) mb))
;; Adds all balances - payments are converted to CZK in member-payments-total ;; Adds all balances - payments are converted to CZK in member-payments-total
(define (member-add-balance mr) (define (member-sort-payments mr)
(let ((mr0 (dict-set mr (dict-set mr
'balance 'payments
(make-dict `((fees . ,(member-fees-total mr)) (sort (dict-ref mr 'payments '())
(credit . ,(member-credit-total mr)) (lambda (a b)
(payment . ,(member-payments-total mr))))))) (string<? (bank-transaction-date a)
(dict-set mr0 (bank-transaction-date b))))))
'payments
(sort (dict-ref mr0 'payments '())
(lambda (a b)
(string<? (bank-transaction-date a)
(bank-transaction-date b)))))))
;; Balances totals
(define (member-balance mr)
(make-dict `((fees . ,(member-fees-total mr))
(credit . ,(member-credit-total mr))
(payment . ,(member-payments-total mr)))))
;; Computes total member balance from credit, fees and payment
;; information
(define (member-total-balance mr)
(let* ((bal (member-balance mr))
(fees (dict-ref bal 'fees 0))
(credit (dict-ref bal 'credit 0))
(payment (dict-ref bal 'payment)))
(- (+ credit payment) fees)))
;; Total amount paid - calculated from payments ;; Total amount paid - calculated from payments
(define (member-payments-total mr) (define (member-payments-total mr)

View file

@ -57,7 +57,8 @@
members-base members-base
configuration configuration
bank-account bank-account
member-fees) member-fees
members-payments)
;; Prints human-readable information ;; Prints human-readable information
(define (print-member-info mr) (define (print-member-info mr)
@ -334,62 +335,76 @@
;; Prints summary table of all fees and credits for all members ;; Prints summary table of all fees and credits for all members
(define (print-members-fees-table MB) (define (print-members-fees-table MB)
(print (let ((balances (map member-balance MB))
(table->string (members ;; Pass 1
(cons (map
(list (ansi-string #:bgblue #:brightyellow #:bold "Member") (lambda (mr)
(ansi-string #:bgblue #:brightyellow #:bold "Status") (list (member-nick mr)
(ansi-string #:bgblue #:brightyellow #:bold "Fees") (if (member-suspended? mr)
(ansi-string #:bgblue #:brightyellow #:bold "Credit") "suspended"
(ansi-string #:bgblue #:brightyellow #:bold "Payments") (if (member-student? mr)
(ansi-string #:bgblue #:brightyellow #:bold "Balance")) "student"
(append (if (member-destroyed? mr)
(map "destroyed"
(lambda (mr) "active")))
(let* ((balance (member-balance mr)) ;; TODO: move let* below here and add fees, credit, payment and total
(fees (dict-ref balance 'fees)) )))))
(credit (dict-ref balance 'credit)) (print
(payment (dict-ref balance 'payment)) (table->string
(total (- (+ credit payment) fees))) (cons
(list (member-nick mr) (list (ansi-string #:bgblue #:brightyellow #:bold "Member")
(if (member-suspended? mr) (ansi-string #:bgblue #:brightyellow #:bold "Status")
"suspended" (ansi-string #:bgblue #:brightyellow #:bold "Fees")
(if (member-student? mr) (ansi-string #:bgblue #:brightyellow #:bold "Credit")
"student" (ansi-string #:bgblue #:brightyellow #:bold "Payments")
(if (member-destroyed? mr) (ansi-string #:bgblue #:brightyellow #:bold "Balance"))
"destroyed" (append
"active"))) (map
(sprintf "\t~A" fees) (lambda (mr)
(sprintf "\t~A" credit) (let* ((balance (member-balance mr))
(sprintf "\t~A" payment) (fees (dict-ref balance 'fees))
(sprintf "\t~A~A~A" (credit (dict-ref balance 'credit))
(if (< total -500) (payment (dict-ref balance 'payment))
a:error (total (- (+ credit payment) fees)))
(if (< total 0) (list (member-nick mr)
a:warning (if (member-suspended? mr)
a:success)) "suspended"
(exact->inexact total) (if (member-student? mr)
a:default) "student"
))) (if (member-destroyed? mr)
(sort MB member<?)) "destroyed"
(let* ((balances (map member-balance MB)) "active")))
(fees (foldl + 0 (map (lambda (b) (dict-ref b 'fees)) balances))) (sprintf "\t~A" fees)
(credit (foldl + 0 (map (lambda (b) (dict-ref b 'credit)) balances))) (sprintf "\t~A" credit)
(payment (foldl + 0 (map (lambda (b) (dict-ref b 'payment)) balances))) (sprintf "\t~A" payment)
(total (- (+ credit payment) fees))) (sprintf "\t~A~A~A"
(list (list (ansi-string #:bold "Total") (if (< total -500)
"" a:error
(ansi-string "\t" #:bold (sprintf "~A" fees)) (if (< total 0)
(ansi-string "\t" #:bold (sprintf "~A" credit)) a:warning
(ansi-string "\t" #:bold (sprintf "~A" payment)) a:success))
(ansi-string "\t" #:bold (exact->inexact total)
(sprintf "~A~A" a:default)
(if (< total 0) )))
a:error (sort MB member<?))
a:success) (let* ((fees (foldl + 0 (map (lambda (b) (dict-ref b 'fees)) balances)))
total)) (credit (foldl + 0 (map (lambda (b) (dict-ref b 'credit)) balances)))
))))) (payment (foldl + 0 (map (lambda (b) (dict-ref b 'payment)) balances)))
#:col-border #t #:row0-border #t #:ansi #t)) (total (- (+ credit payment) fees)))
(list (list (ansi-string #:bold "Total")
""
(ansi-string "\t" #:bold (sprintf "~A" fees))
(ansi-string "\t" #:bold (sprintf "~A" credit))
(ansi-string "\t" #:bold (sprintf "~A" payment))
(ansi-string "\t" #:bold
(sprintf "~A~A"
(if (< total 0)
a:error
a:success)
total))
)))))
#:col-border #t #:row0-border #t #:ansi #t))
)
) )
) )

View file

@ -41,7 +41,8 @@
(chicken file) (chicken file)
member-record member-record
utils utils
configuration) configuration
members-payments)
;; Generate all the files in specified (default current) directory. ;; Generate all the files in specified (default current) directory.
(define (gen-web-static-member mr . dirs) (define (gen-web-static-member mr . dirs)