Christopher Baines
e117bb1d87
A large proportion of these changes relate to changing the way packages relate to derivations. Previously, a package at a given revision had a single derivation. This was OK, but didn't account for multiple architectures. Therefore, these changes mean that a package has multiple derivations, depending on the system of the derivation, and the target system. There are multiple changes, small and large to the web interface as well. More pages link to each other, and the visual display has been improved somewhat.
120 lines
4.7 KiB
Scheme
120 lines
4.7 KiB
Scheme
(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
|
|
select-package-metadata-by-revision-name-and-version
|
|
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 (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 "
|
|
"(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)))
|