mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
80010a8a1b
Use exec-query-with-null-handling to distinguish NULL values, change it to just take a list of fields and remove the handlers. Also, add a sets-of-data? parameter so that this can be used licenses.
131 lines
5 KiB
Scheme
131 lines
5 KiB
Scheme
(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
|
|
lint-warnings-for-guix-revision
|
|
select-lint-warnings-by-revision-package-name-and-version))
|
|
|
|
(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 package_id location_id lint_warning_message_set_id)
|
|
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)
|
|
", "))))
|
|
|
|
(define* (lint-warnings-for-guix-revision conn commit-hash
|
|
#:key
|
|
package-query
|
|
linters
|
|
message-query)
|
|
(define query
|
|
(string-append "
|
|
SELECT lint_warnings.id, lint_checkers.name, lint_checkers.description,
|
|
lint_checkers.network_dependent, packages.name, packages.version,
|
|
locations.file, locations.line, locations.column_number,
|
|
lint_warning_messages.message
|
|
FROM lint_warnings
|
|
INNER JOIN lint_checkers
|
|
ON lint_warnings.lint_checker_id = lint_checkers.id
|
|
INNER JOIN packages
|
|
ON lint_warnings.package_id = packages.id
|
|
INNER JOIN locations
|
|
ON locations.id = lint_warnings.location_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)
|
|
"
|
|
(if linters
|
|
(string-append
|
|
"INNER JOIN (VALUES "
|
|
(string-join
|
|
(map (lambda (lint-checker-name)
|
|
(simple-format
|
|
#f "($STR$~A$STR$)" lint-checker-name))
|
|
linters)
|
|
",")
|
|
") AS linters (name) ON lint_checkers.name = linters.name ")
|
|
"")
|
|
"WHERE lint_warnings.id IN (
|
|
SELECT lint_warning_id
|
|
FROM guix_revision_lint_warnings
|
|
INNER JOIN guix_revisions ON guix_revision_id = guix_revisions.id
|
|
WHERE commit = $1
|
|
)"
|
|
(if package-query
|
|
" AND to_tsvector(packages.name) @@ plainto_tsquery($2)"
|
|
"")
|
|
(if message-query
|
|
(simple-format
|
|
#f " AND to_tsvector(lint_warning_messages.message) @@ plainto_tsquery($~A)"
|
|
(if package-query "3" "2"))
|
|
"")
|
|
" ORDER BY packages.name"))
|
|
|
|
(exec-query conn query `(,commit-hash
|
|
,@(if package-query
|
|
(list package-query)
|
|
'())
|
|
,@(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)))
|