1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(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)))
|