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)

22
src/members-print.scm
View file

@ -337,9 +337,11 @@
")")))) ")"))))
;; 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
(car ds))))
(let* ((members ;; Pass 1
(map (map
(lambda (mr) (lambda (mr)
(let* ((balance (member-balance mr)) (let* ((balance (member-balance mr))
@ -359,8 +361,18 @@
credit credit
payment payment
total total
balance
))) )))
(sort (members-base-members MB) member<?)))) (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 (print
(table->string (table->string
(cons (cons
@ -433,7 +445,7 @@
(* (lookup-member-fee 'student) students)) (* (lookup-member-fee 'student) students))
" (" full " full members + " students " 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)