Work on predicates.
This commit is contained in:
parent
d183e658b1
commit
4b453162cf
2 changed files with 22 additions and 5 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue