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.
123 lines
4.6 KiB
Scheme
123 lines
4.6 KiB
Scheme
(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)))
|