Show lint warnings on the comparison page

3 files changed, 185 insertions, 10 deletions

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index 546f89c..9aa8863 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -13,7 +13,9 @@
             package-data-vhashes->new-packages
             package-data-vhashes->removed-packages
             package-data-version-changes
-            package-data-derivation-changes))
+            package-data-derivation-changes
+
+            lint-warning-differences-data))
 
 (define* (package-differences-data conn
                                    base_guix_revision_id
@@ -317,3 +319,127 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
                           (derivation-system-and-target-list->alist
                            target-derivations)))))))))
     names-and-versions)))
+
+(define (lint-warning-differences-data conn
+                                       base-guix-revision-id
+                                       target-guix-revision-id)
+  (define query
+    (string-append "
+WITH base_lint_warnings AS (
+  SELECT lint_warnings.id,
+         packages.name, packages.version,
+         lint_checkers.name AS lint_checker_name,
+         lint_checkers.description AS lint_checker_description,
+         lint_checkers.network_dependent AS lint_checker_network_dependent,
+         locations.file, locations.line, locations.column_number,
+         lint_warning_messages.message
+  FROM lint_warnings
+  INNER JOIN packages
+    ON lint_warnings.package_id = packages.id
+  INNER JOIN lint_checkers
+    ON lint_warnings.lint_checker_id = lint_checkers.id
+  INNER JOIN locations
+    ON lint_warnings.location_id = locations.id
+  INNER JOIN lint_warning_message_sets
+    ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id
+  INNER JOIN lint_warning_messages
+    ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids) AND
+       lint_warning_messages.locale = 'en_US.utf8'
+  WHERE lint_warnings.id IN (
+    SELECT lint_warning_id
+    FROM guix_revision_lint_warnings
+    WHERE guix_revision_id = $1
+  )
+), target_lint_warnings AS (
+  SELECT lint_warnings.id,
+         packages.name, packages.version,
+         lint_checkers.name AS lint_checker_name,
+         lint_checkers.description AS lint_checker_description,
+         lint_checkers.network_dependent AS lint_checker_network_dependent,
+         locations.file, locations.line, locations.column_number,
+         lint_warning_messages.message
+  FROM lint_warnings
+  INNER JOIN packages
+    ON lint_warnings.package_id = packages.id
+  INNER JOIN lint_checkers
+    ON lint_warnings.lint_checker_id = lint_checkers.id
+  INNER JOIN locations
+    ON lint_warnings.location_id = locations.id
+  INNER JOIN lint_warning_message_sets
+    ON lint_warnings.lint_warning_message_set_id = lint_warning_message_sets.id
+  INNER JOIN lint_warning_messages
+    ON lint_warning_messages.id = ANY (lint_warning_message_sets.message_ids) AND
+       lint_warning_messages.locale = 'en_US.utf8'
+  WHERE lint_warnings.id IN (
+    SELECT lint_warning_id
+    FROM guix_revision_lint_warnings
+    WHERE guix_revision_id = $2
+  )
+)
+SELECT coalesce(
+         base_lint_warnings.name,
+         target_lint_warnings.name
+       ) AS package_name,
+       coalesce(
+         base_lint_warnings.version,
+         target_lint_warnings.version
+       ) AS package_version,
+       coalesce(
+         base_lint_warnings.lint_checker_name,
+         target_lint_warnings.lint_checker_name
+       ) AS lint_checker_name,
+       coalesce(
+         base_lint_warnings.message,
+         target_lint_warnings.message
+       ) AS message,
+       coalesce(
+         base_lint_warnings.lint_checker_description,
+         target_lint_warnings.lint_checker_description
+       ) AS lint_checker_description,
+       coalesce(
+         base_lint_warnings.lint_checker_network_dependent,
+         target_lint_warnings.lint_checker_network_dependent
+       ) AS lint_checker_network_dependent,
+       coalesce(
+         base_lint_warnings.file,
+         target_lint_warnings.file
+       ) AS file,
+       coalesce(
+         base_lint_warnings.line,
+         target_lint_warnings.line
+       ) AS line,
+       coalesce(
+         base_lint_warnings.column_number,
+         target_lint_warnings.column_number
+       ) AS column_number,
+       CASE
+         WHEN base_lint_warnings.name IS NULL THEN 'new'
+         WHEN target_lint_warnings.name IS NULL THEN 'removed'
+         ELSE 'moved'
+       END AS change
+FROM base_lint_warnings
+FULL OUTER JOIN target_lint_warnings
+  ON base_lint_warnings.name = target_lint_warnings.name
+  AND base_lint_warnings.lint_checker_name = target_lint_warnings.lint_checker_name
+  AND (
+    base_lint_warnings.message = target_lint_warnings.message OR
+    -- TODO Some lint warnings include the line number in the message, so
+    -- they'll appear to be altered if the package definition moves within the
+    -- file, therefore try replacing the line number to see if the message matches
+    -- that way as well
+    replace(base_lint_warnings.message,base_lint_warnings.line::varchar,target_lint_warnings.line::varchar) = target_lint_warnings.message
+  )
+WHERE
+  (
+    base_lint_warnings.id IS NULL OR
+    target_lint_warnings.id IS NULL OR
+    base_lint_warnings.id != target_lint_warnings.id
+  ) AND (
+    base_lint_warnings.name IS NULL OR
+    target_lint_warnings.name IS NULL
+  )
+ORDER BY coalesce(base_lint_warnings.name, target_lint_warnings.name) ASC, base_lint_warnings.version, target_lint_warnings.version, change"))
+
+  (exec-query conn query
+              (list base-guix-revision-id
+                    target-guix-revision-id)))
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 038af58..58b824e 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -43,6 +43,7 @@
   #:use-module (guix-data-service model build)
   #:use-module (guix-data-service model lint-checker)
   #:use-module (guix-data-service model lint-warning)
+  #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service jobs load-new-guix-revision)
   #:use-module (guix-data-service web render)
   #:use-module (guix-data-service web sxml)
@@ -469,7 +470,13 @@
                                                     target-packages-vhash))
            (version-changes
             (package-data-version-changes base-packages-vhash
-                                          target-packages-vhash)))
+                                          target-packages-vhash))
+           (lint-warnings-data
+            (group-list-by-first-n-fields
+             2
+             (lint-warning-differences-data conn
+                                            base-revision-id
+                                            target-revision-id))))
       (case (most-appropriate-mime-type
              '(application/json text/html)
              mime-types)
@@ -495,7 +502,8 @@
                                  target-revision-id))
                           new-packages
                           removed-packages
