From 8b426edf1b6d4de0ec825da8a34b1df7b51212db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 18:37:03 +0200 Subject: Update ical parts to use app context. --- module/entry-points/ical.scm | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) (limited to 'module/entry-points') diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm index f2f4e0b5..dc060ec6 100644 --- a/module/entry-points/ical.scm +++ b/module/entry-points/ical.scm @@ -22,11 +22,4 @@ ;; [else (normalize-date* (set (month start) = (+ 1)))] [(date+ start (date month: 1))] )) - - ;; TODO this contains repeated events multiple times - (define-values (calendars regular repeating) - (cond [(option-ref opts 'file #f) => (compose load-calendars* list)] - [else (load-calendars*)])) - - (ical-main calendars regular repeating start end) - ) + (ical-main start end)) -- cgit v1.2.3 From c74486cbb2efda112dc2631aa3ed84824fc61c8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 18:41:39 +0200 Subject: Update HTML to use app. --- module/entry-points/html.scm | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) (limited to 'module/entry-points') diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm index 70fbde42..d80de3b5 100644 --- a/module/entry-points/html.scm +++ b/module/entry-points/html.scm @@ -4,7 +4,7 @@ :use-module (util) :use-module (util time) :use-module (util config) - :use-module (vcomponent) + ;; :use-module (vcomponent) :use-module (datetime) :use-module (datetime util) :use-module (ice-9 getopt-long) @@ -30,26 +30,17 @@ (define style (string->symbol (option-ref opts 'style "wide"))) - (define-values (calendars events) - (cond [(option-ref opts 'file #f) => (compose load-calendars list)] - [else (load-calendars)])) - - - (report-time! "Calendars loaded") - (case style - [(unchunked) - (html-generate calendars events start end render-calendar)] [(wide) ; previously `chunked' - (html-chunked-main count calendars events start (date month: 1))] + (html-chunked-main count start (date month: 1))] [(week) ;; TODO The small calendar is always centered on months, it might ;; be a good idea to instead center it on the current week, meaning ;; that the active row is always in the center - (html-chunked-main count calendars events + (html-chunked-main count (start-of-week start (get-config 'week-start)) (date day: 7))] [(table) - (html-table-main count calendars events start)] + (html-table-main count start)] [else (error "Unknown html style: ~a" style)])) -- cgit v1.2.3 From 8872d37332619820c7f00f95867eb836fc0c3950 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 19:01:44 +0200 Subject: Update server to use app. --- module/entry-points/server.scm | 33 +++++++++------------------------ 1 file changed, 9 insertions(+), 24 deletions(-) (limited to 'module/entry-points') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 408b00b3..6a4558a6 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -1,5 +1,6 @@ (define-module (entry-points server) :use-module (util) + :use-module (util app) :use-module (srfi srfi-1) @@ -54,7 +55,7 @@ (cddr (scandir dir)))))) -(define (make-make-routes calendar regular repeating events) +(define-method (make-make-routes) (make-routes (GET "/week/:start-date.html" (start-date) @@ -63,8 +64,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (html-generate calendars: (getf app 'calendars) + events: (getf app 'event-set) start-date: start-date end-date: (date+ start-date (date day: 6)) next-start: (lambda (d) (date+ d (date day: 7))) @@ -78,8 +79,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (html-generate calendars: (getf app 'calendars) + events: (getf app 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) @@ -95,19 +96,12 @@ (return '((content-type text/calendar)) (with-output-to-string (lambda () - (ical-main calendar - regular - repeating - (parse-iso-date start) + (ical-main (parse-iso-date start) (parse-iso-date end)))))) ;; TODO this returns "invalid" events, since the surrounding VCALENDAR is missing. (GET "/calendar/:uid.ics" (uid) - ;; NOTE build an index. - (aif (or (find (lambda (ev) (equal? uid (attr ev 'UID))) - regular) - (find (lambda (ev) (equal? uid (attr ev 'UID))) - repeating)) + (aif (get-event-by-uid uid) (return '((content-type text/calendar)) (with-output-to-string (lambda () (print-components-with-fake-parent @@ -160,15 +154,6 @@ [(and addr (string-contains addr ".")) AF_INET] [else AF_INET6])) - (define-values (c regular repeating) - (cond [(option-ref opts 'file #f) => (compose load-calendars* list)] - [else (load-calendars*)])) - - (define all-events - ((@ (vcomponent load) calculate-recurrence-set) regular repeating)) - - - ;; update address if it was left blank. A bit clumsy since ;; @var{addr} & @var{family} depend on each other. ;; placed after load-calendars to keep Guile 2.2 compability. @@ -195,7 +180,7 @@ addr port (getpid) (getcwd)) - (run-server (make-make-routes c regular repeating all-events) + (run-server (make-make-routes) 'http `(family: ,family port: ,port -- cgit v1.2.3 From aa44c16ce953c090b2eb3ce580c60fa8934a7720 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Apr 2020 19:17:35 +0200 Subject: Change call signature for [gs]etf. --- module/entry-points/server.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'module/entry-points') diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 6a4558a6..3dab6e9c 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -64,8 +64,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: (getf app 'calendars) - events: (getf app 'event-set) + (html-generate calendars: (getf 'calendars) + events: (getf 'event-set) start-date: start-date end-date: (date+ start-date (date day: 6)) next-start: (lambda (d) (date+ d (date day: 7))) @@ -79,8 +79,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: (getf app 'calendars) - events: (getf app 'event-set) + (html-generate calendars: (getf 'calendars) + events: (getf 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) -- cgit v1.2.3