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

206
src/members-print.scm
View file

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