-                          version-changes)
+                          version-changes
+                          lint-warnings-data)
           #:extra-headers http-headers-for-unchanging-content))))))
 
 (define (render-compare/derivations mime-types
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index e8c7a09..5cd2023 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -1429,7 +1429,8 @@
                  cgit-url-bases
                  new-packages
                  removed-packages
-                 version-changes)
+                 version-changes
+                 lint-warnings-data)
   (define query-params
     (string-append "?base_commit=" base-commit
                    "&target_commit=" target-commit))
@@ -1573,12 +1574,52 @@
                                                       "/package/"
                                                       name "/" version)))
                                                 ,version)))
-                                        (vector->list versions)))
-                                   ,(if (eq? type 'base)
-                                        " (old)"
-                                        " (new)"))))
-                            versions))))))
-                  version-changes))))))))))
+                                      (vector->list versions)))
+                                  ,(if (eq? type 'base)
+                                       " (old)"
+                                       " (new)"))))
+                          versions))))))
+                version-changes))))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h2 "Lint warnings")
+        ,@(map
+           (match-lambda
+             (((package-name package-version) . warnings)
+              `((h4 ,package-name " (version: " ,package-version ")")
+                (table
+                 (@ (class "table"))
+                 (thead
+                  (tr
+                   (th "")
+                   (th "Linter")
+                   (th "Message")))
+                 (tbody
+                  ,@(map (match-lambda
+                           ((lint-checker-name
+                             message
+                             lint-checker-description
+                             lint-checker-network-dependent
+                             file line column-number ;; TODO Maybe use the location?
+                             change)
+
+                            `(tr
+                              (td (@ (class ,(if (string=? change "new")
+                                                 "text-danger"
+                                                 "text-success"))
+                                     (style "font-weight: bold"))
+                                  ,(if (string=? change "new")
+                                       "New warning"
+                                       "Resolved warning"))
+                              (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))))
+                         warnings))))))
+           lint-warnings-data)))))))
 
 (define (compare/derivations query-parameters
                              valid-systems