Add a textual search to the packages page

This commit is contained in:
Christopher Baines 2019-05-12 21:17:08 +01:00
parent b151d8bb78
commit 9aaab6b751
2 changed files with 71 additions and 33 deletions

View file

@ -109,30 +109,56 @@
conn conn
commit-hash commit-hash
query-parameters) query-parameters)
(let ((packages (select-packages-in-revision (if (any-invalid-query-parameters? query-parameters)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
`((error . "invalid query"))))
(else
(apply render-html
(view-revision-packages commit-hash
query-parameters
'()
#f))))
(let* ((search-query (assq-ref query-parameters 'search_query))
(limit-results (assq-ref query-parameters 'limit_results))
(packages
(if search-query
(search-packages-in-revision
conn conn
commit-hash commit-hash
#:limit-results (assq-ref query-parameters search-query
'limit_results) #:limit-results limit-results)
#:after-name (assq-ref query-parameters (select-packages-in-revision
'after_name)))) conn
(case (most-appropriate-mime-type commit-hash
'(application/json text/html) #:limit-results limit-results
mime-types) #:after-name (assq-ref query-parameters 'after_name))))
((application/json) (show-next-page?
(render-json (and (not search-query)
`((packages . ,(list->vector (>= (length packages)
(map (match-lambda limit-results))))
((name version synopsis) (case (most-appropriate-mime-type
`((name . ,name) '(application/json text/html)
(version . ,version) mime-types)
(synopsis . ,synopsis)))) ((application/json)
packages)))))) (render-json
(else `((packages . ,(list->vector
(apply render-html (map (match-lambda
(view-revision-packages commit-hash ((name version synopsis)
query-parameters `((name . ,name)
packages)))))) (version . ,version)
(synopsis . ,synopsis))))
packages))))))
(else
(apply render-html
(view-revision-packages commit-hash
query-parameters
packages
show-next-page?)))))))
(define (render-revision-package mime-types (define (render-revision-package mime-types
conn conn
@ -452,10 +478,15 @@
commit-hash)) commit-hash))
((GET "revision" commit-hash "packages") ((GET "revision" commit-hash "packages")
(let ((parsed-query-parameters (let ((parsed-query-parameters
(parse-query-parameters (guard-against-mutually-exclusive-query-parameters
request (parse-query-parameters
`((after_name ,identity) request
(limit_results ,parse-result-limit #:default 100))))) `((after_name ,identity)
(search_query ,identity)
(limit_results ,parse-result-limit #:default 100)))
;; You can't specify a search query, but then also limit the
;; results by filtering for after a particular package name
'((after_name search_query)))))
(render-revision-packages mime-types (render-revision-packages mime-types
conn conn

View file

@ -414,7 +414,8 @@
(define (view-revision-packages revision-commit-hash (define (view-revision-packages revision-commit-hash
query-parameters query-parameters
packages) packages
show-next-page?)
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -439,6 +440,10 @@
(@ (method "get") (@ (method "get")
(action "") (action "")
(class "form-horizontal")) (class "form-horizontal"))
,(form-horizontal-control
"Search query" query-parameters
#:help-text
"List packages where the name or synopsis match the query.")
,(form-horizontal-control ,(form-horizontal-control
"After name" query-parameters "After name" query-parameters
#:help-text #:help-text
@ -478,12 +483,14 @@
"/package/" name "/" version))) "/package/" name "/" version)))
"More information"))))) "More information")))))
packages))))) packages)))))
(div ,@(if show-next-page?
(@ (class "row")) `((div
(a (@ (href ,(string-append "/revision/" revision-commit-hash (@ (class "row"))
"/packages?after_name=" (a (@ (href ,(string-append "/revision/" revision-commit-hash
(car (last packages))))) "/packages?after_name="
"Next page")))))) (car (last packages)))))
"Next page")))
'())))))
(define (view-branches branches-with-most-recent-commits) (define (view-branches branches-with-most-recent-commits)
(layout (layout