aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 19:01:44 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-30 19:01:44 +0200
commit8872d37332619820c7f00f95867eb836fc0c3950 (patch)
treea51d2afc35c9d9cbd3ab85d69e3e69ec1794b4f0
parentMinor changes. (diff)
downloadcalp-8872d37332619820c7f00f95867eb836fc0c3950.tar.gz
calp-8872d37332619820c7f00f95867eb836fc0c3950.tar.xz
Update server to use app.
-rw-r--r--module/entry-points/server.scm33
1 files changed, 9 insertions, 24 deletions
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