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

New cal-month documentation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-13 16:57:03 +02:00
parent 41001e4266
commit aa30960e24
2 changed files with 56 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

39
src/cal-month.scm
View file

@ -37,6 +37,7 @@
string->cal-month
cal-month->string
iso-date->cal-month
cal-month=?
cal-month<?
@ -45,7 +46,7 @@
cal-month>?
cal-month-diff
cal-month-add
iso-date->cal-month
cal-month-tests!
)
@ -113,6 +114,24 @@
(error 'string->month "Invalid month" M))
"____-__"))
;; Converts ISO date YYYY-MM-DD to single month
(define (iso-date->cal-month str)
(let ((lst (string-split str "-")))
(if (or (not lst)
(null? lst)
(null? (cdr lst))
(null? (cddr lst))
(not (null? (cdddr lst))))
#f
(let ((year (string->number (car lst)))
(mon (string->number (cadr lst))))
(if (and year mon)
(let ((M (make-cal-month year mon)))
(if (cal-month? M)
M
#f))
#f)))))
;; Returns true if both arguments are a valid month and are equal
(define (cal-month=? m n)
(and (cal-month? m)
@ -163,24 +182,6 @@
(make-cal-month (quotient mi 12)
(+ (remainder mi 12) 1))))
;; Converts ISO date YYYY-MM-DD to single month
(define (iso-date->cal-month str)
(let ((lst (string-split str "-")))
(if (or (not lst)
(null? lst)
(null? (cdr lst))
(null? (cddr lst))
(not (null? (cdddr lst))))
#f
(let ((year (string->number (car lst)))
(mon (string->number (cadr lst))))
(if (and year mon)
(let ((M (make-cal-month year mon)))
(if (cal-month? M)
M
#f))
#f)))))
;; Performs self-tests of the month module.
(define (cal-month-tests!)
(run-tests