brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Month parsing.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-11 08:37:02 +01:00
parent 3306a80b09
commit de8f54005d
1 changed files with 20 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

22
brmsaptool.scm
View file

@ -127,8 +127,23 @@
(>= (cadr m 1)) (>= (cadr m 1))
(<= (cadr m 12)))) (<= (cadr m 12))))
;; Converts string in a format YYYY-MM to valid month. Returns #f if
;; the conversion fails.
(define (string->month s) (define (string->month s)
(list 2023 1)) (let ((l (string-split s "-")))
(if (or (not l)
(nil? l)
(nil? (cdr l))
(not (nil? (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)
M
#f))
#f)))))
;; Formats (valid) month as YYYY-MM string ;; Formats (valid) month as YYYY-MM string
(define (month->string M) (define (month->string M)
@ -165,7 +180,10 @@
(unit-test 'month-valid? (month-valid? '(2023 5))) (unit-test 'month-valid? (month-valid? '(2023 5)))
(unit-test 'month-valid?-bad-year (not (month-valid? '(999 8)))) (unit-test 'month-valid?-bad-year (not (month-valid? '(999 8))))
(unit-test 'month-valid?-bad-month (not (month-valid? '(2023 -5)))) (unit-test 'month-valid?-bad-month (not (month-valid? '(2023 -5))))
;; Parsing (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 (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-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->string-bad-month (with-handler (lambda (x) #t) (month->string '(2023 13)) #f))