diff --git a/brmsaptool.scm b/brmsaptool.scm index 90a7d90..dc0e5b7 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -26,6 +26,7 @@ (chicken file posix) (chicken io) (chicken string) + (chicken format) (chicken process-context)) @@ -50,7 +51,7 @@ (syntax-rules () ((_ name condition) (if (with-handler (lambda (x) #f) - (lambda () condition)) + condition) (display ".") (error 'unit-test name))))) @@ -131,28 +132,28 @@ (car m) (cdr m) (cadr m) - (nil? (cddr m)) + (null? (cddr m)) (integer? (car m)) (integer? (cadr m)) - (>= (car m 1000)) - (<= (car m 9999)) - (>= (cadr m 1)) - (<= (cadr m 12)))) + (>= (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) - (nil? l) - (nil? (cdr l)) - (not (nil? (cddr 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 (valid-month? M) + (if (month-valid? M) M #f)) #f))))) @@ -160,18 +161,18 @@ ;; Formats (valid) month as YYYY-MM string (define (month->string M) (if (month-valid? M) - (let ((y (car s)) - (m (cadr s))) + (let ((y (car M)) + (m (cadr M))) (sprintf "~A-~A~A" y - (if (< m 10) " " "") + (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 (valid-month? m) - (valid-month? 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 @@ -183,16 +184,23 @@ (and (= (car m) (car n)) (< (cadr m) (cadr n)))))) -(define (month-diff m n) - ; Exclusive - 1) +;; 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))) + (T (+ (* (car t) 12) (cadr t)))) + (- T F)) + (error 'month-diff "Second argument is not a valid month" t)) + (error 'month-diff "First argument is not a valid month" f))) (define (month-tests!) (display "[test] month ") (unit-test 'month-valid? (month-valid? '(2023 5))) (unit-test 'month-valid?-bad-year (not (month-valid? '(999 8)))) (unit-test 'month-valid?-bad-month (not (month-valid? '(2023 -5)))) - (unit-test 'string->month (equal? (string->month "2023-01" '(2023 1)))) + (unit-test 'string->month (equal? (string->month "2023-01") '(2023 1))) (unit-test 'string->month-bad-month (not (string->month "2023-13"))) (unit-test 'string->month-nonumber-year (not (string->month "YYYY-01"))) (unit-test 'string->month-nonumber-month (not (string->month "2023-MMM"))) @@ -201,11 +209,13 @@ (unit-test 'month->string-bad-month (with-handler (lambda (x) #t) (month->string '(2023 13)) #f)) (unit-test 'month