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

Show destroyed only when requested in fees.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-07 23:36:12 +02:00
parent b00139bd89
commit 6a597d71c8
2 changed files with 113 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/bbstool.scm
View file

@ -69,6 +69,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(define -normal-month- (make-parameter #t))
(define -jendasap-checked- (make-parameter "checked.ntlm"))
(define -ml-all- (make-parameter #f))
(define -show-destroyed- (make-parameter #f))
;; Arguments parsing
(command-line
@ -98,6 +99,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(-jendasap-checked- file))
(-ml-all () "Load all mailman lists"
(-ml-all- #t))
(-destroyed () "Show destroyed members in -fees"
(-show-destroyed- #t))
""
"Query options:"
(-mi (id) "Specify member by id" (-member-id- (string->number id)))
@ -262,7 +265,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(print "No problems found."))))
((fees)
(newline)
(print-members-fees-table MB))
(print-members-fees-table MB (-show-destroyed-)))
((repl)
(repl))
((genweb)

206
src/members-print.scm
View file

@ -337,103 +337,115 @@
")"))))
;; Prints summary table of all fees and credits for all members
(define (print-members-fees-table MB)
(let ((balances (map member-balance (members-base-members MB)))
(members ;; Pass 1
(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)))
fees
credit
payment
total
)))
(sort (members-base-members MB) member<?))))
(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 ;; Pass 2
(lambda (member)
(let ((total (list-ref member 5)))
(list (list-ref member 0)
(list-ref member 1)
(sprintf "\t~A" (list-ref member 2))
(sprintf "\t~A" (list-ref member 3))
(sprintf "\t~A" (list-ref member 4))
(sprintf "\t~A~A~A"
(if (< total -500)
a:error
(if (< total 0)
a:warning
a:success))
(exact->inexact total)
a:default)
)))
members)
(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))
(print "Credit: "
(foldl + 0
(map (lambda (member)
(list-ref member 5))
members)))
(print "Advance: "
(foldl + 0
(map (lambda (member)
(max 0 (list-ref member 5)))
members)))
(print "Debt: "
(foldl + 0
(map (lambda (member)
(min 0 (list-ref member 5)))
members)))
(let* ((ns (foldl (lambda (acc member)
(cons (+ (car acc) (if (eq? 'student (cadr member)) 1 0))
(+ (cdr acc) (if (eq? 'active (cadr member)) 1 0))))
(cons 0 0)
members))
(students (car ns))
(full (cdr ns)))
(print "Expected income: "
(+ (* (lookup-member-fee 'normal) full)
(* (lookup-member-fee 'student) students))
" (" full " full members + " students " students)"))
)
)
(define (print-members-fees-table MB . ds)
(let ((destroyed? (if (null? ds)
#f
(car ds))))
(let* ((members ;; Pass 1
(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)))
fees
credit
payment
total
balance
)))
(sort
(if destroyed?
(members-base-members MB)
(filter (lambda (mr)
(not (member-destroyed? mr)))
(members-base-members MB)))
member<?)))
(balances (map (lambda (m)
(list-ref m 6))
members)))
(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 ;; Pass 2
(lambda (member)
(let ((total (list-ref member 5)))
(list (list-ref member 0)
(list-ref member 1)
(sprintf "\t~A" (list-ref member 2))
(sprintf "\t~A" (list-ref member 3))
(sprintf "\t~A" (list-ref member 4))
(sprintf "\t~A~A~A"
(if (< total -500)
a:error
(if (< total 0)
a:warning
a:success))
(exact->inexact total)
a:default)
)))
members)
(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))
(print "Credit: "
(foldl + 0
(map (lambda (member)
(list-ref member 5))
members)))
(print "Advance: "
(foldl + 0
(map (lambda (member)
(max 0 (list-ref member 5)))
members)))
(print "Debt: "
(foldl + 0
(map (lambda (member)
(min 0 (list-ref member 5)))
members)))
(let* ((ns (foldl (lambda (acc member)
(cons (+ (car acc) (if (eq? 'student (cadr member)) 1 0))
(+ (cdr acc) (if (eq? 'active (cadr member)) 1 0))))
(cons 0 0)
members))
(students (car ns))
(full (cdr ns)))
(print "Expected income: "
(+ (* (lookup-member-fee 'normal) full)
(* (lookup-member-fee 'student) students))
" (" full " full members + " students " students)"))
)
))
;; Prints all transactions which the members base considers unpaired.
(define (print-unpaired-table mb)