blob: 429538bb143182ca904edfb0b8e2cd87907230c5 (
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
|
(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
insert-package-metadata
inferior-packages->package-metadata-ids))
(define (select-package-metadata hashes)
(string-append "SELECT id, sha1_hash "
"FROM package_metadata "
"WHERE sha1_hash IN ("
(string-join (map (lambda (hash)
(simple-format #f "'~A'" hash))
hashes)
",")
");"))
(define (insert-package-metadata metadata-rows)
(string-append "INSERT INTO package_metadata "
"(sha1_hash, synopsis, description, home_page) "
"VALUES "
(string-join
(map (match-lambda
((sha1_hash synopsis description home_page)
(string-append
"('" sha1_hash "',"
(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)
(let ((data (list (inferior-package-synopsis package)
(inferior-package-description package)
(inferior-package-home-page package))))
`(,(bytevector->base16-string
(sha1 (string->utf8
(string-join
(map (lambda (d)
(cond
((string? d) d)
((boolean? d) (simple-format #f "~A" d))
(else d)))
data)
":"))))
,@data)))
packages))
(define package-metadata-hashes
(map first package-metadata))
(let* ((existing-package-metadata-entries
(exec-query->vhash conn
(select-package-metadata
package-metadata-hashes)
second ;; sha1_hash
first)) ;; id))
(missing-package-metadata-entries
(delete-duplicates
(filter (lambda (metadata)
(not (vhash-assoc (first metadata)
existing-package-metadata-entries)))
package-metadata)))
(new-package-metadata-entries
(if (null? missing-package-metadata-entries)
'()
(map car (exec-query conn
(insert-package-metadata
missing-package-metadata-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash (map first missing-package-metadata-entries)
new-package-metadata-entries)))
(map (lambda (sha1-hash)
(cdr
(or (vhash-assoc sha1-hash
existing-package-metadata-entries)
(vhash-assoc sha1-hash
new-entries-id-lookup-vhash)
(begin
sha1-hash
(error "missing package-metadata entry")))))
package-metadata-hashes)))
|