diff options
author | Christopher Baines <mail@cbaines.net> | 2019-08-31 12:11:58 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-09-01 13:12:10 +0100 |
commit | 6b9977f62eef54678c7a53844ad5d26d8efeecb0 (patch) | |
tree | d76ededb17ec03e0705258bb9565782c7e16af76 /guix-data-service/model | |
parent | bf469504eb4df95a3349328dc10095d172630fcd (diff) | |
download | data-service-6b9977f62eef54678c7a53844ad5d26d8efeecb0.tar data-service-6b9977f62eef54678c7a53844ad5d26d8efeecb0.tar.gz |
Store lint warnings in the database
This commit adds the relevant tables and code to store lint warnings in the
database.
Currently, only lint checkers which don't require access to the network will
be run, as this allows the processing to happen without network access. Also,
this functionality won't work in older versions of Guix which don't expose the
lint warnings in a compatible way.
Diffstat (limited to 'guix-data-service/model')
-rw-r--r-- | guix-data-service/model/lint-checker.scm | 15 | ||||
-rw-r--r-- | guix-data-service/model/lint-warning-message.scm | 57 | ||||
-rw-r--r-- | guix-data-service/model/lint-warning.scm | 36 |
3 files changed, 108 insertions, 0 deletions
diff --git a/guix-data-service/model/lint-checker.scm b/guix-data-service/model/lint-checker.scm new file mode 100644 index 0000000..6193966 --- /dev/null +++ b/guix-data-service/model/lint-checker.scm @@ -0,0 +1,15 @@ +(define-module (guix-data-service model lint-checker) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (guix-data-service model utils) + #:export (lint-checkers->lint-checker-ids)) + +(define (lint-checkers->lint-checker-ids conn lint-checkers-data) + (insert-missing-data-and-return-all-ids + conn + "lint_checkers" + `((name . ,(lambda (value) + (quote-string (symbol->string value)))) + (description . ,quote-string) + (network_dependent . ,value->sql-boolean)) + lint-checkers-data)) diff --git a/guix-data-service/model/lint-warning-message.scm b/guix-data-service/model/lint-warning-message.scm new file mode 100644 index 0000000..70851d9 --- /dev/null +++ b/guix-data-service/model/lint-warning-message.scm @@ -0,0 +1,57 @@ +(define-module (guix-data-service model lint-warning-message) + #:use-module (ice-9 match) + #:use-module (squee) + #:use-module (guix-data-service database) + #:use-module (guix-data-service model utils) + #:export (lint-warning-message-data->lint-warning-message-ids + + lint-warning-message-data->lint-warning-message-set-id)) + +(define (lint-warning-message-data->lint-warning-message-ids conn + messages-by-locale) + (insert-missing-data-and-return-all-ids + conn + "lint_warning_messages" + `((locale . ,quote-string) + (message . ,quote-string)) + (map (match-lambda + ((locale . message) + (list locale message))) + messages-by-locale))) + +(define (insert-lint-warning-message-set conn lint-message-ids) + (let ((query + (string-append + "INSERT INTO lint_warning_message_sets (message_ids) VALUES " + (string-append + "('{" + (string-join + (map number->string + (sort (map string->number lint-message-ids) <)) + ", ") + "}')") + " RETURNING id"))) + + (match (exec-query conn query) + (((id)) id)))) + +(define (lint-warning-message-data->lint-warning-message-set-id + conn + messages-by-locale) + + (let* ((lint-warning-message-ids + (lint-warning-message-data->lint-warning-message-ids + conn messages-by-locale)) + (lint-message-set-id + (exec-query + conn + (string-append + "SELECT id FROM lint_warning_message_sets " + "WHERE message_ids = ARRAY[" + (string-join lint-warning-message-ids ", ") + "]")))) + + (match lint-message-set-id + (((id)) id) + (() + (insert-lint-warning-message-set conn lint-warning-message-ids))))) diff --git a/guix-data-service/model/lint-warning.scm b/guix-data-service/model/lint-warning.scm new file mode 100644 index 0000000..e516618 --- /dev/null +++ b/guix-data-service/model/lint-warning.scm @@ -0,0 +1,36 @@ +(define-module (guix-data-service model lint-warning) + #:use-module (squee) + #:use-module (guix-data-service model utils) + #:export (lint-warnings-data->lint-warning-ids + insert-guix-revision-lint-warnings)) + +(define (lint-warnings-data->lint-warning-ids + conn + ;; (lint-checker-id package-id location-id lint-warning-message-set-id) + lint-warnings-data) + (insert-missing-data-and-return-all-ids + conn + "lint_warnings" + `((lint_checker_id . ,identity) + (package_id . ,identity) + (location_id . ,identity) + (lint_warning_message_set_id . ,identity)) + lint-warnings-data)) + +(define (insert-guix-revision-lint-warnings conn + guix-revision-id + lint-warning-ids) + (exec-query + conn + (string-append + "INSERT INTO guix_revision_lint_warnings (lint_warning_id, guix_revision_id) " + "VALUES " + (string-join + (map (lambda (lint-warning-id) + (simple-format + #f + "(~A, ~A)" + lint-warning-id + guix-revision-id)) + lint-warning-ids) + ", ")))) |