Create member calendar.
This commit is contained in:
parent
a729d2f991
commit
6c8d2c8dbd
5 changed files with 51 additions and 15 deletions
10
MODULES.md
10
MODULES.md
|
@ -58,10 +58,12 @@ is substituted as a default.
|
||||||
Determines how many months the member can be suspended before any
|
Determines how many months the member can be suspended before any
|
||||||
action is required.
|
action is required.
|
||||||
|
|
||||||
### Member File
|
|
||||||
|
|
||||||
### Member Record
|
### Member Record
|
||||||
|
|
||||||
|
### Member Parser
|
||||||
|
|
||||||
|
### Member Info Printer
|
||||||
|
|
||||||
### Member Base
|
### Member Base
|
||||||
|
|
||||||
### Cards
|
### 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```
|
```t```. If both months are the same, the result is zero. If ```t```
|
||||||
is before ```f```, the result is negative.
|
is before ```f```, the result is negative.
|
||||||
|
|
||||||
(month-add m n)
|
(month-add m [n])
|
||||||
|
|
||||||
* ```m``` - valid month
|
* ```m``` - valid month
|
||||||
* ```n``` - an integer
|
* ```n``` - an integer, defaults to 1
|
||||||
|
|
||||||
Returns a new valid month that comes ```n``` months after ```m```. If
|
Returns a new valid month that comes ```n``` months after ```m```. If
|
||||||
```n``` is negative, it correctly subtracts the months.
|
```n``` is negative, it correctly subtracts the months.
|
||||||
|
|
2
Makefile
2
Makefile
|
@ -157,7 +157,7 @@ primes.import.scm: $(PRIMES-SOURCES)
|
||||||
|
|
||||||
MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm \
|
MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm \
|
||||||
period.import.scm testing.import.scm month.import.scm \
|
period.import.scm testing.import.scm month.import.scm \
|
||||||
configuration.import.scm primes.import.scm
|
configuration.import.scm primes.import.scm utils.import.scm
|
||||||
|
|
||||||
member-record.so: member-record.o
|
member-record.so: member-record.o
|
||||||
member-record.o: member-record.import.scm
|
member-record.o: member-record.import.scm
|
||||||
|
|
|
@ -28,14 +28,33 @@
|
||||||
(module
|
(module
|
||||||
member-fees
|
member-fees
|
||||||
(
|
(
|
||||||
member-calender
|
member-calendar
|
||||||
member-calendar->fees
|
member-calendar->fees
|
||||||
)
|
)
|
||||||
|
|
||||||
(import scheme)
|
(import scheme
|
||||||
|
(chicken base)
|
||||||
|
configuration
|
||||||
|
member-record
|
||||||
|
month)
|
||||||
|
|
||||||
(define (member-calendar mr)
|
;; Returns a list of months where each month is a list containing:
|
||||||
#f)
|
;; * 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)
|
(define (member-calendar->fees mr)
|
||||||
#f)
|
#f)
|
||||||
|
|
|
@ -51,6 +51,7 @@
|
||||||
member-active?
|
member-active?
|
||||||
member-student?
|
member-student?
|
||||||
member-existing?
|
member-existing?
|
||||||
|
member-flags
|
||||||
|
|
||||||
member-nick
|
member-nick
|
||||||
member-id
|
member-id
|
||||||
|
@ -74,7 +75,8 @@
|
||||||
month
|
month
|
||||||
period
|
period
|
||||||
configuration
|
configuration
|
||||||
primes)
|
primes
|
||||||
|
utils)
|
||||||
|
|
||||||
;; Checks whether given string is a 4-digit decimal number.
|
;; Checks whether given string is a 4-digit decimal number.
|
||||||
(define (is-4digit-string? s)
|
(define (is-4digit-string? s)
|
||||||
|
@ -249,6 +251,15 @@
|
||||||
(and joined
|
(and joined
|
||||||
(month<=? joined (*current-month*)))))
|
(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
|
;; Nickname as string
|
||||||
(define (member-nick mr)
|
(define (member-nick mr)
|
||||||
(member-record-info mr 'nick))
|
(member-record-info mr 'nick))
|
||||||
|
|
10
month.scm
10
month.scm
|
@ -137,9 +137,13 @@
|
||||||
(error 'month-diff "Second argument is not a valid month" t))
|
(error 'month-diff "Second argument is not a valid month" t))
|
||||||
(error 'month-diff "First argument is not a valid month" f)))
|
(error 'month-diff "First argument is not a valid month" f)))
|
||||||
|
|
||||||
;; Returns a month n months after the month m.
|
;; Returns a month n months after the month m. The number n defaults
|
||||||
(define (month-add m n)
|
;; to 1.
|
||||||
(let ((mi (+ (* 12 (car m)) (cadr m) n -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)
|
(list (quotient mi 12)
|
||||||
(+ (remainder mi 12) 1))))
|
(+ (remainder mi 12) 1))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue