aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-14 00:55:14 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-14 00:55:14 +0200
commit9efa45fc7035e5d5dc1c2883566283e992fe94d9 (patch)
tree1bd95c1a094f8e242fc0162a8f9e5c1d57bc3c97
parentFix /static/ links in generated html + extra. (diff)
downloadcalp-9efa45fc7035e5d5dc1c2883566283e992fe94d9.tar.gz
calp-9efa45fc7035e5d5dc1c2883566283e992fe94d9.tar.xz
Simplify (output html) further.
-rw-r--r--module/output/html.scm66
1 files changed, 37 insertions, 29 deletions
diff --git a/module/output/html.scm b/module/output/html.scm
index ca4bf83d..16b4a060 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -5,10 +5,12 @@
#:use-module ((srfi srfi-41) :select (stream-take stream-for-each))
#:use-module ((datetime)
:select (date-stream date
- remove-day month-days
+ remove-day
date+ date-
- month+ month-
- date->string))
+ date->string
+ start-of-week end-of-week
+ end-of-month
+ ))
#:use-module ((html view calendar)
:select (html-generate))
@@ -79,31 +81,37 @@
(common count start-date chunk-length
(lambda (calendars events)
- (html-generate calendars: calendars
- events: events
- start-date: start-date
- end-date: (remove-day (date+ start-date chunk-length))
- render-calendar: render-calendar
- next-start: (lambda (d) (date+ d chunk-length))
- prev-start: (lambda (d) (date- d chunk-length))
- ))))
-
+ (html-generate
+ ;; same
+ calendars: calendars
+ events: events
+ next-start: (lambda (d) (date+ d chunk-length))
+ prev-start: (lambda (d) (date- d chunk-length))
+ start-date: start-date
+ end-date: (remove-day (date+ start-date chunk-length))
+ render-calendar: render-calendar
+ ;; different
+ ))))
+
+;; start date MUST be the first in month
(define-public (html-table-main count start-date)
- (common count start-date (date month: 1)
- (let* ((before current after (month-days start-date)))
- (lambda (calendars events)
- (html-generate calendars: calendars
- events: events
- start-date: (car current)
- end-date: (date- (if (null? after)
- (last current)
- (car after))
- (date day: 1))
- render-calendar: render-calendar-table
- next-start: month+
- prev-start: month-
- ;; Appends for case where before or after is empty
- pre-start: (car (append before current))
- post-end: (last (append current after))
- )))))
+ (define chunk-length (date month: 1))
+ (define render-calendar render-calendar-table)
+
+ (common count start-date chunk-length
+ (lambda (calendars events)
+ (html-generate
+ ;; same
+ calendars: calendars
+ events: events
+ next-start: (lambda (d) (date+ d chunk-length))
+ prev-start: (lambda (d) (date- d chunk-length))
+ start-date: start-date
+ end-date: (remove-day (date+ start-date chunk-length))
+ render-calendar: render-calendar
+
+ ;; different
+ pre-start: (start-of-week start-date)
+ post-end: (end-of-week (end-of-month start-date))
+ ))))