Start fees table rework using new primitives.
This commit is contained in:
parent
ea9c76d2fc
commit
f2e47b9ad3
5 changed files with 101 additions and 88 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue