From 1551ea15e6d4910cf2529610a8d641f9b129d955 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 8 Apr 2023 21:53:48 +0200 Subject: [PATCH] Prepare for notifications. --- src/bbstool.scm | 13 +++++++++++-- src/members-payments.scm | 13 +++++++++++++ src/util-list.scm | 6 +++--- 3 files changed, 27 insertions(+), 5 deletions(-) diff --git a/src/bbstool.scm b/src/bbstool.scm index dae3fc8..a36c735 100644 --- a/src/bbstool.scm +++ b/src/bbstool.scm @@ -32,7 +32,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. month period command-line - utils + util-list ansi members-base primes @@ -70,6 +70,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (define -jendasap-checked- (make-parameter "checked.ntlm")) (define -ml-all- (make-parameter #f)) (define -show-destroyed- (make-parameter #f)) +(define -notify-months- (make-parameter 1)) ;; Arguments parsing (command-line @@ -144,6 +145,12 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (-action- 'mlcheck)) (-mlsync () "Synchronize internal ML" (-action- 'mlsync)) + (-notify () "Members with debt for more than 1 month" + (-notify-months- 1) + (-action- 'notify)) + (-notify3 () "Members with debt for more than 3 month" + (-notify-months- 3) + (-action- 'notify)) ) ;; Run tests @@ -152,7 +159,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (dictionary-tests!) (month-tests!) (period-tests!) - (utils-tests!) + (util-list-tests!) (ansi-tests!) (command-line-tests!) (members-dir-tests!) @@ -297,6 +304,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (print " Missing: " missing)) (when (not (null? surplus)) (print " Outsiders: " surplus)))))) + ((notify) + (print "Notify" (-notify-months-))) (else (print "Nothing to do.")) diff --git a/src/members-payments.scm b/src/members-payments.scm index 0544230..a35a73f 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -32,6 +32,7 @@ members-payments-process member-balance member-total-balance + members-to-notify ) (import scheme @@ -211,5 +212,17 @@ (else 0)))) (member-payments mr)))) + ;; Return members to notify because of late payments for more than + ;; given number of months + (define (members-to-notify mb months) + (filter-members-by-predicate + mb + (lambda (mr) + (let ((total (member-total-balance mr)) + (fee (lookup-member-fee (if (member-student? mr) + 'student + 'regular)))) + (and (< total 0) + (< total (- (* months fee)))))))) ) diff --git a/src/util-list.scm b/src/util-list.scm index 8a2c7a6..e6c2393 100644 --- a/src/util-list.scm +++ b/src/util-list.scm @@ -29,7 +29,7 @@ util-list ( filter - utils-tests! + util-list-tests! ) (import scheme @@ -51,9 +51,9 @@ res))))) ;; Performs utils module self-tests. - (define (utils-tests!) + (define (util-list-tests!) (run-tests - utils + util-list (test-equal? filter (filter odd? '(1 2 3 4)) '(1 3)) (test-equal? filter (filter odd? '(2 4)) '()) ))