Make joined/destroyed member period.

This commit is contained in:
Dominik Pantůček 2023-03-29 18:21:25 +02:00
parent 99b86ff9c2
commit 0c7cf11297
2 changed files with 15 additions and 8 deletions

View file

@ -46,8 +46,13 @@
;; Pass 2: known keys ;; Pass 2: known keys
(define mandatory-keys '(nick name mail phone)) (define mandatory-keys '(nick name mail phone))
(define optional-keys '(born joined destroyed)) (define optional-keys '(born))
(define known-multikeys '(card desfire credit studentstart studentstop suspendstart suspendstop)) (define known-multikeys
'(card desfire
credit
studentstart studentstop
suspendstart suspendstop
joined destroyed))
(define ignored-keys '(mail2)) (define ignored-keys '(mail2))
(define known-keys (append mandatory-keys optional-keys)) (define known-keys (append mandatory-keys optional-keys))
@ -60,8 +65,8 @@
(suspendstart suspend start) (suspendstart suspend start)
(suspendstop suspend stop) (suspendstop suspend stop)
;;(joined member start) (joined member start)
;;(destroyed member stop) (destroyed member stop)
)) ))
(define start-stop-markers (map car start-stop-markers-lookup)) (define start-stop-markers (map car start-stop-markers-lookup))
@ -70,8 +75,9 @@
`((pass-markers `((pass-markers
,(lambda (mr output key value) ,(lambda (mr output key value)
(if (member key start-stop-markers) (if (member key start-stop-markers)
(let ((marker (caddr (assq key start-stop-markers-lookup))) (let* ((mk (assq key start-stop-markers-lookup))
(kind (cadr (assq key start-stop-markers-lookup)))) (marker (caddr mk))
(kind (cadr mk)))
(foldl (lambda (mr value) (foldl (lambda (mr value)
(let* ((mspec (string-first+rest (car value))) (let* ((mspec (string-first+rest (car value)))
(month (string->month (car mspec))) (month (string->month (car mspec)))
@ -87,7 +93,7 @@
(info (info
,(lambda (mr output key value) ,(lambda (mr output key value)
(case key (case key
((student suspend) ((student suspend member)
(let* ((res (period-markers->periods value)) (let* ((res (period-markers->periods value))
(ok? (car res)) (ok? (car res))
(periods (cadr res)) (periods (cadr res))
@ -133,7 +139,7 @@
(apply (apply
member-record-sub-ensure member-record-sub-ensure
mr 'info mr 'info
'joined (*member-default-joined*) 'member (make-period (*member-default-joined*) #f)
(join (map (lambda (mk) (list mk #f)) mandatory-keys)))) (join (map (lambda (mk) (list mk #f)) mandatory-keys))))
;; Pass 0: Removes any comments and removes any leading and trailing ;; Pass 0: Removes any comments and removes any leading and trailing

View file

@ -28,6 +28,7 @@
(module (module
period period
( (
make-period
period-since period-since
period-before period-before
period-scomment period-scomment