diff options
| -rw-r--r-- | module/entry-points/server.scm | 9 | ||||
| -rw-r--r-- | module/output/general.scm | 3 | ||||
| -rw-r--r-- | module/output/html.scm | 4 | ||||
| -rw-r--r-- | module/srfi/srfi-19/alt/util.scm | 5 | ||||
| -rw-r--r-- | module/vcomponent/group.scm | 1 | ||||
| -rw-r--r-- | tests/srfi-19-alt.scm | 16 |
6 files changed, 33 insertions, 5 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 4215ab9a..0b40a6ff 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -9,9 +9,12 @@ (ice-9 (match control rdelim curried-definitions ftw getopt-long iconv regex #| regex here due to bad macros |# )) - (srfi (srfi-1 srfi-19 srfi-88))) + (srfi (srfi-1 srfi-88))) -(use-modules (srfi srfi-19 util)) +(use-modules (srfi srfi-19 alt) + (srfi srfi-19 alt util)) + +;; (use-modules (srfi srfi-19 util)) (define (file-extension name) (car (last-pair (string-split name #\.)))) @@ -41,7 +44,7 @@ (start (if m (date year: 2019 day: 1 month: (string->number m)) (current-date))) - (end (set (date-month start) = (+ 1)))) + (end (set (month start) = (+ 1)))) (return '((content-type text/html)) (with-output-to-string diff --git a/module/output/general.scm b/module/output/general.scm index 4d9b4ce8..e2f73991 100644 --- a/module/output/general.scm +++ b/module/output/general.scm @@ -6,6 +6,7 @@ (catch #t (lambda () (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16)) + ;; (format (current-error-port) "COLOR = ~s~%" c) (let ((r (str->num c 1)) (g (str->num c 3)) (b (str->num c 5))) @@ -15,6 +16,6 @@ #xFF)) "#000000" "#e5e8e6"))) (lambda args - (format (current-error-port) "Error calculating foreground color?~%~a~%" args) + (format (current-error-port) "Error calculating foreground color?~%~s~%" args) "#FF0000" ))) diff --git a/module/output/html.scm b/module/output/html.scm index cd3e2974..d64c7aa1 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -8,6 +8,7 @@ #:use-module (vcomponent datetime) #:use-module (util) #:use-module (util tree) + #:duplicates (last) #:use-module (srfi srfi-19 alt) #:use-module (srfi srfi-19 alt util) #:use-module (output general) @@ -120,6 +121,7 @@ (datetime- (attr ev 'DTEND) (attr ev 'DTSTART))))) (stream->list events)))) + ;; (format (current-error-port) "lay-out-day: ~a~%" (date->string date)) (fix-event-widths! time-obj short-events) (fix-event-widths! time-obj long-events) `(div (@ (class "day")) @@ -182,6 +184,7 @@ ;; For sidebar, just text (define (fmt-single-event ev) + (format (current-error-port) "fmt-single-event: ~a~%" (attr ev 'X-HNH-FILENAME)) `(article (@ (id ,(UID ev)) (class "eventtext CAL_bg_" ,(html-attr (attr (parent ev) 'NAME)))) @@ -198,6 +201,7 @@ ;; Single event in side bar (text objects) (define (fmt-day day) (let* (((date . events) day)) + (format (current-error-port) "fmt-day: ~a~%" (date->string date)) `(section (@ (class "text-day")) (header (h2 ,(let ((s (date->string date "~Y-~m-~d"))) `(a (@ (href "#" ,s) diff --git a/module/srfi/srfi-19/alt/util.scm b/module/srfi/srfi-19/alt/util.scm index 3310df85..ba1d8dd8 100644 --- a/module/srfi/srfi-19/alt/util.scm +++ b/module/srfi/srfi-19/alt/util.scm @@ -163,4 +163,9 @@ (define-public (in-date-range? start-date end-date) (lambda (date) + (format (current-error-port) "in-date-range? ~a < ~a < ~a = ~a~%" + (date->string start-date) + (date->string date) + (date->string end-date) + (date<= start-date date end-date) ) (date<= start-date date end-date))) diff --git a/module/vcomponent/group.scm b/module/vcomponent/group.scm index 83d79f9a..cf9a6b70 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/group.scm @@ -37,7 +37,6 @@ (define (get-groups-between groups start-date end-date) (filter-sorted-stream - ;; TODO in-date-range? drops the first date (compose (in-date-range? start-date end-date) car) groups)) diff --git a/tests/srfi-19-alt.scm b/tests/srfi-19-alt.scm index 9e03bf53..887af4fa 100644 --- a/tests/srfi-19-alt.scm +++ b/tests/srfi-19-alt.scm @@ -102,6 +102,21 @@ (test-assert "date< tripple negate" (not (date< #2020-01-10 #2020-01-12 #2020-01-11))) +(test-assert "date<=" + (not (date<= #2020-01-01 #2018-05-15 #2020-01-31))) + +(test-assert "date<= equal" + (date<= #2018-05-15 #2020-01-01)) + +(test-assert "date<" + (not (date< #2020-01-01 #2018-05-15 #2020-01-31))) + +(test-assert "date>" + (not (date> #2020-01-31 #2018-05-15 #2020-01-01 ))) + +(test-assert "date>=" + (not (date>= #2020-01-31 #2018-05-15 #2020-01-01))) + (test-assert (datetime- #2018-01-17T10:00:00 #2018-01-17T08:00:00)) @@ -111,3 +126,4 @@ (datetime<=? (datetime time: (time hour: 24)) (datetime- #2018-01-17T10:00:00 #2018-01-17T08:00:00))) + |