From d3254dddb68980c26edc35539346dcf455e01fba Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 1 Sep 2019 18:26:46 +0100 Subject: Add lint warnings to the package page --- guix-data-service/model/lint-warning.scm | 40 ++++++++++++++++++++++- guix-data-service/web/controller.scm | 9 +++++- guix-data-service/web/view/html.scm | 55 +++++++++++++++++++++++++++++++- 3 files changed, 101 insertions(+), 3 deletions(-) diff --git a/guix-data-service/model/lint-warning.scm b/guix-data-service/model/lint-warning.scm index 25678a8..7cd3ae4 100644 --- a/guix-data-service/model/lint-warning.scm +++ b/guix-data-service/model/lint-warning.scm @@ -3,7 +3,8 @@ #:use-module (guix-data-service model utils) #:export (lint-warnings-data->lint-warning-ids insert-guix-revision-lint-warnings - lint-warnings-for-guix-revision)) + lint-warnings-for-guix-revision + select-lint-warnings-by-revision-package-name-and-version)) (define (lint-warnings-data->lint-warning-ids conn @@ -94,3 +95,40 @@ INNER JOIN lint_warning_messages ,@(if message-query (list message-query) '())))) + +(define (select-lint-warnings-by-revision-package-name-and-version conn + commit-hash + name version) + (define query " +SELECT lint_warnings.id, lint_checkers.name, lint_checkers.description, + lint_checkers.network_dependent, + locations.file, locations.line, locations.column_number, + lint_warning_messages.message +FROM lint_warnings +INNER JOIN lint_checkers + ON lint_checkers.id = lint_warnings.lint_checker_id +INNER JOIN packages + ON lint_warnings.package_id = packages.id +LEFT OUTER JOIN locations + ON lint_warnings.location_id = locations.id +INNER JOIN lint_warning_message_sets + ON lint_warning_message_sets.id = lint_warning_message_set_id +INNER JOIN lint_warning_messages + ON lint_warning_messages.locale = 'en_US.utf8' + AND lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids) +WHERE packages.id IN ( + SELECT package_derivations.package_id + FROM package_derivations + INNER JOIN guix_revision_package_derivations + ON package_derivations.id = + guix_revision_package_derivations.package_derivation_id + INNER JOIN guix_revisions + ON guix_revision_package_derivations.revision_id = guix_revisions.id + WHERE guix_revisions.commit = $1 +) + AND packages.name = $2 + AND packages.version = $3") + + (exec-query conn + query + (list commit-hash name version))) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 8712121..b305823 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -301,7 +301,13 @@ version)) (git-repositories (git-repositories-containing-commit conn - commit-hash))) + commit-hash)) + (lint-warnings + (select-lint-warnings-by-revision-package-name-and-version + conn + commit-hash + name + version))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) @@ -330,6 +336,7 @@ metadata derivations git-repositories + lint-warnings #:header-text header-text #:header-link header-link) #:extra-headers http-headers-for-unchanging-content))))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 982b5f2..3e9a5b9 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -290,6 +290,7 @@ (define* (view-revision-package-and-version revision-commit-hash name version package-metadata derivations git-repositories + lint-warnings #:key header-text header-link) (layout @@ -375,7 +376,59 @@ (td (a (@ (href ,file-name)) ,(display-store-item-short file-name))) (td ,(build-status-span status))))) - derivations))))))))) + derivations))))) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h3 "Lint warnings") + (table + (@ (class "table")) + (thead + (tr + (th "Linter") + (th "Message") + (th "Location"))) + (tbody + ,@(map + (match-lambda + ((id lint-checker-name lint-checker-description + lint-checker-network-dependent + file line-number column-number + message) + `(tr + (td (span (@ (style "font-family: monospace; display: block;")) + ,lint-checker-name) + (p (@ (style "font-size: small; margin: 6px 0 0px;")) + ,lint-checker-description)) + (td ,message) + (td + ,@(if (and file (not (string-null? file))) + `((ul + ,@(map + (match-lambda + ((id label url cgit-url-base) + (let ((output + `(,file + " " + (span + (@ (style "white-space: nowrap")) + "(line: " ,line-number + ", column: " ,column-number ")")))) + (if + (and cgit-url-base + (not (string-null? cgit-url-base))) + `(li + (a (@ (href + ,(string-append + cgit-url-base "tree/" + file "?id=" revision-commit-hash + "#n" line-number))) + ,@output)) + `(li ,@output))))) + git-repositories))) + '()))))) + lint-warnings))))))))) (define (view-revision/git-repositories git-repositories-and-branches commit-hash) -- cgit v1.2.3