All member record predicates.

member2-record.scm

@@ -30,12 +30,23 @@
  member2-record
  (
   make-member-record
+
   member-record-input-file
+
   member-record-set
   member-record-add-highlight
   member-record-sub-ref
   member-record-sub-set
   member-record-sub-prepend
+
+  member-record-info
+
+  member-destroyed?
+  member-suspended?
+  member-active?
+  member-student?
+  member-existing?
+
   member-record-tests!
   )
 
@@ -43,7 +54,10 @@
 	 (chicken base)
 	 (chicken keyword)
 	 dictionary
-	 testing)
+	 testing
+	 month
+	 period
+	 configuration)
 
  ;; Creates new member record based on the file and symlinks
  ;; information received from the members directory. Any keyword
@@ -109,6 +123,56 @@
 			  (cons val
 				(member-record-sub-ref mr sec key '()))))
 
+ ;; Returns member info key value
+ (define (member-record-info mr key . defaults)
+   (let ((info (dict-ref mr 'info)))
+     (if (null? defaults)
+	 (dict-ref info key)
+	 (dict-ref info key (car defaults)))))
+
+ ;; Returns true if the member record represents destroyed member. The
+ ;; *current-month* is a global parameter from period module.
+ (define (member-destroyed? mr)
+   (let ((destroyed (member-record-info mr 'destroyed #f)))
+     (and destroyed
+	  (month<? (string->month destroyed)
+		   (*current-month*)))))
+
+ ;; Generic period-based predicate
+ (define ((member-period-predicate? key) mr)
+   (let ((periods (member-record-info mr key #f)))
+     (and periods
+	  (month-in-periods? periods))))
+
+ ;; Returns true if the member is now suspended
+ (define member-is-suspended?
+   (member-period-predicate? 'suspend))
+
+ ;; Suspended must not be destroyed
+ (define (member-suspended? mr)
+   (and (member-is-suspended? mr)
+	(not (member-destroyed? mr))))
+
+ ;; 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)
+   (and (not (member-destroyed? mr))
+	(not (member-suspended? mr))))
+
+ ;; Returns true if the member has joined.
+ (define (member-existing? mr)
+   (let ((joined (member-record-info mr 'joined)))
+     (and joined
+	  (month<=? joined (*current-month*)))))
+
  ;; Self-tests
  (define (member-record-tests!)
    (run-tests