03/04: hydra/goggles: Add search page.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository maintenance.

commit f74c3e724a1d4e17cf2f7727b5affe17d28c7793
Author: Ricardo Wurmus <address@hidden>
AuthorDate: Fri Apr 24 14:02:31 2020 +0200

    hydra/goggles: Add search page.
    
    * hydra/goggles.scm (css): Add table styles.
    (search-results, parse-query-string): New procedures.
    (->): New macro.
    (%controller): Add route for search.
---
 hydra/goggles.scm | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/hydra/goggles.scm b/hydra/goggles.scm
index 0daf534..02b76e4 100755
--- a/hydra/goggles.scm
+++ b/hydra/goggles.scm
@@ -144,6 +144,14 @@ h2 {
   font-weight: 200;
 }
 
+table td {
+  padding: 0.75em;
+}
+
+table tr:hover {
+  background: #eee;
+}
+
 .nick {
   padding-right: 0.6rem;
   font-weight: bold;
@@ -281,10 +289,60 @@ freenode." channel))
              (or (channel-files channel)
                  '()))))))
 
+(define (search-results channel query)
+  `(html
+    (head (title ,(string-append "Search " channel " IRC channel logs"))
+          (style ,css))
+    (body
+     (h1 ,(string-append "Search " channel " IRC channel logs"))
+     (form
+      (@ (action "search"))
+      (input (@ (name "query")
+                (placeholder "nick:rekado frobnicate")) "")
+      (button (@ (type "submit")) "Search!"))
+     ,@(if (and query (not (string-null? query)))
+           (let* ((results (search (format #f "channel:~a ~a" channel query))))
+             `((p "These are the channel logs matching your query " (code 
,query))
+               (table
+                (tbody
+                 ,(map (lambda (result)
+                         `(tr (td
+                               (a (@ (href ,(string-append "/" channel "/"
+                                                           (assoc-ref result 
'stamp)
+                                                           ".log#"
+                                                           (assoc-ref result 
'id))))
+                                  ,(assoc-ref result 'stamp)))
+                              (td ,(assoc-ref result 'text))))
+                       (sort results
+                             (lambda (a b)
+                               (string< (assoc-ref a 'stamp)
+                                        (assoc-ref b 'stamp)))))))))
+           '()))))
+
+(define-syntax-rule (-> target functions ...)
+  (fold (lambda (f val) (and=> val f))
+        target
+        (list functions ...)))
+
+(define (parse-query-string query)
+  "Parse and decode the URI query string QUERY and return an alist."
+  (let lp ((lst (map uri-decode (string-split query (char-set #\& #\=)))))
+    (match lst
+      ((key value . rest)
+       (cons (cons key value) (lp rest)))
+      (() '()))))
+
 (define (%controller request)
   (match-lambda
     (('GET)
      (render-html (index "guix")))
+    (('GET (? (cut member <> (assoc-ref %config 'channels)) channel) "search")
+     (let ((query (-> request
+                      request-uri
+                      uri-query
+                      parse-query-string
+                      (cut assoc-ref <> "query"))))
+       (render-html (search-results channel query))))
     (('GET (? (cut member <> (assoc-ref %config 'channels)) channel))
      (render-html (index channel)))
     (('GET (? (cut member <> (assoc-ref %config 'channels)) channel) path ...)