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
|
(define-module (guix-data-service model package)
#:use-module (srfi srfi-1)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (guix inferior)
#:use-module (guix-data-service model utils)
#:export (select-existing-package-entries
select-packages-in-revision
count-packages-in-revision
insert-into-package-entries
inferior-packages->package-ids))
(define (select-existing-package-entries package-entries)
(string-append "SELECT id, packages.name, packages.version, "
"packages.package_metadata_id "
"FROM packages "
"JOIN (VALUES "
(string-join (map (lambda (package-entry)
(apply
simple-format
#f "('~A', '~A', ~A)"
package-entry))
package-entries)
", ")
") AS vals (name, version, package_metadata_id) "
"ON packages.name = vals.name AND "
"packages.version = vals.version AND "
"packages.package_metadata_id = vals.package_metadata_id"))
(define (select-packages-in-revision conn commit-hash)
(define query
"
SELECT packages.name, packages.version, package_metadata.synopsis
FROM packages
INNER JOIN package_metadata
ON packages.package_metadata_id = 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
)
ORDER BY packages.name, packages.version")
(exec-query conn query (list commit-hash)))
(define (count-packages-in-revision conn commit-hash)
(define query
"
SELECT COUNT(DISTINCT packages.name)
FROM packages
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
)")
(exec-query conn query (list commit-hash)))
(define (insert-into-package-entries package-entries)
(string-append "INSERT INTO packages "
"(name, version, package_metadata_id) VALUES "
(string-join
(map
(match-lambda
((name version package_metadata_id)
(simple-format #f "('~A', '~A', ~A)"
name
version
package_metadata_id)))
package-entries)
",")
" RETURNING id"
";"))
(define (inferior-packages->package-ids conn packages metadata-ids)
(define package-entries
(map (lambda (package metadata-id)
(list (inferior-package-name package)
(inferior-package-version package)
metadata-id))
packages
metadata-ids))
(let* ((existing-package-entry-ids
(exec-query->vhash conn
(select-existing-package-entries package-entries)
;; name, version and package_metadata_id
cdr
first)) ;;id
(missing-package-entries
(filter (lambda (package-entry)
(not (vhash-assoc package-entry
existing-package-entry-ids)))
package-entries))
(new-package-entry-ids
(if (null? missing-package-entries)
'()
(map car
(exec-query
conn
(insert-into-package-entries
missing-package-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash missing-package-entries
new-package-entry-ids)))
(map (lambda (package-entry)
(cdr
(or (vhash-assoc package-entry
existing-package-entry-ids)
(vhash-assoc package-entry
new-entries-id-lookup-vhash)
(error "missing package entry"))))
package-entries)))
|