Period matching.

This commit is contained in:
Dominik Pantůček 2023-03-19 20:29:11 +01:00
parent 1880239973
commit 7e171bbcef
2 changed files with 25 additions and 0 deletions

View file

@ -134,6 +134,17 @@
(map period->string ps)
", "))
;; Finds a period the month marthes and returns it. If no period
;; matches, it returns #f.
(define (periods-match ps . ml)
(let ((m (if (null? ml) (*current-month*) (car ml))))
(let loop ((ps ps))
(if (null? ps)
#f
(if (month-in-period? (car ps) m)
(car ps)
(loop (cdr ps)))))))
;; Performs self-tests of the period module.
(define (period-tests!)
(run-tests
@ -184,6 +195,13 @@
(periods->string '(((2022 1) . (2022 4))
((2022 12). (2023 2))))
"2022-01..2022-04, 2022-12..2023-02")
(test-false periods-match (periods-match '(((2022 1) . (2022 4))
((2022 12). (2023 2)))
'(2022 5)))
(test-equal? periods-match (periods-match '(((2022 1) . (2022 4))
((2022 12). (2023 2)))
'(2022 2))
'((2022 1) . (2022 4)))
))
)