Propagate errors to HTML search page.

4 files changed, 48 insertions, 29 deletions

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))
diff --git a/static/style.scss b/static/style.scss
index 9cc8916e..322f62f3 100644
--- a/static/style.scss
+++ b/static/style.scss
@@ -671,6 +671,15 @@ along with their colors.
     }
 }
 
+.error {
+    border: 3px solid red;
+    background-color: pink;
+    
+    pre {
+        padding: 1em;
+    }
+}
+
 /* Popups
 ----------------------------------------
 */