Period matching.
This commit is contained in:
parent
1880239973
commit
7e171bbcef
2 changed files with 25 additions and 0 deletions
18
period.scm
18
period.scm
|
@ -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)))
|
||||
))
|
||||
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue