brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Start fees table rework using new primitives.

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

129
src/members-print.scm
View file

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