From 6226a7bd1cdb40633ce7beee32fbfad91fd83d50 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sat, 11 Mar 2023 17:10:01 +0100
Subject: [PATCH] Finish periods implementation.

---
 brmsaptool.scm | 44 +++++++++++++++++++++++++++++++++++++-------
 1 file changed, 37 insertions(+), 7 deletions(-)

diff --git a/brmsaptool.scm b/brmsaptool.scm
index 1817811..c22e373 100644
--- a/brmsaptool.scm
+++ b/brmsaptool.scm
@@ -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)