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

Finish periods implementation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-11 17:10:01 +01:00
parent d8676ebc1c
commit 6226a7bd1c
1 changed files with 37 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

44
brmsaptool.scm
View file

@ -28,6 +28,8 @@
(chicken string)
(chicken format)
(chicken sort)
(chicken time)
(chicken time posix)
(chicken process-context))
@ -35,6 +37,11 @@
;; Static default configuration
(define *members-directory* (make-parameter "members"))
(define *current-month*
(make-parameter
(let ((d (seconds->local-time (current-seconds))))
(list (vector-ref d 5)
(vector-ref d 4)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Testing
@ -251,11 +258,17 @@
(cdr m)))
(error 'period-markers->periods "Invalid start/stop sequence marker" m))))))
(define (period-duration p)
1)
;; Returns duration of period in months. Start is included, end is
;; not. The period contains the month just before the specified end.
(define (period->duration p)
(let* ((b (car p))
(e (cdr p))
(e- (if e e (*current-month*))))
(month-diff b e-)))
;; Returns sum of periods lengths.
(define (periods-duration l)
1)
(apply + (map period->duration l)))
(define (period-tests!)
(display "[test] period ")
@ -263,14 +276,25 @@
(equal? (sort-period-markers '((start 2023 1) (stop 2022 10) (start 2022 3)))
'((start 2022 3) (stop 2022 10) (start 2023 1))))
(unit-test 'period-markers->periods
(equal? (period-markers->periods '((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4)))
(equal? (period-markers->periods
'((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4)))
'(((2022 3) . (2022 10))
((2023 1) . (2023 4)))))
(unit-test 'period-markers->periods-open
(equal? (period-markers->periods '((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4) (start 2023 5)))
(equal? (period-markers->periods
'((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4) (start 2023 5)))
'(((2022 3) . (2022 10))
((2023 1) . (2023 4))
((2023 5) . #f))))
(unit-test 'period-duration
(eq? (period->duration '((2023 1) . (2023 4))) 3))
(parameterize ((*current-month* (list 2023 4)))
(unit-test 'period-duration
(eq? (period->duration '((2023 1) . #f)) 3)))
(unit-test 'periods-duration
(eq? (periods-duration '(((2022 3) . (2022 10))
((2023 1) . (2023 4))))
10))
(print " ok."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -352,8 +376,14 @@
(let loop ((ls ls)
(r (make-dict)))
(if (null? ls)
(let* ((r1 (dict-set r 'suspend (sort-period-markers (dict-ref r 'suspend '()))))
(r2 (dict-set r1 'student (sort-period-markers (dict-ref r1 'student '())))))
(let* ((r1 (dict-set r 'suspend
(period-markers->periods
(sort-period-markers
(dict-ref r 'suspend '())))))
(r2 (dict-set r1 'student
(period-markers->periods
(sort-period-markers
(dict-ref r1 'student '()))))))
r2)
(let ((p (parse-member-line (car ls))))
(loop (cdr ls)