From cc463991c11e68fbb5d0c98a1efa5547b3870745 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 9 May 2023 22:56:50 +0200 Subject: [PATCH] Porting to new calendar modules. --- src/Makefile | 57 ++++---- src/brmember-parser.scm | 8 +- src/brmember.scm | 22 +-- src/configuration.scm | 1 - src/mbase.scm | 10 +- src/members-fees.scm | 18 +-- src/members-payments.scm | 4 +- src/month.scm | 192 -------------------------- src/period.scm | 284 --------------------------------------- src/specification.scm | 6 +- 10 files changed, 57 insertions(+), 545 deletions(-) delete mode 100644 src/month.scm delete mode 100644 src/period.scm diff --git a/src/Makefile b/src/Makefile index 8039fa3..af208ee 100644 --- a/src/Makefile +++ b/src/Makefile @@ -31,20 +31,20 @@ static: ../hackerbase CSC=csc -HACKERBASE-DEPS=hackerbase.scm month.import.scm \ +HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm \ command-line.import.scm mbase.import.scm brmember.import.scm \ configuration.import.scm cards.import.scm \ members-print.import.scm members-payments.import.scm \ web-static.import.scm environment.import.scm \ mailman.import.scm texts.import.scm tests.import.scm \ notifications.import.scm logging.import.scm \ - progress.import.scm period.import.scm + progress.import.scm cal-period.import.scm -HACKERBASE-OBJS=hackerbase.o testing.o listing.o month.o period.o \ - ansi.o util-dict-list.o command-line.o mbase.o primes.o \ - brmember.o configuration.o progress.o table.o cards.o \ - members-print.o members-fees.o mbase-dir.o util-csv.o \ - bank-account.o bank-fio.o members-payments.o \ +HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ + cal-period.o ansi.o util-dict-list.o command-line.o mbase.o \ + primes.o brmember.o configuration.o progress.o table.o \ + cards.o members-print.o members-fees.o mbase-dir.o \ + util-csv.o bank-account.o bank-fio.o members-payments.o \ brmember-parser.o web-static.o environment.o mailman.o \ util-set-list.o util-time.o util-tag.o util-io.o \ util-string.o util-io.o util-list.o util-parser.o texts.o \ @@ -106,17 +106,6 @@ UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \ util-dict-list.o: util-dict-list.import.scm util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES) -MONTH-SOURCES=month.scm testing.import.scm - -month.o: month.import.scm -month.import.scm: $(MONTH-SOURCES) - -PERIOD-SOURCES=period.scm testing.import.scm month.import.scm \ - configuration.import.scm - -period.o: period.import.scm -period.import.scm: $(PERIOD-SOURCES) - ANSI-SOURCES=ansi.scm testing.import.scm util-list.import.scm ansi.o: ansi.import.scm @@ -130,9 +119,10 @@ command-line.import.scm: $(COMMAND-LINE-SOURCES) MBASE-SOURCES=mbase.scm testing.import.scm util-dict-list.import.scm \ primes.import.scm brmember.import.scm ansi.import.scm \ - period.import.scm month.import.scm configuration.import.scm \ - progress.import.scm table.import.scm mbase-dir.import.scm \ - util-list.import.scm util-tag.import.scm + cal-period.import.scm cal-month.import.scm \ + configuration.import.scm progress.import.scm \ + table.import.scm mbase-dir.import.scm util-list.import.scm \ + util-tag.import.scm mbase.o: mbase.import.scm mbase.import.scm: $(MBASE-SOURCES) @@ -147,17 +137,16 @@ PRIMES-SOURCES=primes.scm testing.import.scm util-list.import.scm primes.o: primes.import.scm primes.import.scm: $(PRIMES-SOURCES) -BRMEMBER-SOURCES=brmember.scm util-dict-list.import.scm \ - period.import.scm testing.import.scm month.import.scm \ - configuration.import.scm primes.import.scm \ - bank-account.import.scm util-list.import.scm \ +BRMEMBER-SOURCES=brmember.scm util-dict-list.import.scm \ + cal-period.import.scm testing.import.scm cal-month.import.scm \ + configuration.import.scm primes.import.scm \ + bank-account.import.scm util-list.import.scm \ util-tag.import.scm brmember.o: brmember.import.scm brmember.import.scm: $(BRMEMBER-SOURCES) -CONFIGURATION-SOURCES=configuration.scm month.import.scm \ - util-parser.import.scm +CONFIGURATION-SOURCES=configuration.scm util-parser.import.scm configuration.o: configuration.import.scm configuration.import.scm: $(CONFIGURATION-SOURCES) @@ -180,8 +169,8 @@ cards.o: cards.import.scm cards.import.scm: $(CARDS-SOURCES) BRMEMBER-PARSER-SOURCES=brmember-parser.scm brmember.import.scm \ - testing.import.scm util-dict-list.import.scm month.import.scm \ - period.import.scm configuration.import.scm \ + testing.import.scm util-dict-list.import.scm cal-month.import.scm \ + cal-period.import.scm configuration.import.scm \ util-string.import.scm util-list.import.scm \ util-parser.import.scm @@ -189,8 +178,8 @@ brmember-parser.o: brmember-parser.import.scm brmember-parser.import.scm: $(BRMEMBER-PARSER-SOURCES) MEMBERS-PRINT-SOURCES=members-print.scm util-dict-list.import.scm \ - brmember.import.scm month.import.scm table.import.scm \ - listing.import.scm ansi.import.scm period.import.scm \ + brmember.import.scm cal-month.import.scm table.import.scm \ + listing.import.scm ansi.import.scm cal-period.import.scm \ primes.import.scm mbase.import.scm configuration.import.scm \ bank-account.import.scm members-fees.import.scm \ members-payments.import.scm util-list.import.scm \ @@ -200,7 +189,7 @@ members-print.o: members-print.import.scm members-print.import.scm: $(MEMBERS-PRINT-SOURCES) MEMBERS-FEES-SOURCES=members-fees.scm configuration.import.scm \ - brmember.import.scm month.import.scm table.import.scm \ + brmember.import.scm cal-month.import.scm table.import.scm \ mbase.import.scm specification.import.scm \ util-list.import.scm @@ -233,7 +222,7 @@ bank-fio.import.scm: $(BANK-FIO-SOURCES) MEMBERS-PAYMENTS-SOURCES=members-payments.scm bank-account.import.scm \ util-dict-list.import.scm members-fees.import.scm \ - period.import.scm configuration.import.scm \ + cal-period.import.scm configuration.import.scm \ progress.import.scm bank-fio.import.scm util-list.import.scm \ specification.import.scm @@ -354,7 +343,7 @@ LOGGING-SOURCES=logging.scm util-string.import.scm logging.o: logging.import.scm logging.import.scm: $(LOGGING-SOURCES) -SPECIFICATION-SOURCES=specification.scm period.import.scm +SPECIFICATION-SOURCES=specification.scm cal-period.import.scm specification.o: specification.import.scm specification.import.scm: $(SPECIFICATION-SOURCES) diff --git a/src/brmember-parser.scm b/src/brmember-parser.scm index 54da4bf..af1fd3e 100644 --- a/src/brmember-parser.scm +++ b/src/brmember-parser.scm @@ -38,8 +38,8 @@ brmember testing util-dict-list - month - period + cal-month + cal-period util-list configuration util-string @@ -81,7 +81,7 @@ (kind (cadr mk))) (foldl (lambda (mr value) (let* ((mspec (string-first+rest (car value))) - (month (string->month (car mspec))) + (month (string->cal-month (car mspec))) (comment (cdr mspec))) (if month (brmember-sub-prepend @@ -95,7 +95,7 @@ ,(lambda (mr output key value) (case key ((student suspend member) - (let* ((res (period-markers->periods value)) + (let* ((res (period-markers->cal-periods value)) (ok? (car res)) (periods (cadr res)) (msg (caddr res)) diff --git a/src/brmember.scm b/src/brmember.scm index 78393ff..1ad12a1 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -84,8 +84,8 @@ (chicken format) util-dict-list testing - month - period + cal-month + cal-period configuration primes util-list @@ -273,14 +273,14 @@ (let ((member (brmember-info mr 'member))) (if (null? member) #f - (month>=? (*current-month*) - (period-since (car member))))))) + (cal-month>=? (*current-month*) + (cal-period-since (car member))))))) ;; Generic period-based predicate (define ((member-period-predicate? key) mr) (let ((periods (brmember-info mr key #f))) (and periods - (month-in-periods? periods)))) + (cal-month-in-periods? periods)))) ;; Returns true if the member is now suspended (define member-is-suspended? @@ -302,12 +302,12 @@ ;; Returns true if the member is active (not suspended or destroyed). (define (brmember-active? mr) - (and (month-in-periods? (brmember-info mr 'member)) + (and (cal-month-in-periods? (brmember-info mr 'member)) (not (brmember-suspended? mr)))) ;; Returns true if the member is currently a member (define (brmember-existing? mr) - (month-in-periods? + (cal-month-in-periods? (brmember-info mr 'member))) ;; Returns a list of flags of given member record. @@ -331,9 +331,9 @@ ;; suspended. (define (brmember-suspended-months mr) (if (brmember-suspended? mr) - (let ((period (periods-match (brmember-info mr 'suspend)))) + (let ((period (cal-periods-match (brmember-info mr 'suspend)))) (if period - (month-diff (car period) (*current-month*)) + (cal-month-diff (cal-period-since period) (*current-month*)) 0)) 0)) @@ -352,8 +352,8 @@ (define (brmember-payments mr) (filter (lambda (tr) (let* ((isodate (bank-transaction-date tr)) - (month (iso-date->month isodate))) - (month<=? month (*current-month*)))) + (month (iso-date->cal-month isodate))) + (cal-month<=? month (*current-month*)))) (ldict-ref mr 'payments '()))) ;; Returns a list of MLs this member is subscribed to diff --git a/src/configuration.scm b/src/configuration.scm index 0d38bfe..7e83973 100644 --- a/src/configuration.scm +++ b/src/configuration.scm @@ -46,7 +46,6 @@ (chicken time posix) (chicken file) (chicken io) - month util-parser) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/src/mbase.scm b/src/mbase.scm index 0fda26b..8de51d2 100644 --- a/src/mbase.scm +++ b/src/mbase.scm @@ -73,8 +73,8 @@ primes brmember ansi - period - month + cal-period + cal-month configuration progress mbase-dir @@ -224,7 +224,7 @@ di7)) (define (members-base-oldest-month mb) - (make-month 2015 1)) + (make-cal-month 2015 1)) ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. @@ -232,14 +232,14 @@ (let ((keys '(month total active suspended students destroyed invalid))) (let mloop ((data '()) (month (members-base-oldest-month mb))) - (if (month? cm last-month) + (if (cal-month>? cm last-month) (reverse cal) - (loop (month-add cm) + (loop (cal-month-add cm) (cons (list cm (parameterize ((*current-month* cm)) (brmember-flags mr))) @@ -134,8 +134,8 @@ '() (let* ((fm (member-calendar-first-month mc)) (lm (member-calendar-last-month mc)) - (fy (month-year fm)) - (ly (month-year lm))) + (fy (cal-month-year fm)) + (ly (cal-month-year lm))) (let loop ((y fy) (rows '())) (if (> y ly) @@ -147,7 +147,7 @@ (reverse row) (mloop (add1 m) (cons (member-calendar-entry->string - (member-calendar-query mc (make-month y m))) + (member-calendar-query mc (make-cal-month y m))) row)))) rows))))))) diff --git a/src/members-payments.scm b/src/members-payments.scm index e73c7e6..1383b1e 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -52,7 +52,7 @@ bank-fio util-dict-list members-fees - period + cal-period configuration util-list progress @@ -64,7 +64,7 @@ ;; Lookup CZK/EUR (define (lookup-eur-rate) - (car (lookup-by-period exchange-rates-lookup-table))) + (car (lookup-by-cal-period exchange-rates-lookup-table))) ;; Extract probable member-id from transaction (define (transaction-extract-member-id transaction) diff --git a/src/month.scm b/src/month.scm deleted file mode 100644 index 6e3b784..0000000 --- a/src/month.scm +++ /dev/null @@ -1,192 +0,0 @@ -;; -;; month.scm -;; -;; Month processing support. -;; -;; ISC License -;; -;; Copyright 2023 Brmlab, z.s. -;; Dominik Pantůček -;; -;; Permission to use, copy, modify, and/or distribute this software -;; for any purpose with or without fee is hereby granted, provided -;; that the above copyright notice and this permission notice appear -;; in all copies. -;; -;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL -;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED -;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE -;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR -;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, -;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN -;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -;; - -(declare (unit month)) - -(module - month - ( - make-month - month-year - month-month - month-valid? - string->month - month->string - month=? - month=? - month>? - month-diff - month-add - iso-date->month - month-tests! - ) - - (import scheme - (chicken base) - (chicken string) - (chicken format) - testing) - - ;; Simple wrapper for creating month representation as a list. - (define (make-month y m) - (list y m)) - - ;; Accessors - (define month-year car) - (define month-month cadr) - - ;; Returns true if this is a valid month representation - a list with - ;; two integer elements within the allowed range. - (define (month-valid? m) - (and (list? m) - (car m) - (cdr m) - (cadr m) - (null? (cddr m)) - (integer? (car m)) - (integer? (cadr m)) - (>= (car m) 1000) - (<= (car m) 9999) - (>= (cadr m) 1) - (<= (cadr m) 12))) - - ;; Converts string in a format YYYY-MM to valid month. Returns #f if - ;; the conversion fails. - (define (string->month s) - (let ((l (string-split s "-"))) - (if (or (not l) - (null? l) - (null? (cdr l)) - (not (null? (cddr l)))) - #f - (let ((y (string->number (car l))) - (m (string->number (cadr l)))) - (if (and y m) - (let ((M (list y m))) - (if (month-valid? M) - M - #f)) - #f))))) - - ;; Formats (valid) month as YYYY-MM string - (define (month->string M) - (if M - (if (month-valid? M) - (let ((y (car M)) - (m (cadr M))) - (sprintf "~A-~A~A" - y - (if (< m 10) "0" "") - m)) - (error 'string->month "Invalid month" M)) - "____-__")) - - ;; Returns true if both arguments are a valid month and are equal - (define (month=? m n) - (and (month-valid? m) - (month-valid? n) - (equal? m n))) - - ;; Returns true if the first argument is a month in the past of the - ;; second argument month - (define (month=? m n) - (not (month? m n) - (not (month<=? m n))) - - ;; Returns the number of months between from f and to t. The first - ;; month is included in the count, the last month is not. - (define (month-diff f t) - (if (month-valid? f) - (if (month-valid? t) - (let ((F (+ (* (car f) 12) (cadr f) -1)) - (T (+ (* (car t) 12) (cadr t) -1))) - (- T F)) - (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. 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)))) - - ;; Converts ISO date to single month - (define (iso-date->month str) - (let* ((lst (string-split str "-")) - (year (car lst)) - (mon (cadr lst))) - (make-month (string->number year) - (string->number mon)))) - - ;; Performs self-tests of the month module. - (define (month-tests!) - (run-tests - month - (test-true month-valid? (month-valid? '(2023 5))) - (test-false month-valid? (month-valid? '(999 8))) - (test-false month-valid? (month-valid? '(2023 -5))) - (test-equal? string->month (string->month "2023-01") '(2023 1)) - (test-false string->month (string->month "2023-13")) - (test-false string->month (string->month "YYYY-01")) - (test-false string->month (string->month "2023-MMM")) - (test-equal? month->string (month->string '(2023 1)) "2023-01") - (test-exn month->string (month->string '(999 12))) - (test-exn month->string (month->string '(2023 13))) - (test-true monthmonth (iso-date->month "2023-04-03") '(2023 4)) - )) - - ) diff --git a/src/period.scm b/src/period.scm deleted file mode 100644 index 38b744c..0000000 --- a/src/period.scm +++ /dev/null @@ -1,284 +0,0 @@ -;; -;; period.scm -;; -;; Month periods. -;; -;; ISC License -;; -;; Copyright 2023 Brmlab, z.s. -;; Dominik Pantůček -;; -;; Permission to use, copy, modify, and/or distribute this software -;; for any purpose with or without fee is hereby granted, provided -;; that the above copyright notice and this permission notice appear -;; in all copies. -;; -;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL -;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED -;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE -;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR -;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS -;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, -;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN -;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -;; - -(declare (unit period)) - -(module - period - ( - *current-month* - - make-period - - period-since - period-before - period-scomment - period-bcomment - - period-markers->periods - - periods-duration - - month-in-period? - month-in-periods? - - periods->string - periods-match - - make-period-lookup-table - lookup-by-period - - period-tests! - ) - - (import scheme - (chicken base) - (chicken sort) - (chicken time) - (chicken time posix) - (chicken format) - (chicken string) - month - testing - configuration) - - ;; Current month - if changed, we get the actual state for given month. - (define *current-month* - (make-parameter - (let ((d (seconds->local-time (current-seconds)))) - (list (+ 1900 (vector-ref d 5)) - (+ (vector-ref d 4) 1))))) - - ;; Creates a new period value with optional since and before - ;; comments. - (define (make-period since before . args) - (let ((scomment (if (not (null? args)) (car args) #f)) - (bcomment (if (and (not (null? args)) - (not (null? (cdr args)))) - (cadr args) - #f))) - (list since before scomment bcomment))) - - ;; Simple accessors - (define period-since car) - (define period-before cadr) - (define period-scomment caddr) - (define period-bcomment cadddr) - - ;; Sorts period markers (be it start or end) chronologically and - ;; returns the sorted list. - (define (sort-period-markers l) - (sort l - (lambda (a b) - (monthperiods l) - (let loop ((l (sort-period-markers l)) - (ps '()) - (cb #f)) - (if (null? l) - (list #t - (if cb - (reverse (cons (make-period (car cb) #f (cadr cb)) ps)) - (reverse ps)) - "" - -1) - (let* ((marker (car l)) - (rmt (if cb 'stop 'start)) - (mtype (car marker)) - (month (cadr marker)) - (line-number (if (null? (cddr marker)) - #f - (caddr marker))) - (comment (if (and line-number - (not (null? (cdddr marker)))) - (cadddr marker) - #f))) - (if (eq? mtype rmt) - (if cb - (loop (cdr l) - (cons (make-period (car cb) month (cadr cb) comment) ps) - #f) - (loop (cdr l) - ps - (list month comment))) - (list #f - (reverse ps) - (sprintf "Invalid start/stop sequence marker ~A" marker) - line-number)))))) - - ;; 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 (period-since p)) - (e (period-before p)) - (e- (if e e (*current-month*)))) - (month-diff b e-))) - - ;; Returns sum of periods lengths. - (define (periods-duration l) - (apply + (map period->duration l))) - - ;; True if month belongs to given month period - start inclusive, end - ;; exclusive. - (define (month-in-period? p . ml) - (let ((m (if (null? ml) - (*current-month*) - (car ml)))) - (and (or (not (period-before p)) - (monthstring p) - (sprintf "~A..~A" - (month->string (period-since p)) - (month->string (period-before p)))) - - ;; Returns a string representing a list of periods. - (define (periods->string ps) - (string-intersperse - (map period->string ps) - ", ")) - - ;; Finds a period the month matches and returns it. If no period - ;; matches, it returns #f. - (define (periods-match ps . ml) - (let ((m (if (null? ml) (*current-month*) (car ml)))) - (let loop ((ps ps)) - (if (null? ps) - #f - (if (month-in-period? (car ps) m) - (car ps) - (loop (cdr ps))))))) - - ;; Creates lookup table from definition source - (define (make-period-lookup-table source) - (let loop ((lst source) - (res '()) - (prev #f)) - (if (null? lst) - (reverse - (cons (cons (make-period (car prev) #f) - (cdr prev)) - res)) - (loop (cdr lst) - (if prev - (cons (cons (make-period (car prev) (caar lst)) - (cdr prev)) - res) - res) - (car lst))))) - - ;; Looks up current month and returns associated definitions - (define (lookup-by-period table) - (let loop ((lst table)) - (if (null? lst) - #f - (if (month-in-period? (caar lst)) - (cdar lst) - (loop (cdr lst)))))) - - ;; Performs self-tests of the period module. - (define (period-tests!) - (run-tests - period - (test-equal? sort-period-markers - (sort-period-markers '((start (2023 1)) (stop (2022 10)) (start (2022 3)))) - '((start (2022 3)) (stop (2022 10)) (start (2023 1)))) - (test-equal? period-markers->periods - (period-markers->periods - '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)))) - '(#t - (((2022 3) (2022 10) #f #f) - ((2023 1) (2023 4) #f #f)) - "" - -1)) - (test-equal? period-markers->periods-open - (period-markers->periods - '((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)) (start (2023 5)))) - '(#t - (((2022 3) (2022 10) #f #f) - ((2023 1) (2023 4) #f #f) - ((2023 5) #f #f #f)) - "" - -1)) - (test-eq? period-duration - (period->duration '((2023 1) (2023 4) #f #f)) 3) - (parameterize ((*current-month* (list 2023 4))) - (test-eq? period-duration - (period->duration '((2023 1) #f #f #f)) 3)) - (test-eq? periods-duration - (periods-duration '(((2022 3) (2022 10) #f #f) - ((2023 1) (2023 4) #f #f))) - 10) - (test-true month-in-period? - (month-in-period? '((2022 1) (2022 4) #f #f) '(2022 3))) - (test-false month-in-period? - (month-in-period? '((2022 1) (2022 4) #f #f) '(2022 5))) - (test-true month-in-periods? - (month-in-periods? '(((2022 1) (2022 4) #f #f) - ((2023 5) (2023 10) #f #f)) - '(2022 3))) - (test-true month-in-periods? - (month-in-periods? '(((2022 1) (2022 4) #f #f) - ((2023 5) (2023 10) #f #f)) - '(2023 7))) - (test-false month-in-periods? - (month-in-periods? '(((2022 1) (2022 4) #f #f) - ((2023 5) (2023 10) #f #f)) - '(2022 10))) - (test-equal? period->string - (period->string '((2022 1) (2022 4) #f #f)) - "2022-01..2022-04") - (test-equal? periods->string - (periods->string '(((2022 1) (2022 4) #f #f) - ((2022 12) (2023 2) #f #f))) - "2022-01..2022-04, 2022-12..2023-02") - (test-false periods-match (periods-match '(((2022 1) (2022 4) #f #f) - ((2022 12) (2023 2) #f #f)) - '(2022 5))) - (test-equal? periods-match (periods-match '(((2022 1) (2022 4) #f #f) - ((2022 12) (2023 2) #f #f)) - '(2022 2)) - '((2022 1) (2022 4) #f #f)) - )) - - ) diff --git a/src/specification.scm b/src/specification.scm index 84444e6..310d8d4 100644 --- a/src/specification.scm +++ b/src/specification.scm @@ -34,16 +34,16 @@ ) (import scheme - period) + cal-period) ;; Convert into lookups - a list of (list period regular student) (define member-fees-lookup-table - (make-period-lookup-table + (make-cal-period-lookup-table '(((2010 1) 500 250)))) ;; Exchange rates (define exchange-rates-lookup-table - (make-period-lookup-table + (make-cal-period-lookup-table '(((2010 1) 25)))) ;; How long the member can be suspended without any action required?