diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:08:25 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:08:25 +0200 |
commit | 29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea (patch) | |
tree | 92c5f2a5271911930a15e58df862273b3a755e5d /module/entry-points/server.scm | |
parent | Server server any subdir under static. (diff) | |
parent | Change call signature for [gs]etf. (diff) | |
download | calp-29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea.tar.gz calp-29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea.tar.xz |
Merge branch 'app'.
The app objects both makes the whole program sort of behave like one
class in some object oriented languages, with an implicitly (actually
hiddenly explicitly) passed 'app' argument to all methods. Multiple
concurrent apps should be supported, but is of now untested.
The app is also configured to lazily bind all its fields, which means
that almost all loading is now lazy!
Diffstat (limited to '')
-rw-r--r-- | module/entry-points/server.scm | 33 |
1 files changed, 9 insertions, 24 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 3455540d..63fb83a8 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) @@ -56,7 +57,7 @@ (cdr (scandir dir)))))) -(define (make-make-routes calendar regular repeating events) +(define-method (make-make-routes) (make-routes (GET "/week/:start-date.html" (start-date) @@ -65,8 +66,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (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))) @@ -80,8 +81,8 @@ (return '((content-type text/html)) (with-output-to-string (lambda () - (html-generate calendars: calendar - events: events + (html-generate calendars: (getf 'calendars) + events: (getf 'event-set) start-date: start-date end-date: (date- (month+ start-date) (date day: 1)) @@ -97,19 +98,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 fails if there's a period in the uid. (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 @@ -162,15 +156,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. @@ -197,7 +182,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 |