Add a new table guix_revision_lint_checkers

To associate a set of lint checkers with a specific revision. While there is
the association through the lint warnings, that only works for checkers where
there are lint warnings for that revision.

Therefore, to allow finding all the checkers for a specific revision, also
associate them directly with the revision.

6 files changed, 95 insertions, 45 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index b146afc..75eae4d 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -457,50 +457,46 @@ WHERE job_id = $1"
                  conn packages packages-metadata-ids)))))
 
 (define (insert-lint-warnings conn inferior-package-id->package-database-id
+                              lint-checker-ids
                               lint-warnings-data)
-  (let ((lint-checker-ids
-         (lint-checkers->lint-checker-ids
-          conn
-          (map car lint-warnings-data))))
-
-    (lint-warnings-data->lint-warning-ids
-     conn
-     (append-map
-      (lambda (lint-checker-id warnings-by-package-id)
-        (append-map
-         (match-lambda
-           ((package-id . warnings)
-            (map
-             (match-lambda
-               ((location-data messages-by-locale)
-                (let ((location-id
-                       (location->location-id
-                        conn
-                        (apply location location-data)))
-                      (lint-warning-message-set-id
-                       (lint-warning-message-data->lint-warning-message-set-id
-                        conn
-                        messages-by-locale)))
-                  (list lint-checker-id
-                        (inferior-package-id->package-database-id package-id)
-                        location-id
-                        lint-warning-message-set-id))))
-             (fold (lambda (location-and-messages result)
-                     (if (member location-and-messages result)
-                         (begin
-                           (apply
-                            simple-format
-                            (current-error-port)
-                            "warning: skipping duplicate lint warning ~A ~A"
-                            location-and-messages)
-                           result)
-                         (append result
-                                 (list location-and-messages))))
-                   '()
-                   warnings))))
-         warnings-by-package-id))
-      lint-checker-ids
-      (map cdr lint-warnings-data)))))
+  (lint-warnings-data->lint-warning-ids
+   conn
+   (append-map
+    (lambda (lint-checker-id warnings-by-package-id)
+      (append-map
+       (match-lambda
+         ((package-id . warnings)
+          (map
+           (match-lambda
+             ((location-data messages-by-locale)
+              (let ((location-id
+                     (location->location-id
+                      conn
+                      (apply location location-data)))
+                    (lint-warning-message-set-id
+                     (lint-warning-message-data->lint-warning-message-set-id
+                      conn
+                      messages-by-locale)))
+                (list lint-checker-id
+                      (inferior-package-id->package-database-id package-id)
+                      location-id
+                      lint-warning-message-set-id))))
+           (fold (lambda (location-and-messages result)
+                   (if (member location-and-messages result)
+                       (begin
+                         (apply
+                          simple-format
+                          (current-error-port)
+                          "warning: skipping duplicate lint warning ~A ~A"
+                          location-and-messages)
+                         result)
+                       (append result
+                               (list location-and-messages))))
+                 '()
+                 warnings))))
+       warnings-by-package-id))
+    lint-checker-ids
+    (map cdr lint-warnings-data))))
 
 (define (inferior-data->package-derivation-ids
          conn inf
@@ -807,10 +803,15 @@ WHERE job_id = $1"
                #t "debug: finished loading information from inferior\n")
               (close-inferior inf)
 
-              (let* ((lint-warning-ids
+              (let* ((lint-checker-ids
+                      (lint-checkers->lint-checker-ids
+                       conn
+                       (map car inferior-lint-warnings)))
+                     (lint-warning-ids
                       (insert-lint-warnings
                        conn
                        inferior-package-id->package-database-id
+                       lint-checker-ids
                        inferior-lint-warnings))
                      (package-derivation-ids
                       (inferior-data->package-derivation-ids
@@ -820,6 +821,10 @@ WHERE job_id = $1"
                       (insert-guix-revision conn git-repository-id
                                             commit store-path)))
 
+                (insert-guix-revision-lint-checkers conn
+                                                    guix-revision-id
+                                                    lint-checker-ids)
+
                 (insert-guix-revision-lint-warnings conn
                                                     guix-revision-id
                                                     lint-warning-ids)
diff --git a/guix-data-service/model/lint-checker.scm b/guix-data-service/model/lint-checker.scm
index c6cafde..501c28a 100644
--- a/guix-data-service/model/lint-checker.scm
+++ b/guix-data-service/model/lint-checker.scm
@@ -4,7 +4,8 @@
   #:use-module (squee)
   #:use-module (guix-data-service model utils)
   #:export (lint-checkers->lint-checker-ids
-            lint-warning-count-by-lint-checker-for-revision))
+            lint-warning-count-by-lint-checker-for-revision
+            insert-guix-revision-lint-checkers))
 
 (define (lint-checkers->lint-checker-ids conn lint-checkers-data)
   (insert-missing-data-and-return-all-ids
@@ -37,3 +38,21 @@ INNER JOIN (
 ORDER BY count DESC")
 
   (exec-query conn query (list commit-hash)))
+
+(define (insert-guix-revision-lint-checkers conn
+                                            guix-revision-id
+                                            lint-checker-ids)
+  (exec-query
+   conn
+   (string-append
+    "INSERT INTO guix_revision_lint_checkers (lint_checker_id, guix_revision_id) "
+    "VALUES "
+    (string-join
+     (map (lambda (lint-checker-id)
+            (simple-format
+             #f
+             "(~A, ~A)"
+             lint-checker-id
+             guix-revision-id))
+          lint-checker-ids)
+     ", "))))
diff --git a/sqitch/deploy/guix_revision_lint_checkers.sql b/sqitch/deploy/guix_revision_lint_checkers.sql
new file mode 100644
index 0000000..21c5a79
--- /dev/null
+++ b/sqitch/deploy/guix_revision_lint_checkers.sql
@@ -0,0 +1,11 @@
+-- Deploy guix-data-service:guix_revision_lint_checkers to pg
+
+BEGIN;
+
+CREATE TABLE guix_revision_lint_checkers (
+  lint_checker_id integer NOT NULL REFERENCES lint_checkers (id),
+  guix_revision_id integer NOT NULL REFERENCES guix_revisions (id),
+  PRIMARY KEY (lint_checker_id, guix_revision_id)
+);
+
+COMMIT;
diff --git a/sqitch/revert/guix_revision_lint_checkers.sql b/sqitch/revert/guix_revision_lint_checkers.sql
new file mode 100644
index 0000000..3cdee33
--- /dev/null
+++ b/sqitch/revert/guix_revision_lint_checkers.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:guix_revision_lint_checkers from pg
+
+BEGIN;
+
+DROP TABLE guix_revision_lint_checkers;
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index fb234ae..b0b145b 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -19,3 +19,4 @@ fix_duplicated_licenses 2019-07-30T05:48:17Z Christopher Baines <mail@cbaines.ne
 change_git_branches_primary_key 2019-08-05T18:57:41Z Christopher Baines <mail@cbaines.net> # Change the git_branches primary key to include the git_repository_id,\nas this will allow having the same branch in different repositories.
 remove_duplicate_load_new_guix_revision_jobs 2019-08-05T19:06:36Z Christopher Baines <mail@cbaines.net> # Remove duplicate load_new_guix_revision_jobs
 lint_warnings 2019-08-18T17:10:12Z Christopher Baines <mail@cbaines.net> # Store lint warnings
+guix_revision_lint_checkers 2019-09-01T12:17:38Z chris <chris@phact> # Associate lint_checkers to guix_revisions
diff --git a/sqitch/verify/guix_revision_lint_checkers.sql b/sqitch/verify/guix_revision_lint_checkers.sql
new file mode 100644
index 0000000..637f4be
--- /dev/null
+++ b/sqitch/verify/guix_revision_lint_checkers.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:guix_revision_lint_checkers on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;