diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/calp/html/components.scm | 50 | ||||
-rw-r--r-- | module/calp/html/vcomponent.scm | 179 | ||||
-rw-r--r-- | module/calp/html/view/calendar.scm | 27 | ||||
-rw-r--r-- | module/calp/main.scm | 63 | ||||
-rw-r--r-- | module/calp/server/routes.scm | 66 | ||||
-rw-r--r-- | module/calp/util/config.scm | 4 | ||||
-rw-r--r-- | module/vcomponent/base.scm | 8 | ||||
-rw-r--r-- | module/vcomponent/ical/output.scm | 8 | ||||
-rw-r--r-- | module/vcomponent/ical/parse.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/search.scm | 18 | ||||
-rw-r--r-- | module/vcomponent/xcal/parse.scm | 17 | ||||
-rw-r--r-- | module/web/http/make-routes.scm | 7 |
12 files changed, 361 insertions, 88 deletions
diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index ebc359b8..03e1cef1 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -1,6 +1,8 @@ (define-module (calp html components) :use-module (calp util) :use-module (calp util exceptions) + :use-module (ice-9 curried-definitions) + :use-module (ice-9 match) :export (xhtml-doc) ) @@ -112,6 +114,54 @@ ,key) (div (@ (class "content")) ,body))))) +(define ((set-attribute attr) el) + (match el + [(tagname ('@ params ...) inner-body ...) + `(,tagname (@ ,@(assq-merge params attr)) + ,@inner-body)] + [(tagname inner-body ...) + `(,tagname (@ ,attr) + ,@inner-body)])) + + +(define-public (with-label lbl . forms) + + (define id (gensym "label")) + + (cons `(label (@ (for ,id)) ,lbl) + (let recurse ((forms forms)) + (map (lambda (form) + (cond [(not (list? form)) form] + [(null? form) '()] + [(eq? 'input (car form)) + ((set-attribute `((id ,id))) form)] + [(list? (car form)) + (cons (recurse (car form)) + (recurse (cdr form)))] + [else + (cons (car form) + (recurse (cdr form)))])) + forms)))) + + +(define-public (form elements) + `(form + ,@(map (label self + (lambda (el) + (match el + ((name ('@ tags ...) body ...) + (let ((id (gensym "formelement"))) + (cons + `(label (@ (for ,id)) ,name) + (map + (set-attribute `((name ,name))) + (cons + ((set-attribute `((id ,id))) (car body)) + (cdr body)))))) + ((name body ...) + (self `(,name (@) ,@body)))))) + elements))) + (define-public (include-css path . extra-attributes) `(link (@ (type "text/css") diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm index c4e15374..fbf344b0 100644 --- a/module/calp/html/vcomponent.scm +++ b/module/calp/html/vcomponent.scm @@ -5,9 +5,10 @@ :use-module (srfi srfi-41) :use-module (datetime) :use-module ((text util) :select (add-enumeration-punctuation)) + :use-module ((web uri-query) :select (encode-query-parameters)) :use-module (calp html util) :use-module ((calp html config) :select (edit-mode)) - :use-module ((calp html components) :select (btn tabset)) + :use-module ((calp html components) :select (btn tabset form with-label)) :use-module ((calp util color) :select (calculate-fg-color)) :use-module ((vcomponent datetime output) :select (fmt-time-span @@ -56,18 +57,21 @@ ;; (format (current-error-port) "fmt-single-event: ~a~%" (prop ev 'X-HNH-FILENAME)) `(div (@ ,@(assq-merge attributes - `((class " eventtext " + `((class " eventtext summary-tab " ,(when (and (prop ev 'PARTSTAT) (eq? 'TENTATIVE (prop ev 'PARTSTAT))) " tentative "))))) (h3 ,(fmt-header (when (prop ev 'RRULE) `(span (@ (class "repeating")) "↺")) - `(span (@ (class "summary")) ,(prop ev 'SUMMARY)))) + `(span (@ (class "bind summary") + (data-property "summary")) + ,(prop ev 'SUMMARY)))) (div ,(call-with-values (lambda () (fmt-time-span ev)) (case-lambda [(start) - `(div (time (@ (class "dtstart") + `(div (time (@ (class "bind dtstart") + (data-property "dtstart") (data-fmt ,(string-append "~L" start)) (datetime ,(datetime->string (as-datetime (prop ev 'DTSTART)) @@ -76,7 +80,8 @@ (as-datetime (prop ev 'DTSTART)) start)))] [(start end) - `(div (time (@ (class "dtstart") + `(div (time (@ (class "bind dtstart") + (data-property "dtstart") (data-fmt ,(string-append "~L" start)) (datetime ,(datetime->string (as-datetime (prop ev 'DTSTART)) @@ -84,31 +89,170 @@ ,(datetime->string (as-datetime (prop ev 'DTSTART)) start)) " — " - (time (@ (class "dtend") + (time (@ (class "bind dtend") + (data-property "dtend") (data-fmt ,(string-append "~L" end)) (datetime ,(datetime->string (as-datetime (prop ev 'DTSTART)) "~1T~3"))) ,(datetime->string (as-datetime (prop ev 'DTEND)) end)))])) + + ;; TODO add optional fields when added in frontend + ;; Possibly by always having them here, just hidden. + (div (@ (class "fields")) ,(when (and=> (prop ev 'LOCATION) (negate string-null?)) `(div (b "Plats: ") - (div (@ (class "location")) + (div (@ (class "bind location") (data-property "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (prop ev 'LOCATION))))) ,(awhen (prop ev 'DESCRIPTION) - `(span (@ (class "description")) + `(div (@ (class "bind description") + (data-property "description")) ,(format-description ev it))) + + ;; TODO add bind once I figure out how to bind lists + ,(awhen (prop ev 'CATEGORIES) + `(div (@ (class "categories")) + ,@(map (lambda (c) + `(a (@ (class "category") + ;; TODO centralize search terms + (href + "/search/?" + ,(encode-query-parameters + `((q . (member + ,(->quoted-string c) + (or (prop event 'CATEGORIES) + '()))))))) + ,c)) + it))) + + ;; TODO bind ,(awhen (prop ev 'RRULE) - `(span (@ (class "rrule")) - ,@(format-recurrence-rule ev))) + `(div (@ (class "rrule")) + ,@(format-recurrence-rule ev))) + ,(when (prop ev 'LAST-MODIFIED) - `(span (@ (class "last-modified")) "Senast ändrad " - ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M")))) + `(div (@ (class "last-modified")) "Senast ändrad " + ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M")))) ))) +(define*-public (fmt-for-edit ev + optional: (attributes '()) + key: (fmt-header list)) + `(div (@ (class " eventtext edit-tab ")) + (form (@ (class "edit-form")) + (div (@ (class "dropdown-goes-here"))) + (h3 (input (@ (type "text") + (placeholder "Sammanfattning") + (name "summary") (required) + (class "bind") (data-property "summary") + (value ,(prop ev 'SUMMARY))))) + + ,(let ((start (prop ev 'DTSTART)) + (end (prop ev 'DTEND))) + `(div (@ (class "timeinput")) + + (input (@ (type "date") + (name "dtstart-date") + (style "grid-column:1;grid-row:2") + (class "bind") + (data-property "--dtstart-date") + (value ,(date->string (as-date start))))) + + (input (@ (type "date") + (name "dtend-date") + (style "grid-column:1;grid-row:3") + (class "bind") + (data-property "--dtend-date") + ,@(when end `((value ,(date->string (as-date end))))))) + + ,@(with-label + "Heldag?" + `(input (@ (type "checkbox") (style "display:none") + (name "wholeday")))) + + (input (@ (type "time") + (name "dtstart-time") + (class "bind") + (data-property "--dtstart-time") + (style "grid-column:3;grid-row:2;" + ,(when (date? start) "display:none")) + (value ,(time->string (as-time start))))) + + (input (@ (type "time") + (name "dtend-time") + (class "bind") + (data-property "--dtend-time") + (style "grid-column:3;grid-row:3;" + ,(when (date? end) "display:none")) + ,@(when end `((value ,(time->string (as-time end))))) + )))) + + ,@(with-label + "Plats" + `(input (@ (placeholder "Plats") + (name "location") + (type "text") + (class "bind") (data-property "location") + (value ,(or (prop ev 'LOCATION) ""))))) + + ,@(with-label + "Beskrivning" + `(textarea (@ (placeholder "Beskrivning") + (class "bind") (data-property "description") + (name "description")) + ,(prop ev 'DESCRIPTION))) + + ,@(with-label + "Kategorier" + ;; It would be better if these input-list's worked on the same + ;; class=bind system as the fields above. The problem with that + ;; is however that each input-list requires different search + ;; and join procedures. Currently this is bound in the JS, see + ;; [CATEGORIES_BIND]. + ;; It matches on ".input-list[data-property='categories']". + `(div (@ (class "input-list") + (data-property "categories")) + ,@(awhen (prop ev 'CATEGORIES) + (map (lambda (c) + `(input (@ (size 2) + (class "unit") + (value ,c)))) + it)) + + (input (@ (class "unit final") + (size 2) + (type "text") + )))) + + (hr) + + ;; For custom user fields + ;; TODO these are currently not bound to anything, so entering data + ;; here does nothing. Bigest hurdle to overcome is supporting arbitrary + ;; fields which will come and go in the JavaScript. + ;; TODO also, all (most? maybe not LAST-MODIFIED) remaining properties + ;; should be exposed here. + (div (@ (class "input-list")) + (div (@ (class "unit final newfield")) + (input (@ (type "text") + (list "known-fields") + (placeholder "Nytt fält"))) + (select (@ (name "TYPE")) + (option (@ (value "TEXT")) "Text")) + (span + (input (@ (type "text") + (placeholder "Värde")))))) + + (hr) + + + (input (@ (type "submit"))) + ))) + ;; Single event in side bar (text objects) (define-public (fmt-day day) @@ -176,10 +320,12 @@ (div (@ (class "event-body")) ,(when (prop ev 'RRULE) `(span (@ (class "repeating")) "↺")) - (span (@ (class "summary")) + (span (@ (class "bind summary") + (data-property "summary")) ,(format-summary ev (prop ev 'SUMMARY))) ,(when (prop ev 'LOCATION) - `(span (@ (class "location")) + `(span (@ (class "bind location") + (data-property "location")) ,(string-map (lambda (c) (if (char=? c #\,) #\newline c)) (prop ev 'LOCATION))))) (div (@ (style "display:none !important;")) @@ -238,6 +384,10 @@ ,(tabset `(("📅" title: "Översikt" ,(fmt-single-event ev)) + + ("📅" title: "Redigera" + ,(fmt-for-edit ev)) + ("⤓" title: "Nedladdning" (div (@ (class "eventtext") (style "font-family:sans")) (h2 "Ladda ner") @@ -245,6 +395,7 @@ "som iCal")) (li (a (@ (href "/calendar/" ,(prop ev 'UID) ".xcs")) "som xCal"))))) + ,@(when (prop ev 'RRULE) `(("↺" title: "Upprepningar" class: "repeating" ,(repeat-info ev))))))))) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index a583d82b..0e90e5d4 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -104,7 +104,9 @@ ,(include-alt-css "/static/dark.css" '(title "Dark")) ,(include-alt-css "/static/light.css" '(title "Light")) + (script (@ (defer) (src "/static/types.js"))) (script (@ (defer) (src "/static/lib.js"))) + (script (@ (defer) (src "/static/input_list.js"))) (script (@ (defer) (src "/static/script.js"))) ,(calendar-styles calendars)) @@ -296,4 +298,27 @@ ;; TODO merge this into the event-set, add attribute ;; for non-displaying elements. (div (@ (class "template") (id "popup-template")) - ,(popup event (string-append "popup" (html-id event))))))))) + ,(popup event (string-append "popup" (html-id event)))))) + + ;; Auto-complets when adding new fields to a component + ;; Any string is however still valid. + (datalist (@ (id "known-fields")) + ,@(map (lambda (f) + `(option (@ (value ,f)))) + '(CALSCALE + METHOD PRODID VERSION ATTACH + CATEGORIES CLASS COMMENT + DESCRIPTION GEO LOCATION + PERCENT-COMPLETE PRIORITY + RESOURCES STATUS SUMMARY + COMPLETED DTEND DUE DTSTART + DURATION FREEBUSY + TRANSP TZID TZNAME + TZOFFSETFROM TZOFFSETTO + TZURL ATTENDEE CONTACT + ORGANIZER RECURRENCE-ID + RELATED-TO URL EXDATE + RDATE RRULE ACTION REPEAT + TRIGGER CREATED DTSTAMP LAST-MODIFIED + SEQUENCE REQUEST-STATUS + )))))) diff --git a/module/calp/main.scm b/module/calp/main.scm index 33da1554..c93ae795 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -15,6 +15,8 @@ :use-module (ice-9 getopt-long) :use-module (ice-9 regex) :use-module ((ice-9 popen) :select (open-input-pipe)) + :use-module ((ice-9 sandbox) :select + (make-sandbox-module all-pure-and-impure-bindings)) :use-module (statprof) :use-module (calp repl) @@ -99,13 +101,26 @@ (if (null? a) b a)) - (define (wrapped-main args) (define opts (getopt-long args (getopt-opt options) #:stop-at-first-non-option #t)) (define stprof (option-ref opts 'statprof #f)) (define repl (option-ref opts 'repl #f)) (define altconfig (option-ref opts 'config #f)) + (define config-file + (cond [altconfig + (if (file-exists? altconfig) + altconfig + (throw 'option-error + "Configuration file ~a missing" altconfig))] + ;; altconfig could be placed in the list below. But I want to raise an error + ;; if an explicitly given config is missing. + [(find file-exists? + (list + (path-append (xdg-config-home) "/calp/config.scm") + (path-append (xdg-sysconfdir) "/calp/config.scm"))) + => identity])) + (when stprof (statprof-start)) (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" @@ -113,18 +128,40 @@ (getpid)))] [repl => repl-start]) - (if altconfig - (begin - (if (file-exists? altconfig) - (primitive-load altconfig) - (throw 'option-error "Configuration file ~a missing" altconfig))) - ;; if not altconfig, then regular config - - (awhen (find file-exists? - (list - (path-append (xdg-config-home) "/calp/config.scm") - (path-append (xdg-sysconfdir) "/calp/config.scm"))) - (primitive-load it))) + + ;; Load config + ;; Sandbox and "stuff" not for security from the user. The config script is + ;; assumed to be "safe". Instead it's so we can control the environment in + ;; which it is executed. + (catch #t + (lambda () + (eval + `(begin + (use-modules (srfi srfi-1) + (srfi srfi-88) + (datetime) + (vcomponent) + (calp util config) + (glob)) + ,@(with-input-from-file config-file + (lambda () + (let loop ((done '())) + (let ((form (read))) + (if (eof-object? form) + (reverse done) + (loop (cons form done)))))))) + (make-sandbox-module + `(((guile) use-modules) + ,@all-pure-and-impure-bindings + )) + )) + (lambda args + (format (current-error-port) + "Failed loading config file ~a~%~s~%" + config-file + args + ))) + ;; NOTE this doesn't stop at first non-option, meaning that -o flags diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 184b4481..276513f5 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -218,55 +218,43 @@ [(get-event-by-uid global-event-object (prop event 'UID)) => (lambda (old-event) - ;; procedure to run after save. - ;; used as hook to remove old event from disk below - (define after-save (const #f)) - - (if (eq? calendar (parent old-event)) - (begin (vcomponent-update! old-event event) - ;; for save below - (set! event old-event)) - - ;; change calendar - (begin - - (format (current-error-port) - "Calendar change~%") - - ;; remove from runtime - ((@ (vcomponent instance methods) remove-event) - global-event-object old-event) - - ;; Actually puring the old event should be safe, - ;; since we first make sure we write the new event to disk. - ;; Currently the whole transaction isn't atomic, so a duplicate - ;; event can still be created. - (set! after-save - ;; remove from disk - (lambda () - (format (current-error-port) - "Unlinking old event from ~a~%" - (prop old-event '-X-HNH-FILENAME)) - ((@ (vcomponent vdir save-delete) remove-event) old-event))) - - (parameterize ((warnings-are-errors #t)) - (catch 'warning - (lambda () (add-event global-event-object calendar event)) - (lambda (err fmt args) - (return (build-response code: 400) - (format #f "~?~%" fmt args))))))) + ;; remove old instance of event from runtime + ((@ (vcomponent instance methods) remove-event) + global-event-object old-event) + + ;; Add new event to runtime, + ;; MUST be done after since the two events SHOULD share UID. + (parameterize ((warnings-are-errors #t)) + (catch 'warning + (lambda () (add-event global-event-object calendar event)) + (lambda (err fmt args) + (return (build-response code: 400) + (format #f "~?~%" fmt args))))) (set! (prop event 'LAST-MODIFIED) (current-datetime)) - ;; NOTE Posibly defer save to a later point. ;; That would allow better asyncronous preformance. + + ;; save-event sets -X-HNH-FILENAME from the UID. This is fine + ;; since the two events are guaranteed to have the same UID. (unless ((@ (vcomponent vdir save-delete) save-event) event) (return (build-response code: 500) "Saving event to disk failed.")) - (after-save) + + (unless (eq? calendar (parent old-event)) + ;; change to a new calendar + (format (current-error-port) + "Unlinking old event from ~a~%" + (prop old-event '-X-HNH-FILENAME)) + ;; NOTE that this may fail, leading to a duplicate event being + ;; created (since we save beforehand). This is just a minor problem + ;; which either a better atomic model, or a propper error + ;; recovery log would solve. + ((@ (vcomponent vdir save-delete) remove-event) old-event)) + (format (current-error-port) "Event updated ~a~%" (prop event 'UID)))] diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index 32dabb69..fbe35d59 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -106,10 +106,6 @@ (export format-procedure) -(define (->str any) - (with-output-to-string - (lambda () (display any)))) - (define-public (get-configuration-documentation) (define groups (group-by (compose source-module car) diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index ae10fe01..34d4416b 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -169,14 +169,6 @@ (copy-vline value)))) (get-component-properties component))))) -;; updates target with all fields from source. -;; fields in target but not in source left unchanged. -;; parent and children unchanged -(define-public (vcomponent-update! target source) - (for key in (property-keys source) - (set! (prop* target key) - (prop* source key)))) - (define-public (extract field) (lambda (e) (prop e field))) diff --git a/module/vcomponent/ical/output.scm b/module/vcomponent/ical/output.scm index a0816679..bcc6bb1d 100644 --- a/module/vcomponent/ical/output.scm +++ b/module/vcomponent/ical/output.scm @@ -44,12 +44,16 @@ [(memv key '(FREEBUSY)) (get-writer 'PERIOD)] + [(memv key '(CATEGORIES RESOURCES)) + (lambda (p v) + (string-join (map (lambda (v) ((get-writer 'TEXT) p v)) + v) + ","))] + [(memv key '(CALSCALE METHOD PRODID COMMENT DESCRIPTION LOCATION SUMMARY TZID TZNAME CONTACT RELATED-TO UID - CATEGORIES RESOURCES - VERSION)) (get-writer 'TEXT)] diff --git a/module/vcomponent/ical/parse.scm b/module/vcomponent/ical/parse.scm index 9c555bca..8499d289 100644 --- a/module/vcomponent/ical/parse.scm +++ b/module/vcomponent/ical/parse.scm @@ -135,7 +135,7 @@ (let ((v ((get-parser 'TEXT) params value))) (unless (= 1 (length v)) (warning "List in non-list field: ~s" v)) - (car v)))] + (string-join v ",")))] ;; TEXT, but allow a list [(memv key '(CATEGORIES RESOURCES)) diff --git a/module/vcomponent/search.scm b/module/vcomponent/search.scm index a402bd49..a850fb40 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/search.scm @@ -52,6 +52,13 @@ (define-public (prepare-string str) (call-with-input-string (close-parenthese str) read)) +;; TODO place this in a proper module +(define (bindings-for module-name) + ;; Wrapping list so we can later export sub-modules. + (list (cons module-name + (module-map (lambda (a . _) a) + (resolve-interface module-name))))) + ;; Evaluates the given expression in a sandbox. ;; NOTE Should maybe be merged inte prepare-query. The argument against is that ;; eval-in-sandbox is possibly slow, and that would prevent easy caching by the @@ -63,9 +70,9 @@ (eval `(lambda (event) ,@expressions) (make-sandbox-module `( - ((vcomponent base) prop param children type) + ((vcomponent base) prop param children type parent) ((ice-9 regex) string-match) - ;; TODO datetime + ,@(bindings-for '(datetime)) ,@all-pure-bindings) ))) @@ -155,8 +162,11 @@ (set-max-page! paginator (max page (get-max-page paginator))) result)))) (lambda (err proc fmt args data) - ;; TODO ensure the error actually is index out of range. - ;; (format (current-error-port) "~?~%" fmt args) + ;; NOTE This is mostly a hack to see that we + ;; actually check for the correct error. + (unless (string=? fmt "beyond end of stream") + (scm-error err proc fmt args data)) + (set-max-page! paginator (get-max-page paginator)) (set-true-max-page! paginator) (throw 'max-page (get-max-page paginator)) diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm index 17c684fc..6b877b9f 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/xcal/parse.scm @@ -25,7 +25,10 @@ ;; TODO possibly trim whitespace on text fields [(cal-address uri text unknown) (car value)] - [(date) (parse-iso-date (car value))] + [(date) + ;; TODO this is correct, but ensure remaining types + (hashq-set! props 'VALUE "DATE") + (parse-iso-date (car value))] [(date-time) (parse-iso-datetime (car value))] @@ -108,6 +111,12 @@ data '(AUDIO DISPLAY EMAIL NONE))) [else data])) +;; Note +;; This doesn't verify the inter-field validity of the object, +;; meaning that value(DTSTART) == DATE and value(DTEND) == DATE-TIME +;; are possibilities, which other parts of the code will crash on. +;; TODO +;; since we are feeding user input into this it really should be fixed. (define-public (sxcal->vcomponent sxcal) (define type (symbol-upcase (car sxcal))) (define component (make-vcomponent type)) @@ -147,7 +156,11 @@ (set! (prop* component tag*) (make-vline tag* (handle-tag - tag (handle-value type params value)) + tag (let ((v (handle-value type params value))) + ;; TODO possibly more list fields + (if (eq? tag 'categories) + (string-split v #\,) + v))) params)))))]))) ;; children diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index ab5f88a7..4fb5397a 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -71,6 +71,8 @@ (r:port ((@ (web request) request-port) request))) (let ((r:scheme ((@ (web uri) uri-scheme) r:uri)) (r:userinfo ((@ (web uri) uri-userinfo) r:uri)) + ;; TODO can sometimes be a pair of host and port + ;; '("localhost" . 8080). It shouldn't... (r:host (or ((@ (web uri) uri-host) r:uri) ((@ (web request) request-host) request))) @@ -80,6 +82,11 @@ (r:path ((@ (web uri) uri-path) r:uri)) (r:query ((@ (web uri) uri-query) r:uri)) (r:fragment ((@ (web uri) uri-fragment) r:uri))) + ;; TODO propper logging + (display (format #f "[~a] ~a ~a/~a?~a~%" + (datetime->string (current-datetime)) + r:method r:host r:path (or r:query "")) + (current-error-port)) (call-with-values (lambda () ((@ (ice-9 control) call/ec) |