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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service model package-metadata)
#:use-module (srfi srfi-1)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (json)
#:use-module (gcrypt hash)
#:use-module (rnrs bytevectors)
#:use-module (guix base16)
#:use-module (guix inferior)
#:use-module (guix-data-service model location)
#:use-module (guix-data-service model utils)
#:export (select-package-metadata-by-revision-name-and-version
inferior-packages->package-metadata-ids))
(define (select-package-metadata package-metadata-values)
(define fields
'("synopsis" "description" "home_page" "location_id" "license_set_id"))
(string-append "SELECT id, " (string-join (map
(lambda (name)
(string-append
"package_metadata." name))
fields)
", ") " "
"FROM package_metadata "
"JOIN (VALUES "
(string-join (map
(match-lambda
((synopsis description home-page location-id
license-set-id)
(apply
simple-format
#f
(string-append
"("
(string-join
(list-tabulate
(length fields)
(lambda (n) "~A"))
",")
")")
(list
(value->quoted-string-or-null synopsis)
(value->quoted-string-or-null description)
(value->quoted-string-or-null home-page)
location-id
license-set-id))))
package-metadata-values)
",")
") AS vals (" (string-join fields ", ") ") "
"ON "
(string-join
(map (lambda (field)
(if (member field '("home_page" "location_id"
"license_set_id"))
(string-append
"(package_metadata." field " = vals." field " OR "
"(package_metadata." field " IS NULL AND"
" vals." field " IS NULL))")
(string-append
"package_metadata." field " = vals." field)))
fields)
" AND ")))
(define (select-package-metadata-by-revision-name-and-version
conn revision-commit-hash name version)
(define query "
SELECT package_metadata.synopsis, package_metadata.description,
package_metadata.home_page,
locations.file, locations.line, locations.column_number,
(SELECT JSON_AGG((license_data.*))
FROM (
SELECT licenses.name, licenses.uri, licenses.comment
FROM licenses
INNER JOIN license_sets ON licenses.id = ANY(license_sets.license_ids)
WHERE license_sets.id = package_metadata.license_set_id
ORDER BY licenses.name
) AS license_data
) AS licenses
FROM package_metadata
INNER JOIN packages
ON package_metadata.id = packages.package_metadata_id
LEFT OUTER JOIN locations
ON package_metadata.location_id = locations.id
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")
(map
(match-lambda
((synopsis description home-page file line column-number
license-json)
(list synopsis description home-page file line column-number
(if (string-null? license-json)
#()
(json-string->scm license-json)))))
(exec-query conn query (list revision-commit-hash name version))))
(define (insert-package-metadata metadata-rows)
(string-append "INSERT INTO package_metadata "
"(synopsis, description, home_page, location_id, license_set_id) "
"VALUES "
(string-join
(map (match-lambda
((synopsis description home_page
location-id license-set-id)
(string-append
"("
(value->quoted-string-or-null synopsis) ","
(value->quoted-string-or-null description) ","
(value->quoted-string-or-null home_page) ","
location-id ","
license-set-id
")")))
metadata-rows)
",")
" RETURNING id"
";"))
(define (inferior-packages->package-metadata-ids conn
packages
license-set-ids)
(define package-metadata
(map (lambda (package license-set-id)
(list (inferior-package-synopsis package)
(inferior-package-description package)
(non-empty-string-or-false
(inferior-package-home-page package))
(location->location-id
conn
(inferior-package-location package))
license-set-id))
packages
license-set-ids))
(insert-missing-data-and-return-all-ids
conn
"package_metadata"
'(synopsis description home_page location_id license_set_id)
(map (match-lambda
((synopsis description home-page location-id license-set-id)
(list synopsis
description
(if (string? home-page)
home-page
NULL)
location-id
license-set-id)))
package-metadata)
;; There can be duplicated entires in package-metadata, for example where
;; you have one package definition which interits from another, and just
;; overrides the version and the source, the package_metadata entries for
;; both definitions will be the same.
#:delete-duplicates? #t
;; There is so much package metadata that it's worth creating a temporary
;; table
#:use-temporary-table? #t))
|