Add boring members to notification email.
This commit is contained in:
parent
cafba67089
commit
70a49c0973
2 changed files with 45 additions and 7 deletions
|
@ -32,6 +32,8 @@
|
||||||
members-payments-process
|
members-payments-process
|
||||||
member-balance
|
member-balance
|
||||||
member-total-balance
|
member-total-balance
|
||||||
|
|
||||||
|
member-to-notify?
|
||||||
members-to-notify
|
members-to-notify
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -213,18 +215,25 @@
|
||||||
(else 0))))
|
(else 0))))
|
||||||
(brmember-payments mr))))
|
(brmember-payments mr))))
|
||||||
|
|
||||||
|
;; Returns true if given member should be notified in given number of months
|
||||||
|
(define (member-to-notify? mr . mmonths)
|
||||||
|
(let ((months (if (null? mmonths)
|
||||||
|
1
|
||||||
|
(car mmonths)))
|
||||||
|
(total (member-total-balance mr))
|
||||||
|
(fee (lookup-member-fee (if (brmember-student? mr)
|
||||||
|
'student
|
||||||
|
'regular))))
|
||||||
|
(and (brmember-active? mr)
|
||||||
|
(< total 0)
|
||||||
|
(< total (- (* months fee))))))
|
||||||
|
|
||||||
;; Return members to notify because of late payments for more than
|
;; Return members to notify because of late payments for more than
|
||||||
;; given number of months
|
;; given number of months
|
||||||
(define (members-to-notify mb months)
|
(define (members-to-notify mb months)
|
||||||
(find-members-by-predicate
|
(find-members-by-predicate
|
||||||
mb
|
mb
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
(let ((total (member-total-balance mr))
|
(member-to-notify? mb months))))
|
||||||
(fee (lookup-member-fee (if (brmember-student? mr)
|
|
||||||
'student
|
|
||||||
'regular))))
|
|
||||||
(and (brmember-active? mr)
|
|
||||||
(< total 0)
|
|
||||||
(< total (- (* months fee))))))))
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -168,10 +168,39 @@
|
||||||
debtors))
|
debtors))
|
||||||
#:border-style 'ascii
|
#:border-style 'ascii
|
||||||
#:col-border #t
|
#:col-border #t
|
||||||
|
#:row0-border #t))))
|
||||||
|
(boring (find-members-by-predicate mb (compose not member-to-notify?)))
|
||||||
|
(boring-lst
|
||||||
|
(if (null? boring)
|
||||||
|
'()
|
||||||
|
(append
|
||||||
|
(list ""
|
||||||
|
"Other active members:")
|
||||||
|
(table->list
|
||||||
|
(cons (list "Id" "Member" "Type" "Balance" "Last payment")
|
||||||
|
(map (lambda (mr)
|
||||||
|
(list (brmember-id mr)
|
||||||
|
(brmember-nick mr)
|
||||||
|
(if (brmember-student? mr)
|
||||||
|
'student
|
||||||
|
'normal)
|
||||||
|
(format "\t~A" (member-total-balance mr))
|
||||||
|
(let* ((payments (brmember-payments mr))
|
||||||
|
(tr (if (null? payments)
|
||||||
|
#f
|
||||||
|
(car (reverse payments)))))
|
||||||
|
(if tr
|
||||||
|
(bank-transaction-date tr)
|
||||||
|
"-"))
|
||||||
|
))
|
||||||
|
boring))
|
||||||
|
#:border-style 'ascii
|
||||||
|
#:col-border #t
|
||||||
#:row0-border #t)))))
|
#:row0-border #t)))))
|
||||||
(append income-lst
|
(append income-lst
|
||||||
unpaired-lst
|
unpaired-lst
|
||||||
debtors-lst
|
debtors-lst
|
||||||
|
boring-lst
|
||||||
(list ""
|
(list ""
|
||||||
"--"
|
"--"
|
||||||
"Brmlab Hackerspace Members Database"
|
"Brmlab Hackerspace Members Database"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue