From 6c8d2c8dbd786ccb9665d2b0d040407b8c38fdf4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Mon, 27 Mar 2023 20:52:04 +0200
Subject: [PATCH] Create member calendar.

---
 MODULES.md        | 10 ++++++----
 Makefile          |  6 +++---
 member-fees.scm   | 27 +++++++++++++++++++++++----
 member-record.scm | 13 ++++++++++++-
 month.scm         | 10 +++++++---
 5 files changed, 51 insertions(+), 15 deletions(-)

diff --git a/MODULES.md b/MODULES.md
index 5247d80..4fdd3f2 100644
--- a/MODULES.md
+++ b/MODULES.md
@@ -58,10 +58,12 @@ is substituted as a default.
 Determines how many months the member can be suspended before any
 action is required.
 
-### Member File
-
 ### Member Record
 
+### Member Parser
+
+### Member Info Printer
+
 ### Member Base
 
 ### Cards
@@ -156,10 +158,10 @@ Returns the difference in months from month ```f``` to month
 ```t```. If both months are the same, the result is zero. If ```t```
 is before ```f```, the result is negative.
 
-    (month-add m n)
+    (month-add m [n])
 
 * ```m``` - valid month
-* ```n``` - an integer
+* ```n``` - an integer, defaults to 1
 
 Returns a new valid month that comes ```n``` months after ```m```. If
 ```n``` is negative, it correctly subtracts the months.
diff --git a/Makefile b/Makefile
index 8b7bc25..26b648d 100644
--- a/Makefile
+++ b/Makefile
@@ -155,9 +155,9 @@ primes.so: primes.o
 primes.o: primes.import.scm
 primes.import.scm: $(PRIMES-SOURCES)
 
-MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm	\
-	period.import.scm testing.import.scm month.import.scm	\
-	configuration.import.scm primes.import.scm
+MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm		\
+	period.import.scm testing.import.scm month.import.scm		\
+	configuration.import.scm primes.import.scm utils.import.scm
 
 member-record.so: member-record.o
 member-record.o: member-record.import.scm
diff --git a/member-fees.scm b/member-fees.scm
index 5157d0c..fa09982 100644
--- a/member-fees.scm
+++ b/member-fees.scm
@@ -28,14 +28,33 @@
 (module
  member-fees
  (
-  member-calender
+  member-calendar
   member-calendar->fees
   )
 
- (import scheme)
+ (import scheme
+	 (chicken base)
+	 configuration
+	 member-record
+	 month)
 
- (define (member-calendar mr)
-   #f)
+ ;; Returns a list of months where each month is a list containing:
+ ;; * month (from month module)
+ ;; * flags - a list of symbols: student, suspended, destroyed
+ ;; The list contains all months from 'joined until (*current-month*).
+ (define (member-calendar mr . args)
+   (let ((last-month (if (null? args)
+			 (*current-month*)
+			 (car args))))
+     (let loop ((cm (member-record-info mr 'joined))
+		(cal '()))
+       (if (month>? cm last-month)
+	   (reverse cal)
+	   (loop (month-add cm)
+		 (cons (list cm
+			     (parameterize ((*current-month* cm))
+			       (member-flags mr)))
+		       cal))))))
 
  (define (member-calendar->fees mr)
    #f)
diff --git a/member-record.scm b/member-record.scm
index 50a1352..9acb139 100644
--- a/member-record.scm
+++ b/member-record.scm
@@ -51,6 +51,7 @@
   member-active?
   member-student?
   member-existing?
+  member-flags
 
   member-nick
   member-id
@@ -74,7 +75,8 @@
 	 month
 	 period
 	 configuration
-	 primes)
+	 primes
+	 utils)
 
  ;; Checks whether given string is a 4-digit decimal number.
  (define (is-4digit-string? s)
@@ -249,6 +251,15 @@
      (and joined
 	  (month<=? joined (*current-month*)))))
 
+ ;; Returns a list of flags of given member record.
+ (define (member-flags mr)
+   (filter identity
+	   (list (if (member-student? mr) 'student #f)
+		 (if (member-suspended? mr) 'suspended #f)
+		 (if (member-active? mr) 'active #f)
+		 (if (member-destroyed? mr) 'destroyed #f)
+		 (if (member-existing? mr) 'existing #f))))
+
  ;; Nickname as string
  (define (member-nick mr)
    (member-record-info mr 'nick))
diff --git a/month.scm b/month.scm
index 4130c6a..04b8e23 100644
--- a/month.scm
+++ b/month.scm
@@ -137,9 +137,13 @@
 	   (error 'month-diff "Second argument is not a valid month" t))
        (error 'month-diff "First argument is not a valid month" f)))
 
- ;; Returns a month n months after the month m.
- (define (month-add m n)
-   (let ((mi (+ (* 12 (car m)) (cadr m) n -1)))
+ ;; Returns a month n months after the month m. The number n defaults
+ ;; to 1.
+ (define (month-add m . ns)
+   (let* ((n (if (null? ns)
+		 1
+		 (car ns)))
+	  (mi (+ (* 12 (car m)) (cadr m) n -1)))
      (list (quotient mi 12)
 	   (+ (remainder mi 12) 1))))