From 83012b101b2a900d1bccfcb8ed9deab2aa002e9a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 16 May 2019 22:28:16 +0100 Subject: Allow specifying the fields on the packages page This is mostly for the JSON output, as it allows much more information to be included. --- guix-data-service/model/package.scm | 31 ++++++++- guix-data-service/web/controller.scm | 64 ++++++++++++++++-- guix-data-service/web/view/html.scm | 126 ++++++++++++++++++++++++++++------- 3 files changed, 189 insertions(+), 32 deletions(-) diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 39fa64d..1579469 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -35,10 +35,23 @@ (define query (string-append " WITH data AS ( - SELECT packages.name, packages.version, package_metadata.synopsis + SELECT packages.name, packages.version, package_metadata.synopsis, + package_metadata.description, package_metadata.home_page, + locations.file, locations.line, locations.column_number, + (SELECT JSON_AGG((license_data.*)) + FROM ( + SELECT licenses.name, licenses.uri, licenses.comment + FROM licenses + INNER JOIN license_sets ON licenses.id = ANY(license_sets.license_ids) + WHERE license_sets.id = package_metadata.license_set_id + ORDER BY licenses.name + ) AS license_data + ) AS licenses FROM packages INNER JOIN package_metadata ON packages.package_metadata_id = package_metadata.id + LEFT OUTER JOIN locations + ON package_metadata.location_id = locations.id WHERE packages.id IN ( SELECT package_derivations.package_id FROM package_derivations @@ -78,10 +91,24 @@ WHERE data.name IN (SELECT name FROM package_names);")) " SELECT packages.name, packages.version, - package_metadata.synopsis + package_metadata.synopsis, + package_metadata.description, + package_metadata.home_page, + locations.file, locations.line, locations.column_number, + (SELECT JSON_AGG((license_data.*)) + FROM ( + SELECT licenses.name, licenses.uri, licenses.comment + FROM licenses + INNER JOIN license_sets ON licenses.id = ANY(license_sets.license_ids) + WHERE license_sets.id = package_metadata.license_set_id + ORDER BY licenses.name + ) AS license_data + ) AS licenses FROM packages INNER JOIN package_metadata ON packages.package_metadata_id = package_metadata.id +LEFT OUTER JOIN locations + ON package_metadata.location_id = locations.id WHERE packages.id IN ( SELECT package_derivations.package_id FROM package_derivations diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 6b4167d..67db909 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -25,7 +25,11 @@ #:use-module (srfi srfi-26) #:use-module (web request) #:use-module (web uri) + #:use-module (texinfo) + #:use-module (texinfo html) + #:use-module (texinfo plain-text) #:use-module (squee) + #:use-module (json) #:use-module (guix-data-service comparison) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-repository) @@ -38,6 +42,7 @@ #:use-module (guix-data-service model build) #:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service web render) + #:use-module (guix-data-service web sxml) #:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web util) #:use-module (guix-data-service web view html) @@ -105,6 +110,14 @@ packages-count derivations-counts)))))) +(define (texinfo->variants-alist s) + (let ((stexi (texi-fragment->stexi s))) + `((source . ,s) + (html . ,(with-output-to-string + (lambda () + (sxml->html (stexi->shtml stexi))))) + (plain . ,(stexi->plain-text stexi))))) + (define (render-revision-packages mime-types conn commit-hash @@ -121,10 +134,12 @@ (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)) + (fields (assq-ref query-parameters 'field)) (packages (if search-query (search-packages-in-revision @@ -137,6 +152,9 @@ commit-hash #:limit-results limit-results #:after-name (assq-ref query-parameters 'after_name)))) + (git-repositories + (git-repositories-containing-commit conn + commit-hash)) (show-next-page? (and (not search-query) (>= (length packages) @@ -146,18 +164,48 @@ mime-types) ((application/json) (render-json - `((packages . ,(list->vector - (map (match-lambda - ((name version synopsis) - `((name . ,name) - (version . ,version) - (synopsis . ,synopsis)))) - packages)))))) + `((revision + . ((commit . ,commit-hash))) + (packages + . ,(list->vector + (map (match-lambda + ((name version synopsis description home-page + location-file location-line + location-column-number licenses) + `((name . ,name) + ,@(if (member "version" fields) + `((version . ,version)) + '()) + ,@(if (member "synopsis" fields) + `((synopsis + . ,(texinfo->variants-alist synopsis))) + '()) + ,@(if (member "description" fields) + `((description + . ,(texinfo->variants-alist description))) + '()) + ,@(if (member "home-page" fields) + `((home-page . ,home-page)) + '()) + ,@(if (member "location" fields) + `((location + . ((file . ,location-file) + (line . ,location-line) + (column . ,location-column-number)))) + '()) + ,@(if (member "licenses" fields) + `((licenses + . ,(if (string-null? licenses) + #() + (json-string->scm licenses)))) + '())))) + packages)))))) (else (apply render-html (view-revision-packages commit-hash query-parameters packages + git-repositories show-next-page?))))))) (define (render-revision-package mime-types @@ -486,6 +534,8 @@ (parse-query-parameters request `((after_name ,identity) + (field ,identity #:multi-value + #:default ("version" "synopsis")) (search_query ,identity) (limit_results ,parse-result-limit #:default 100))) ;; You can't specify a search query, but then also limit the diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 95f628a..05d3b60 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-19) #:use-module (texinfo) #:use-module (texinfo html) + #:use-module (json) #:export (index view-statistics view-revision-package-and-version @@ -97,6 +98,7 @@ (define* (form-horizontal-control label query-parameters #:key + name help-text required? options) @@ -111,8 +113,9 @@ (string-downcase label))) (help-span-id (string-append input-id "-help-text")) - (input-name (underscore-join-words - (string-downcase label))) + (input-name (or name + (underscore-join-words + (string-downcase label)))) (has-error? (invalid-query-parameter? (assq-ref query-parameters (string->symbol input-name)))) @@ -144,12 +147,20 @@ value) (_ '())))) - (map (lambda (option-value) - `(option - (@ ,@(if (member option-value selected-options) - '((selected "")) - '())) - ,(value->text option-value))) + (map (match-lambda + ((option-value) + `(option + (@ ,@(if (member option-value selected-options) + '((selected "")) + '())) + ,(value->text option-value))) + ((option-label . option-value) + `(option + (@ ,@(if (member option-value selected-options) + '((selected "")) + '()) + (value ,option-value)) + ,(value->text option-label)))) options))) `(input (@ (class "form-control") (style "font-family: monospace;") @@ -445,7 +456,17 @@ (define (view-revision-packages revision-commit-hash query-parameters packages + git-repositories show-next-page?) + (define field-options + (map + (lambda (field) + (cons field + (hyphenate-words + (string-downcase field)))) + '("Version" "Synopsis" "Description" + "Home page" "Location" "Licenses"))) + (layout #:extra-headers '((cache-control . ((max-age . 60)))) @@ -474,6 +495,11 @@ "Search query" query-parameters #:help-text "List packages where the name or synopsis match the query.") + ,(form-horizontal-control + "Fields" query-parameters + #:name "field" + #:options field-options + #:help-text "Fields to return in the response.") ,(form-horizontal-control "After name" query-parameters #:help-text @@ -496,23 +522,77 @@ (thead (tr (th (@ (class "col-md-3")) "Name") - (th (@ (class "col-md-3")) "Version") - (th (@ (class "col-md-3")) "Synopsis") + ,@(filter-map + (match-lambda + ((label . value) + (if (member value (assq-ref query-parameters 'field)) + `(th (@ (class "col-md-3")) ,label) + #f))) + field-options) (th (@ (class "col-md-3")) ""))) (tbody - ,@(map - (match-lambda - ((name version synopsis) - `(tr - (td ,name) - (td ,version) - (td ,(stexi->shtml (texi-fragment->stexi synopsis))) - (td (@ (class "text-right")) - (a (@ (href ,(string-append - "/revision/" revision-commit-hash - "/package/" name "/" version))) - "More information"))))) - packages))))) + ,@(let ((fields (assq-ref query-parameters 'field))) + (map + (match-lambda + ((name version synopsis description home-page + location-file location-line + location-column-number licenses) + `(tr + (td ,name) + ,@(if (member "version" fields) + `((td ,version)) + '()) + ,(if (member "synopsis" fields) + `((td ,(stexi->shtml (texi-fragment->stexi synopsis)))) + '()) + ,(if (member "description" fields) + `((td ,(stexi->shtml (texi-fragment->stexi description)))) + '()) + ,(if (member "home-page" fields) + `((td ,home-page)) + '()) + ,(if (member "location" fields) + `((td + ,@(if (and location-file + (not (string-null? location-file))) + `((ul + ,@(map + (match-lambda + ((id label url cgit-url-base) + (if + (and cgit-url-base + (not (string-null? cgit-url-base))) + `(li + (a (@ (href + ,(string-append + cgit-url-base "tree/" + location-file "?id=" revision-commit-hash + "#n" location-line))) + ,location-file + " (line: " ,location-line + ", column: " ,location-column-number ")")) + `(li ,location-file + " (line: " ,location-line + ", column: " ,location-column-number ")")))) + git-repositories))) + '()))) + '()) + ,(if (member "licenses" fields) + `((td + (ul + (@ (class "list-inline")) + ,@(map (lambda (license) + `(li (a (@ (href ,(assoc-ref license "uri"))) + ,(assoc-ref license "name")))) + (vector->list + (json-string->scm licenses)))))) + '()) + (td (@ (class "text-right")) + (a (@ (href ,(string-append + "/revision/" revision-commit-hash + "/package/" name "/" version))) + "More information"))))) + packages)))))) ,@(if show-next-page? `((div (@ (class "row")) -- cgit v1.2.3