brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Start using new period representation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-27 17:23:12 +02:00
parent ae0c00da50
commit d2ad2fdebb
1 changed files with 13 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

26
period.scm
View file

@ -79,7 +79,7 @@
(if (null? l) (if (null? l)
(list #t (list #t
(if cb (if cb
(reverse (cons (cons cb #f) ps)) (reverse (cons (make-period cb #f) ps))
(reverse ps)) (reverse ps))
"" ""
-1) -1)
@ -97,7 +97,7 @@
(if (eq? mtype rmt) (if (eq? mtype rmt)
(if cb (if cb
(loop (cdr l) (loop (cdr l)
(cons (cons cb month) ps) (cons (make-period cb month) ps)
#f) #f)
(loop (cdr l) (loop (cdr l)
ps ps
@ -110,8 +110,8 @@
;; Returns duration of period in months. Start is included, end is ;; Returns duration of period in months. Start is included, end is
;; not. The period contains the month just before the specified end. ;; not. The period contains the month just before the specified end.
(define (period->duration p) (define (period->duration p)
(let* ((b (car p)) (let* ((b (period-since p))
(e (cdr p)) (e (period-before p))
(e- (if e e (*current-month*)))) (e- (if e e (*current-month*))))
(month-diff b e-))) (month-diff b e-)))
@ -176,27 +176,27 @@
(period-markers->periods (period-markers->periods
'((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)))) '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4))))
'(#t '(#t
(((2022 3) . (2022 10)) (((2022 3) (2022 10) #f #f)
((2023 1) . (2023 4))) ((2023 1) (2023 4) #f #f))
"" ""
-1)) -1))
(test-equal? period-markers->periods-open (test-equal? period-markers->periods-open
(period-markers->periods (period-markers->periods
'((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)) (start (2023 5)))) '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)) (start (2023 5))))
'(#t '(#t
(((2022 3) . (2022 10)) (((2022 3) (2022 10) #f #f)
((2023 1) . (2023 4)) ((2023 1) (2023 4) #f #f)
((2023 5) . #f)) ((2023 5) #f #f #f))
"" ""
-1)) -1))
(test-eq? period-duration (test-eq? period-duration
(period->duration '((2023 1) . (2023 4))) 3) (period->duration '((2023 1) (2023 4) #f #f)) 3)
(parameterize ((*current-month* (list 2023 4))) (parameterize ((*current-month* (list 2023 4)))
(test-eq? period-duration (test-eq? period-duration
(period->duration '((2023 1) . #f)) 3)) (period->duration '((2023 1) #f #f #f)) 3))
(test-eq? periods-duration (test-eq? periods-duration
(periods-duration '(((2022 3) . (2022 10)) (periods-duration '(((2022 3) (2022 10) #f #f)
((2023 1) . (2023 4)))) ((2023 1) (2023 4) #f #f)))
10) 10)
(test-true month-in-period? (test-true month-in-period?
(month-in-period? '((2022 1) . (2022 4)) '(2022 3))) (month-in-period? '((2022 1) . (2022 4)) '(2022 3)))