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 | |
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/html.scm | 17 | ||||
-rw-r--r-- | module/entry-points/ical.scm | 9 | ||||
-rw-r--r-- | module/entry-points/server.scm | 33 |
3 files changed, 14 insertions, 45 deletions
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)])) 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)) 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 |