Regular predicates.
This commit is contained in:
parent
bf2b8ef23a
commit
4bd6837e08
6 changed files with 51 additions and 51 deletions
|
@ -50,12 +50,12 @@
|
|||
brmember-usable?
|
||||
brmember-has-problems?
|
||||
|
||||
member-destroyed?
|
||||
member-suspended?
|
||||
member-active?
|
||||
member-student?
|
||||
member-existing?
|
||||
member-flags
|
||||
brmember-destroyed?
|
||||
brmember-suspended?
|
||||
brmember-active?
|
||||
brmember-student?
|
||||
brmember-existing?
|
||||
brmember-flags
|
||||
|
||||
member-nick
|
||||
member-id
|
||||
|
@ -250,8 +250,8 @@
|
|||
;; Returns true if the member record represents non-existing
|
||||
;; member. The *current-month* is a global parameter from period
|
||||
;; module.
|
||||
(define (member-destroyed? mr)
|
||||
(and (not (member-existing? mr))
|
||||
(define (brmember-destroyed? mr)
|
||||
(and (not (brmember-existing? mr))
|
||||
(let ((member (brmember-info mr 'member)))
|
||||
(if (null? member)
|
||||
#f
|
||||
|
@ -269,37 +269,37 @@
|
|||
(member-period-predicate? 'suspend))
|
||||
|
||||
;; Suspended must not be destroyed
|
||||
(define (member-suspended? mr)
|
||||
(define (brmember-suspended? mr)
|
||||
(and (member-is-suspended? mr)
|
||||
(not (member-destroyed? mr))))
|
||||
(not (brmember-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)
|
||||
(define (brmember-student? mr)
|
||||
(and (brmember-active? mr)
|
||||
(member-is-student? mr)))
|
||||
|
||||
;; Returns true if the member is active (not suspended or destroyed).
|
||||
(define (member-active? mr)
|
||||
(define (brmember-active? mr)
|
||||
(and (month-in-periods? (brmember-info mr 'member))
|
||||
(not (member-suspended? mr))))
|
||||
(not (brmember-suspended? mr))))
|
||||
|
||||
;; Returns true if the member is currently a member
|
||||
(define (member-existing? mr)
|
||||
(define (brmember-existing? mr)
|
||||
(month-in-periods?
|
||||
(brmember-info mr 'member)))
|
||||
|
||||
;; Returns a list of flags of given member record.
|
||||
(define (member-flags mr)
|
||||
(define (brmember-flags mr)
|
||||
(filter identity
|
||||
(list (if (member-student? mr) 'student #f)
|
||||
(if (member-suspended? mr) 'suspended #f)
|
||||
(if (member-active? mr) 'active #f)
|
||||
(if (member-destroyed? mr) 'destroyed #f)
|
||||
(if (member-existing? mr) 'existing #f))))
|
||||
(list (if (brmember-student? mr) 'student #f)
|
||||
(if (brmember-suspended? mr) 'suspended #f)
|
||||
(if (brmember-active? mr) 'active #f)
|
||||
(if (brmember-destroyed? mr) 'destroyed #f)
|
||||
(if (brmember-existing? mr) 'existing #f))))
|
||||
|
||||
;; Nickname as string
|
||||
(define (member-nick mr)
|
||||
|
@ -312,7 +312,7 @@
|
|||
;; Returns the number of months the user is suspended. Zero if not
|
||||
;; suspended.
|
||||
(define (member-suspended-months mr)
|
||||
(if (member-suspended? mr)
|
||||
(if (brmember-suspended? mr)
|
||||
(let ((period (periods-match (brmember-info mr 'suspend))))
|
||||
(if period
|
||||
(month-diff (car period) (*current-month*))
|
||||
|
@ -379,41 +379,41 @@
|
|||
(brmember-add-highlight (make-ldict) 123 "Interesting..." 0 'info)
|
||||
(make-ldict
|
||||
'((highlights . ((123 "Interesting..." 0 info)))))))
|
||||
(test-true member-destroyed?
|
||||
(test-true brmember-destroyed?
|
||||
(parameterize ((*current-month* (list 2023 2)))
|
||||
(member-destroyed?
|
||||
(brmember-destroyed?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2010 1) (2010 5))))))))))))
|
||||
(test-false member-destroyed?
|
||||
(test-false brmember-destroyed?
|
||||
(parameterize ((*current-month* (list 2009 2)))
|
||||
(member-destroyed?
|
||||
(brmember-destroyed?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2001 1) (2010 5))))))))))))
|
||||
(test-false member-suspended?
|
||||
(member-suspended?
|
||||
(test-false brmember-suspended?
|
||||
(brmember-suspended?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2015 1) #f))))))))))
|
||||
(test-true member-suspended?
|
||||
(test-true brmember-suspended?
|
||||
(parameterize ((*current-month* (list 2015 2)))
|
||||
(member-suspended?
|
||||
(brmember-suspended?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2015 1) #f)))
|
||||
(suspend ((2010 1) (2022 4) #f #f))))))))))
|
||||
(test-true member-suspended?
|
||||
(test-true brmember-suspended?
|
||||
(parameterize ((*current-month* (list 2015 2)))
|
||||
(member-suspended?
|
||||
(brmember-suspended?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2015 1) #f)))
|
||||
(suspend ((2010 1) #f #f #f))))))))))
|
||||
(test-false member-suspended?
|
||||
(test-false brmember-suspended?
|
||||
(parameterize ((*current-month* (list 2023 2)))
|
||||
(member-suspended?
|
||||
(brmember-suspended?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2015 1) #f)))
|
||||
(suspend ((2010 1) (2022 4) #f #f))))))))))
|
||||
(test-true member-active?
|
||||
(test-true brmember-active?
|
||||
(parameterize ((*current-month* (list 2023 2)))
|
||||
(member-active?
|
||||
(brmember-active?
|
||||
(make-ldict `((info . ,(make-ldict
|
||||
`((member . (((2015 1) #f)))
|
||||
(suspend ((2010 1) (2022 4) #f #f))))))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue