aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-09-01 13:35:23 +0100
committerChristopher Baines <mail@cbaines.net>2019-09-01 18:32:09 +0100
commit91a9ba43498ffcd6149854eaa6b071d8b16e4cf3 (patch)
tree000af25a1d8d6b866d846e4c3461010febf66f73 /guix-data-service
parentc1fad22cd1767b8f64c66a1bd2f47ecf387a992a (diff)
downloaddata-service-91a9ba43498ffcd6149854eaa6b071d8b16e4cf3.tar
data-service-91a9ba43498ffcd6149854eaa6b071d8b16e4cf3.tar.gz
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.
Diffstat (limited to 'guix-data-service')
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm93
-rw-r--r--guix-data-service/model/lint-checker.scm21
2 files changed, 69 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)
+ ", "))))