From 2007e3d8891bb8733c34ceff7cba826760bddfc2 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Mon, 11 Jul 2022 00:43:59 +0530
Subject: web: server: Summarize number of results by type.
* tissue/web/server.scm (%css)[.search-results-statistics,
.search-results-statistics li, .search-results-statistics a,
.current-search-type]: New rules.
* tissue/web/server.scm (make-search-page): Summarize number of
results by type.
(query-string, matches): New functions.
(handler): Pass the number of matches by type to make-search-page.
* issues/add-links-to-filter-documents-by-type.gmi: Close issue.
---
issues/add-links-to-filter-documents-by-type.gmi | 3 +
tissue/web/server.scm | 107 ++++++++++++++++++++---
2 files changed, 98 insertions(+), 12 deletions(-)
diff --git a/issues/add-links-to-filter-documents-by-type.gmi b/issues/add-links-to-filter-documents-by-type.gmi
index 533e0f7..095e5cf 100644
--- a/issues/add-links-to-filter-documents-by-type.gmi
+++ b/issues/add-links-to-filter-documents-by-type.gmi
@@ -3,3 +3,6 @@
* tags: enhancement, web ui
Currently, in the web UI, if the user wants to filter by document type (issues, other documents, etc.), they need to add terms such as type:issue or type:document to the search query. The casual user is not going to learn this search query syntax, and this is going to lead to a lot of confusion. It would be much better to add links to quickly filter by document type. These links will be graphical aids that any user can click with ease.
+
+This is implemented now.
+* closed
diff --git a/tissue/web/server.scm b/tissue/web/server.scm
index 39d63e2..21fbf4a 100644
--- a/tissue/web/server.scm
+++ b/tissue/web/server.scm
@@ -60,6 +60,17 @@ form { text-align: center; }
padding: 0 0.2em;
}
+.search-results-statistics {
+ list-style: none;
+ padding: 0;
+}
+.search-results-statistics li {
+ display: inline;
+ margin: 0.5em;
+}
+.search-results-statistics a { color: blue; }
+.current-search-type { font-weight: bold; }
+
.search-results { padding: 0; }
.search-result {
list-style-type: none;
@@ -112,10 +123,24 @@ a.tag-chore {
color: black;
}")
-(define (make-search-page results query estimated-matches css)
- "Return SXML for a page with search RESULTS produced for
-QUERY. ESTIMATED-MATCHES is the estimated number of matches. CSS is a
-URI to a stylesheet."
+(define* (make-search-page results query css
+ #:key
+ page-uri-path page-uri-parameters
+ matches
+ matched-open-issues matched-closed-issues
+ matched-documents matched-commits
+ current-search-type)
+ "Return SXML for a page with search RESULTS produced for QUERY.
+
+CSS is a URI to a stylesheet. PAGE-URI-PATH is the path part of the
+URI to the page. PAGE-URI-PARAMETERS is an association list of
+parameters in the query string of the URI of the page.
+
+MATCHES is the number of matches. MATCHED-OPEN-ISSUES,
+MATCHED-CLOSED-ISSUES, MATCHED-DOCUMENTS and MATCHED-COMMITS are
+respectively the number of open issues, closed issues, documents and
+commits matching the current query. CURRENT-SEARCH-TYPE is the type of
+document search results are being showed for."
`(html
(head
(title "Tissue search")
@@ -131,6 +156,9 @@ URI to a stylesheet."
(name "query")
(value ,query)
(placeholder "Enter search query")))
+ (input (@ (type "hidden")
+ (name "type")
+ (value ,(symbol->string current-search-type))))
(input (@ (type "submit") (value "Search"))))
(details (@ (class "search-hint"))
(summary "Hint")
@@ -156,9 +184,24 @@ operators "
(span (@ (class "search-filter"))
"OR")
"."))
- (p "Found an estimated "
- (strong ,(string-append (number->string estimated-matches))
- " results"))
+ ,(let ((search-result-statistic
+ (lambda (search-type format-string matches)
+ `(li (a (@ (href ,(string-append
+ page-uri-path
+ "?"
+ (query-string
+ (acons "type" (symbol->string search-type)
+ (alist-delete "type" page-uri-parameters)))))
+ ,@(if (eq? search-type current-search-type)
+ '((class "current-search-type"))
+ '()))
+ ,(format #f format-string matches))))))
+ `(ul (@ (class "search-results-statistics"))
+ ,(search-result-statistic 'all "~a All" matches)
+ ,(search-result-statistic 'open-issue "~a open issues" matched-open-issues)
+ ,(search-result-statistic 'closed-issue "~a closed issues" matched-closed-issues)
+ ,(search-result-statistic 'document "~a documents" matched-documents)
+ ,(search-result-statistic 'commit "~a commits" matched-commits)))
(ul (@ (class "search-results"))
,@results))))
@@ -173,6 +216,17 @@ operators "
(string-split query #\&))
'()))
+(define (query-string parameters)
+ "Return a query string for association list of PARAMETERS."
+ (string-join
+ (map (match-lambda
+ ((key . value)
+ (string-append (uri-encode key)
+ "="
+ (uri-encode value))))
+ parameters)
+ "&"))
+
(define %mime-types
'(("gif" image/gif)
("html" text/html)
@@ -185,6 +239,17 @@ operators "
("svg" image/svg+xml)
("txt" text/plain)))
+(define (matches db search-query filter)
+ "Return the number of matches in DB for SEARCH-QUERY filtering with
+FILTER query."
+ (MSet-get-matches-estimated
+ (enquire-mset
+ (enquire
+ db (new-Query (Query-OP-FILTER)
+ (parse-query search-query)
+ filter))
+ #:maximum-items (database-document-count db))))
+
(define (handler request body hosts state-directory)
"Handle web REQUEST with BODY and return two values---the response
headers and body.
@@ -208,13 +273,24 @@ STATE-DIRECTORY."
(cond
;; Search page
((member path (list "/" "/search"))
- (let ((search-query (or (assoc-ref parameters "query")
- "")))
+ (let* ((search-query (or (assoc-ref parameters "query")
+ ""))
+ (search-type (match (assoc-ref parameters "type")
+ ((or "open-issue" "closed-issue" "commit" "document")
+ (string->symbol (assoc-ref parameters "type")))
+ (_ 'all)))
+ (filter-alist `((open-issue . ,(parse-query "type:issue AND is:open"))
+ (closed-issue . ,(parse-query "type:issue AND is:closed"))
+ (commit . ,(parse-query "type:commit"))
+ (document . ,(parse-query "type:document")))))
(values '((content-type . (text/html)))
(sxml->html
(call-with-database (string-append state-directory "/" hostname "/xapian")
(lambda (db)
- (let ((mset (enquire-mset (enquire db (parse-query search-query))
+ (let ((mset (enquire-mset (enquire db (new-Query (Query-OP-FILTER)
+ (parse-query search-query)
+ (or (assq-ref filter-alist search-type)
+ (Query-MatchAll))))
#:offset 0
#:maximum-items (database-document-count db))))
(make-search-page
@@ -228,8 +304,15 @@ STATE-DIRECTORY."
'()
mset))
search-query
- (MSet-get-matches-estimated mset)
- (assq-ref host-parameters 'css)))))))))
+ (assq-ref host-parameters 'css)
+ #:page-uri-path path
+ #:page-uri-parameters parameters
+ #:matches (matches db search-query (Query-MatchAll))
+ #:matched-open-issues (matches db search-query (assq-ref filter-alist 'open-issue))
+ #:matched-closed-issues (matches db search-query (assq-ref filter-alist 'closed-issue))
+ #:matched-documents (matches db search-query (assq-ref filter-alist 'document))
+ #:matched-commits (matches db search-query (assq-ref filter-alist 'commit))
+ #:current-search-type search-type))))))))
;; Static files
((let ((file-path
(find file-exists?
--
cgit v1.2.3