Add lint warnings to the package page

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)