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
|
(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 (gcrypt hash)
#:use-module (rnrs bytevectors)
#:use-module (guix base16)
#:use-module (guix inferior)
#: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)
(string-append "SELECT id, package_metadata.synopsis, "
"package_metadata.description, package_metadata.home_page "
"FROM package_metadata "
"JOIN (VALUES "
(string-join (map (lambda (field-values)
(apply
simple-format
#f "(~A, ~A, ~A)"
(map value->quoted-string-or-null
field-values)))
package-metadata-values)
",")
") AS vals (synopsis, description, home_page) "
"ON package_metadata.synopsis = vals.synopsis AND "
"package_metadata.description = vals.description AND "
"package_metadata.home_page = vals.home_page"))
(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
FROM package_metadata
INNER JOIN packages
ON package_metadata.id = packages.package_metadata_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")
(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) "
"VALUES "
(string-join
(map (match-lambda
((synopsis description home_page)
(string-append
"("
(value->quoted-string-or-null synopsis) ","
(value->quoted-string-or-null description) ","
(value->quoted-string-or-null home_page) ")")))
metadata-rows)
",")
" RETURNING id"
";"))
(define (inferior-packages->package-metadata-ids conn packages)
(define package-metadata
(map (lambda (package)
(list (inferior-package-synopsis package)
(inferior-package-description package)
(inferior-package-home-page package)))
packages))
(let* ((existing-package-metadata-entries
(exec-query->vhash conn
(select-package-metadata package-metadata)
(lambda (results)
(cdr (take results 4)))
first)) ;; id))
(missing-package-metadata-entries
(delete-duplicates
(filter (lambda (metadata)
(not (vhash-assoc metadata
existing-package-metadata-entries)))
package-metadata)))
(new-package-metadata-entries
(if (null? missing-package-metadata-entries)
'()
(map first
(exec-query conn
(insert-package-metadata
missing-package-metadata-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash missing-package-metadata-entries
new-package-metadata-entries)))
(map (lambda (package-metadata-values)
(cdr
(or (vhash-assoc package-metadata-values
existing-package-metadata-entries)
(vhash-assoc package-metadata-values
new-entries-id-lookup-vhash)
(begin
(error "missing package-metadata entry"
package-metadata-values)))))
package-metadata)))
|