From 4b453162cfaa8beef33af4a9a06581b582927358 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sun, 19 Mar 2023 07:24:45 +0100
Subject: [PATCH] Work on predicates.

---
 member-record.scm | 22 ++++++++++++++++++----
 members-base.scm  |  5 ++++-
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/member-record.scm b/member-record.scm
index 0fe41bd..6d6ab47 100644
--- a/member-record.scm
+++ b/member-record.scm
@@ -33,6 +33,7 @@
   member-destroyed?
   member-suspended?
   member-active?
+  member-student?
   member-nick
   member-record-tests!
   )
@@ -90,11 +91,24 @@
 	  (month<? (string->month destroyed)
 		   (*current-month*)))))
 
+ ;; Generic period-based predicate
+ (define ((member-period-predicate? key) mr)
+   (let ((periods (mr-ref mr key #f)))
+     (and periods
+	  (month-in-periods? periods))))
+
  ;; Returns true if the member is now suspended
- (define (member-suspended? mr)
-   (let ((suspend (mr-ref mr 'suspend #f)))
-     (and suspend
-	  (month-in-periods? suspend))))
+ (define member-suspended?
+   (member-period-predicate? 'suspend))
+
+ ;; True if the member is student
+ (define member-is-student?
+   (member-period-predicate? 'student))
+
+ ;; Only active members can be students.
+ (define (member-student? mr)
+   (and (member-active? mr)
+	(member-is-student? mr)))
 
  ;; Returns true if the member is active (not suspended or destroyed).
  (define (member-active? mr)
diff --git a/members-base.scm b/members-base.scm
index 3e28b3b..f1e40fa 100644
--- a/members-base.scm
+++ b/members-base.scm
@@ -264,11 +264,14 @@
     (let ((invalid-ids (filter (compose not is-4digit-prime?) ids))
 	  (active-mrs (filter-members-by-predicate mb member-active?))
 	  (suspended-mrs (filter-members-by-predicate mb member-suspended?))
-	  (destroyed-mrs (filter-members-by-predicate mb member-suspended?)))
+	  (destroyed-mrs (filter-members-by-predicate mb member-destroyed?))
+	  (student-mrs (filter-members-by-predicate mb member-student?)))
       (print "  Active (" (length active-mrs) "): "
 	     (member-records->nicks-string active-mrs))
       (print "  Suspended (" (length suspended-mrs) "): "
 	     (member-records->nicks-string suspended-mrs))
+      (print "  Students (" (length student-mrs) "): "
+	     (member-records->nicks-string student-mrs))
       (when (not (null? invalid-ids))
 	(print "  Invalid (" (length invalid-ids) "): "
 	       (string-intersperse