aboutsummaryrefslogtreecommitdiff
path: root/module/entry-points
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-05-01 13:08:25 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-05-01 13:08:25 +0200
commit29cb0b9eb8e544d0f2b07eb202d90bed4f20eeea (patch)
tree92c5f2a5271911930a15e58df862273b3a755e5d /module/entry-points
parentServer server any subdir under static. (diff)
parentChange call signature for [gs]etf. (diff)
downloadcalp-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 'module/entry-points')
-rw-r--r--module/entry-points/html.scm17
-rw-r--r--module/entry-points/ical.scm9
-rw-r--r--module/entry-points/server.scm33
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