diff options
| -rw-r--r-- | module/calp/html/view/calendar.scm | 9 | ||||
| -rw-r--r-- | module/calp/html/view/search.scm | 26 | ||||
| -rw-r--r-- | module/calp/server/routes.scm | 55 | ||||
| -rw-r--r-- | module/calp/util.scm | 3 | ||||
| -rw-r--r-- | module/vcomponent/xcal/parse.scm | 3 | ||||
| -rw-r--r-- | module/web/uri-query.scm | 13 | ||||
| -rw-r--r-- | static/style.scss | 17 |
7 files changed, 97 insertions, 29 deletions
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 27edfcb4..a505b586 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -194,6 +194,15 @@ (div (@ (style "grid-area: details")) + + (form (@ (class "simplesearch") + (action "/search/text")) + (input (@ (type "text") + (name "q") + (placeholder "Sök"))) + (input (@ (type "submit") + (value ">")))) + ,(when (or (debug) (edit-mode)) `(details (@ (class "sliders")) (summary "Option sliders") 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 f647b998..389941c7 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -11,6 +11,7 @@ :use-module ((web response) :select (build-response)) :use-module ((web uri) :select (build-relative-ref)) + :use-module ((web uri-query) :select (encode-query-parameters)) :use-module (sxml simple) :use-module (sxml xpath) @@ -345,6 +346,21 @@ (return (build-response code: 404) (format #f "No component with UID=~a found." uid)))) + (GET "/search/text" (q) + (return (build-response + code: 302 + headers: + `((location + . ,(build-relative-ref + path: "/search/" + query: + (encode-query-parameters + `((q . (regexp-exec + (make-regexp ,(->quoted-string q) + regexp/icase) + (prop event 'SUMMARY))))) + )))))) + (GET "/search" (q p) (define search-term (and=> q prepare-string)) @@ -359,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/calp/util.scm b/module/calp/util.scm index 25c753dc..7c176c50 100644 --- a/module/calp/util.scm +++ b/module/calp/util.scm @@ -533,6 +533,9 @@ (define-public ->string ->str) +(define-public (->quoted-string any) + (with-output-to-string (lambda () (write any)))) + (define-public (path-append . strings) (fold (lambda (s done) (string-append 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/module/web/uri-query.scm b/module/web/uri-query.scm new file mode 100644 index 00000000..868b1399 --- /dev/null +++ b/module/web/uri-query.scm @@ -0,0 +1,13 @@ +(define-module (web uri-query) + :use-module ((calp util) :select (->string)) + :use-module ((web uri) :select (uri-encode)) + ) + + +(define-public (encode-query-parameters parameters) + (string-join + (map (lambda (p) + (format #f "~a=~a" + (car p) + (uri-encode (->string (cdr p))))) + parameters))) diff --git a/static/style.scss b/static/style.scss index 3f92f8fc..322f62f3 100644 --- a/static/style.scss +++ b/static/style.scss @@ -165,6 +165,14 @@ html, body { } } +.simplesearch { + display: flex; + + input[type=text] { + flex-grow: 1; + } +} + /* Eventlist ---------------------------------------- The sidebar with all the events @@ -663,6 +671,15 @@ along with their colors. } } +.error { + border: 3px solid red; + background-color: pink; + + pre { + padding: 1em; + } +} + /* Popups ---------------------------------------- */ |