diff options
| -rw-r--r-- | guix-data-service/web/controller.scm | 83 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 21 |
2 files changed, 71 insertions, 33 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 245b775..584392a 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -109,30 +109,56 @@ conn commit-hash 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 commit-hash - #:limit-results (assq-ref query-parameters - 'limit_results) - #:after-name (assq-ref query-parameters - 'after_name)))) - (case (most-appropriate-mime-type - '(application/json text/html) - mime-types) - ((application/json) - (render-json - `((packages . ,(list->vector - (map (match-lambda - ((name version synopsis) - `((name . ,name) - (version . ,version) - (synopsis . ,synopsis)))) - packages)))))) - (else - (apply render-html - (view-revision-packages commit-hash - query-parameters - packages)))))) + search-query + #:limit-results limit-results) + (select-packages-in-revision + conn + commit-hash + #:limit-results limit-results + #:after-name (assq-ref query-parameters 'after_name)))) + (show-next-page? + (and (not search-query) + (>= (length packages) + limit-results)))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((packages . ,(list->vector + (map (match-lambda + ((name version synopsis) + `((name . ,name) + (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 conn @@ -452,10 +478,15 @@ commit-hash)) ((GET "revision" commit-hash "packages") (let ((parsed-query-parameters - (parse-query-parameters - request - `((after_name ,identity) - (limit_results ,parse-result-limit #:default 100))))) + (guard-against-mutually-exclusive-query-parameters + (parse-query-parameters + request + `((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 conn diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 825835b..079b23d 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -414,7 +414,8 @@ (define (view-revision-packages revision-commit-hash query-parameters - packages) + packages + show-next-page?) (layout #:extra-headers '((cache-control . ((max-age . 60)))) @@ -440,6 +441,10 @@ (action "") (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 "After name" query-parameters #:help-text "List packages that are alphabetically after the given name.") @@ -478,12 +483,14 @@ "/package/" name "/" version))) "More information"))))) packages))))) - (div - (@ (class "row")) - (a (@ (href ,(string-append "/revision/" revision-commit-hash - "/packages?after_name=" - (car (last packages))))) - "Next page")))))) + ,@(if show-next-page? + `((div + (@ (class "row")) + (a (@ (href ,(string-append "/revision/" revision-commit-hash + "/packages?after_name=" + (car (last packages))))) + "Next page"))) + '()))))) (define (view-branches branches-with-most-recent-commits) (layout |