Split out month module.

brmsaptool-orig.scm

@@ -30,7 +30,10 @@
 	(chicken sort)
 	(chicken time)
 	(chicken time posix)
-	(chicken process-context))
+	(chicken process-context)
+	testing
+	dictionary
+	month)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Static default configuration
@@ -62,106 +65,6 @@
 	 (display ".")
 	 (error 'unit-test name)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Dictionary
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Months support
-
-;; 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 (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)
-  (and (month-valid? m)
-       (month-valid? n)
-       (or (< (car m) (car n))
-	   (and (= (car m) (car n))
-		(< (cadr m) (cadr 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)))
-		(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-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")))
-  (unit-test 'month->string (equal? (month->string '(2023 1)) "2023-01"))
-  (unit-test 'month->string-bad-year (with-handler (lambda (x) #t) (month->string '(999 12)) #f))
-  (unit-test 'month->string-bad-month (with-handler (lambda (x) #t) (month->string '(2023 13)) #f))
-  (unit-test 'month<? (month<? '(2023 5) '(2023 6)))
-  (unit-test 'month<?-cross-year (month<? '(2022 12) '(2023 1)))
-  (unit-test 'month<?-is-equal (not (month<? '(2023 1) '(2023 1))))
-  (unit-test 'month<?-greater (not (month<? '(2023 1) '(2023 1))))
-  (unit-test 'month-equal? (month=? '(2023 4) '(2023 4)))
-  (unit-test 'month-equal?-not (not (month=? '(2023 4) '(2023 5))))
-  (unit-test 'month-diff-1 (= (month-diff '(2023 1) '(2023 2)) 1))
-  (unit-test 'month-diff-11 (eq? (month-diff '(2023 1) '(2023 12)) 11))
-  (unit-test 'month-diff (= (month-diff '(2023 1) '(2022 2)) -11))
-  (print " ok."))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Periods
 
@@ -594,7 +497,7 @@
 
 ;; Run tests
 (print "Running self-tests:")
-(dict-tests!)
+(dictionary-tests!)
 (month-tests!)
 (period-tests!)
 (print "All self-tests ok!")

brmsaptool.scm

@@ -25,12 +25,15 @@
 
 (import testing
 	listing
-	dictionary)
+	dictionary
+	month)
 
 ;; Print banner
-(print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.")
+(print "brmsaptool 0.2 (c) 2023 Brmlab, z.s.")
 (newline)
 
 ;; Run tests
 (listing-tests!)
 (dictionary-tests!)
+(month-tests!)
+(newline)

month.scm

@@ -0,0 +1,139 @@
+;;
+;; month.scm
+;;
+;; Month processing support.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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.
+;;
+
+(module
+ month
+ (
+  month-valid?
+  string->month
+  month->string
+  month=?
+  month<?
+  month-diff
+  month-tests!
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken string)
+	 (chicken format)
+	 testing)
+
+ ;; 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 (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)
+   (and (month-valid? m)
+	(month-valid? n)
+	(or (< (car m) (car n))
+	    (and (= (car m) (car n))
+		 (< (cadr m) (cadr 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)))
+		 (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)))
+
+ ;; 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 month<? (month<? '(2023 5) '(2023 6)))
+    (test-true month<? (month<? '(2022 12) '(2023 1)))
+    (test-false month<? (month<? '(2023 1) '(2023 1)))
+    (test-false month<? (month<? '(2023 1) '(2023 1)))
+    (test-true month=? (month=? '(2023 4) '(2023 4)))
+    (test-false month=? (month=? '(2023 4) '(2023 5)))
+    (test-eq? month-diff (month-diff '(2023 1) '(2023 2)) 1)
+    (test-eq? month-diff (month-diff '(2023 1) '(2023 12)) 11)
+    (test-eq? month-diff (month-diff '(2023 1) '(2022 2)) -11)
+    ))
+
+ )