aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/model/lint-warning.scm
blob: 1d7097641e282483722e396ec0f3ff0073271bde (plain)
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)))