From 8d2f64e441c041f317130f372760f4e5a76a171f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 27 Aug 2020 20:58:31 +0200
Subject: Propagate errors to HTML search page.

---
 module/calp/html/view/search.scm | 26 ++++++++++++++------------
 module/calp/server/routes.scm    | 39 +++++++++++++++++++++++----------------
 module/vcomponent/xcal/parse.scm |  3 ++-
 3 files changed, 39 insertions(+), 29 deletions(-)

(limited to 'module')

diff --git a/module/calp/html/view/search.scm b/module/calp/html/view/search.scm
index 3141fa11..00f00bb0 100644
--- a/module/calp/html/view/search.scm
+++ b/module/calp/html/view/search.scm
@@ -10,6 +10,7 @@
   )
 
 (define-public (search-result-page
+                errors
                 has-query? search-term search-result page paginator q=)
   (xhtml-doc
    (@ (lang sv))
@@ -24,15 +25,16 @@
                        (with-output-to-string
                          (lambda () (pretty-print search-term))))))
      (input (@ (type submit))))
-    (h2 "Result (page " ,page ")")
-    (ul
-     ,@(compact-event-list search-result))
-    (div (@ (class "paginator"))
-         ,@(paginator->list
-            paginator
-            (lambda (p) (if (= p page)
-                       `(span ,p)
-                       `(a (@ (href "?" ,q= "&p=" ,p)) ,p)))
-            (lambda (p) `(a (@ (href "?" ,q= "&p=" ,p)) "»"))))
-    )))
-
+    ,@(if errors
+          `((h2 "Error searching")
+            (div (@ (class "error"))
+                 (pre ,errors)))
+          `((h2 "Result (page " ,page ")")
+            (ul ,@(compact-event-list search-result))
+            (div (@ (class "paginator"))
+                 ,@(paginator->list
+                    paginator
+                    (lambda (p) (if (= p page)
+                               `(span ,p)
+                               `(a (@ (href "?" ,q= "&p=" ,p)) ,p)))
+                    (lambda (p) `(a (@ (href "?" ,q= "&p=" ,p)) "»")))))))))
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 865c11c7..389941c7 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -375,29 +375,36 @@
 
         (define page (string->number (or p "0")))
 
-        ;; TODO Propagate errors
+        (define error #f)
+
         (define search-result
-          (catch 'max-page
-            ;; TODO Get-page only puts a time limiter per page, meaning that
-            ;; if a user requests page 1000 the server is stuck trying to
-            ;; find that page, which can take up to 1000 * timeslice = 500s = 8min+
-            ;; A timeout here, and also an actual multithreaded server should
-            ;; solve this.
-            (lambda () (get-page paginator page))
-            (lambda (err page-number)
-              (define location
-                (build-relative-ref
-                 path: r:path ; host: r:host port: r:port
-                 query: (format #f "~a&p=~a" q= page-number)))
-              (return (build-response
-                       code: 307
-                       headers: `((location . ,location)))))))
+          (catch #t
+            (lambda ()
+             (catch 'max-page
+               ;; TODO Get-page only puts a time limiter per page, meaning that
+               ;; if a user requests page 1000 the server is stuck trying to
+               ;; find that page, which can take up to 1000 * timeslice = 500s = 8min+
+               ;; A timeout here, and also an actual multithreaded server should
+               ;; solve this.
+               (lambda () (get-page paginator page))
+               (lambda (err page-number)
+                 (define location
+                   (build-relative-ref
+                    path: r:path        ; host: r:host port: r:port
+                    query: (format #f "~a&p=~a" q= page-number)))
+                 (return (build-response
+                          code: 307
+                          headers: `((location . ,location)))))))
+           (lambda (err callee fmt arg data)
+             (set! error
+              (format #f "~?~%" fmt arg)))))
 
         (return '((content-type application/xhtml+xml))
                 (with-output-to-string
                   (lambda ()
                     (sxml->xml
                      (search-result-page
+                      error
                       q search-term search-result page paginator q=))))))
 
    ;; NOTE this only handles files with extensions. Limited, but since this
diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/xcal/parse.scm
index 26f25caa..17c684fc 100644
--- a/module/vcomponent/xcal/parse.scm
+++ b/module/vcomponent/xcal/parse.scm
@@ -75,7 +75,8 @@
          [(ptag (ptype pvalue ...) ...)
           ;; TODO parameter type (rfc6321 3.5.)
           ;; TODO multi-valued parameters!!!
-          (hashq-set! ht (symbol-upcase ptag) (car (concatenate pvalue)))]))
+          (hashq-set! ht (symbol-upcase ptag)
+                      (car (concatenate pvalue)))]))
   ht)
 
 (define* (parse-enum str enum optional: (allow-other #t))
-- 
cgit v1.2.3