Filter brmember-credit properly.

This commit is contained in:
Dominik Pantůček 2023-05-13 09:45:48 +02:00
parent d5ac70b95a
commit f7166475d7
3 changed files with 16 additions and 10 deletions

View file

@ -70,6 +70,8 @@
brmember-add-payment brmember-add-payment
brmember-payments brmember-payments
brmember-credit
brmember-mailman brmember-mailman
brmember-add-mailman brmember-add-mailman
@ -357,6 +359,18 @@
(cal-month<=? month (*current-month*)))) (cal-month<=? month (*current-month*))))
(ldict-ref mr 'payments '()))) (ldict-ref mr 'payments '())))
;; Returns credit records - respects *current-month*
(define (brmember-credit mr)
(filter (lambda (cr)
(let* ((cmon (cadr cr))
(mon (if cmon
(cal-ensure-month cmon)
#f)))
(if mon
(cal-month<=? mon (*current-month*))
#t)))
(brmember-info mr 'credit '())))
;; Returns a list of MLs this member is subscribed to ;; Returns a list of MLs this member is subscribed to
(define (brmember-mailman mr) (define (brmember-mailman mr)
(ldict-ref mr 'mailman '())) (ldict-ref mr 'mailman '()))

View file

@ -163,15 +163,7 @@
;; Total credit manually recorded in member record ;; Total credit manually recorded in member record
(define (member-credit-total mr) (define (member-credit-total mr)
(let* ((credit (filter (lambda (cr) (let* ((credit (brmember-credit mr))
(let* ((cmon (cadr cr))
(mon (if cmon
(cal-ensure-month cmon)
#f)))
(if mon
(cal-month<=? mon (*current-month*))
#t)))
(brmember-info mr 'credit '())))
(amounts (map car credit))) (amounts (map car credit)))
(foldl + 0 amounts))) (foldl + 0 amounts)))

View file

@ -103,7 +103,7 @@
(list (car c) (list (car c)
(cal-format (cadr c)) (cal-format (cadr c))
(caddr c))) (caddr c)))
v) (brmember-credit mr))
#:col-border #t))) #:col-border #t)))
((suspend student member) ((suspend student member)
(list k (list k