Work on periods.
This commit is contained in:
parent
6260ff2f24
commit
20743d68e5
1 changed files with 49 additions and 0 deletions
|
@ -269,6 +269,22 @@
|
||||||
(define (periods-duration l)
|
(define (periods-duration l)
|
||||||
(apply + (map period->duration l)))
|
(apply + (map period->duration l)))
|
||||||
|
|
||||||
|
;; True if month belongs to given month period - start inclusive, end
|
||||||
|
;; exclusive.
|
||||||
|
(define (month-in-period? p m)
|
||||||
|
(and (month<? m (cdr p))
|
||||||
|
(not (month<? m (car p)))))
|
||||||
|
|
||||||
|
;; Returns true if given month is in at least one of the periods
|
||||||
|
;; given.
|
||||||
|
(define (month-in-periods? ps m)
|
||||||
|
(let loop ((ps ps))
|
||||||
|
(if (null? ps)
|
||||||
|
#f
|
||||||
|
(if (month-in-period? (car ps) m)
|
||||||
|
#t
|
||||||
|
(loop (cdr ps))))))
|
||||||
|
|
||||||
(define (period-tests!)
|
(define (period-tests!)
|
||||||
(display "[test] period ")
|
(display "[test] period ")
|
||||||
(unit-test 'sort-period-markers
|
(unit-test 'sort-period-markers
|
||||||
|
@ -294,6 +310,22 @@
|
||||||
(eq? (periods-duration '(((2022 3) . (2022 10))
|
(eq? (periods-duration '(((2022 3) . (2022 10))
|
||||||
((2023 1) . (2023 4))))
|
((2023 1) . (2023 4))))
|
||||||
10))
|
10))
|
||||||
|
(unit-test 'month-in-period?
|
||||||
|
(month-in-period? '((2022 1) . (2022 4)) '(2022 3)))
|
||||||
|
(unit-test 'month-in-period?-not
|
||||||
|
(not (month-in-period? '((2022 1) . (2022 4)) '(2022 5))))
|
||||||
|
(unit-test 'month-in-periods?
|
||||||
|
(month-in-periods? '(((2022 1) . (2022 4))
|
||||||
|
((2023 5) . (2023 10)))
|
||||||
|
'(2022 3)))
|
||||||
|
(unit-test 'month-in-periods?2
|
||||||
|
(month-in-periods? '(((2022 1) . (2022 4))
|
||||||
|
((2023 5) . (2023 10)))
|
||||||
|
'(2023 7)))
|
||||||
|
(unit-test 'month-in-periods?-not
|
||||||
|
(not (month-in-periods? '(((2022 1) . (2022 4))
|
||||||
|
((2023 5) . (2023 10)))
|
||||||
|
'(2022 10))))
|
||||||
(print " ok."))
|
(print " ok."))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -490,6 +522,23 @@
|
||||||
(define (list-members-nicks mdb)
|
(define (list-members-nicks mdb)
|
||||||
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mdb))
|
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mdb))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Member predicates
|
||||||
|
|
||||||
|
(define (member-suspended? mr)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (member-student? mr)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (member-destroyed? mr)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
;; Returns true if the member is neither suspended nor destroyed
|
||||||
|
(define (member-active? mr)
|
||||||
|
(not (or (member-suspended? mr)
|
||||||
|
(member-destroyed? mr))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Command-line parsing
|
;; Command-line parsing
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue