aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-26 21:19:31 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-26 21:19:31 +0200
commitdaded7e491b01cf38177ee91adacf6558dad3733 (patch)
treeca1ffad08acc2bc78c8d8956a62c17bb6777e248
parentICAL output work. (diff)
downloadcalp-daded7e491b01cf38177ee91adacf6558dad3733.tar.gz
calp-daded7e491b01cf38177ee91adacf6558dad3733.tar.xz
Add export as ics button.
-rw-r--r--module/entry-points/server.scm32
-rw-r--r--module/output/html.scm4
-rw-r--r--module/vcomponent/load.scm13
3 files changed, 39 insertions, 10 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 3730b8a5..55bfc770 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -39,7 +39,7 @@
(cddr (scandir dir))))))
-(define (make-make-routes calendar events)
+(define (make-make-routes calendar regular repeating events)
(make-routes
(GET "/week/:start-date.html" (start-date)
@@ -75,6 +75,26 @@
post-end: (end-of-week (end-of-month start-date))
))))))
+ ;; TODO export all events in interval
+ ;; (GET "/calendar" (start end)
+ ;; (ical-main calendars
+ ;; regular
+ ;; repeating
+ ;; (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))
+ (return '((content-type text/calendar))
+ (with-output-to-string (lambda () ((@ (output ical) component->ical-string) it))))
+ (return (build-response code: 404)
+ (format #f "No component with UID=~a found." uid))))
+
(GET "/static" ()
(return
'((content-type text/html))
@@ -120,10 +140,12 @@
[(and addr (string-contains addr ".")) AF_INET]
[else AF_INET6]))
- (define-values (c e)
- (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
- [else (load-calendars)]))
+ (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))
@@ -153,7 +175,7 @@
addr port
(getpid) (getcwd))
- (run-server (make-make-routes c e)
+ (run-server (make-make-routes c regular repeating all-events)
'http
`(family: ,family
port: ,port
diff --git a/module/output/html.scm b/module/output/html.scm
index 21eba258..bc3f131b 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -396,6 +396,10 @@
,(when (attr ev 'LAST-MODIFIED)
`(span (@ (class "last-modified")) "Senast ändrad "
,(datetime->string (attr ev 'LAST-MODIFIED) "~1 ~H:~M")))
+
+ (a (@ (href "/calendar/" ,(attr ev 'UID) ".ics"))
+ "📅")
+
)))
;; Single event in side bar (text objects)
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 5fbb5553..37d57b56 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -17,6 +17,13 @@
(define-config calendar-files '() "" list?)
+(define-public (calculate-recurrence-set regular repeating)
+ (interleave-streams
+ ev-time<?
+ (cons (list->stream regular)
+ (map generate-recurrence-set repeating)
+ )))
+
;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
;; and returns a list of calendars, and a stream of all events "ready" for display.
(define* (load-calendars #:optional (calendar-files (get-config 'calendar-files)))
@@ -25,11 +32,7 @@
(report-time! "Calendars loaded, interleaving and reccurring")
(values
calendars
- (interleave-streams
- ev-time<?
- (cons (list->stream regular)
- (map generate-recurrence-set repeating)
- )))))
+ (calculate-recurrence-set regular repeating))))
;; Basic version, loads calendrs, sorts the events, and returns
;; regular and repeating events separated from each other.