diff options
author | Christopher Baines <mail@cbaines.net> | 2019-03-11 22:11:14 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-03-11 22:11:14 +0000 |
commit | e117bb1d87174d2f3448367f0208fc3340f88e51 (patch) | |
tree | 921a845f0cf06a1cbc04267747127015684426a1 /guix-data-service/model/package-derivation.scm | |
parent | 5bc0e7d4bf2b55f7c62c98ae8ae268fbe53b30f0 (diff) | |
download | data-service-e117bb1d87174d2f3448367f0208fc3340f88e51.tar data-service-e117bb1d87174d2f3448367f0208fc3340f88e51.tar.gz |
Many changes
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.
Diffstat (limited to 'guix-data-service/model/package-derivation.scm')
-rw-r--r-- | guix-data-service/model/package-derivation.scm | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/guix-data-service/model/package-derivation.scm b/guix-data-service/model/package-derivation.scm new file mode 100644 index 0000000..6e87765 --- /dev/null +++ b/guix-data-service/model/package-derivation.scm @@ -0,0 +1,112 @@ +(define-module (guix-data-service model package-derivation) + #:use-module (srfi srfi-1) + #:use-module (ice-9 vlist) + #:use-module (ice-9 match) + #:use-module (squee) + #:use-module (guix-data-service model utils) + #:export (insert-package-derivations + count-packages-derivations-in-revision)) + +(define (insert-missing-package-derivations conn entries) + (define query + (string-append + "INSERT INTO package_derivations " + "(package_id, derivation_id, system, target) VALUES " + (string-join + (map + (lambda (entry) + (apply simple-format + #f "(~A, ~A, '~A', '~A')" + entry)) + entries) + ", ") + " RETURNING id")) + + (exec-query conn query)) + +(define (insert-package-derivations conn + package-ids-systems-and-targets + derivation-ids) + (define select-existing-package-derivation-entries + (string-append + "SELECT id, package_derivations.package_id," + " package_derivations.derivation_id, package_derivations.system," + " package_derivations.target " + "FROM package_derivations " + "JOIN (VALUES " + (string-join (map (match-lambda* + (((package-id system target) derivation-id) + (simple-format + #f "(~A, ~A, '~A', '~A')" + package-id + derivation-id + system + target))) + package-ids-systems-and-targets + derivation-ids) + ", ") + ") AS vals (package_id, derivation_id, system, target) " + "ON package_derivations.package_id = vals.package_id " + "AND package_derivations.derivation_id = vals.derivation_id " + "AND package_derivations.system = vals.system " + "AND package_derivations.target = vals.target")) + + (define data-4-tuples + (map (match-lambda* + (((package-id system target) derivation-id) + (list package-id + derivation-id + system + target))) + package-ids-systems-and-targets + derivation-ids)) + + (if (null? data-4-tuples) + '() + (begin + (let* ((existing-entries + (exec-query->vhash + conn + select-existing-package-derivation-entries + cdr + first)) ;; id + + (missing-entries + (filter (lambda (4-tuple) + (not (vhash-assoc 4-tuple existing-entries))) + data-4-tuples)) + + (new-entry-ids + (if (null? missing-entries) + '() + (begin + (vlist->list existing-entries) + (insert-missing-package-derivations conn missing-entries)))) + + (new-entries-id-lookup-vhash + (two-lists->vhash missing-entries + new-entry-ids))) + (map (lambda (4-tuple) + (cdr + (or (vhash-assoc 4-tuple existing-entries) + (vhash-assoc 4-tuple new-entries-id-lookup-vhash) + (error "Missing entry")))) + data-4-tuples))))) + +(define (count-packages-derivations-in-revision conn commit-hash) + (define query + " +SELECT package_derivations.system, package_derivations.target, +COUNT(DISTINCT package_derivations.derivation_id) +FROM package_derivations +WHERE package_derivations.id IN ( + SELECT guix_revision_package_derivations.package_derivation_id + FROM guix_revision_package_derivations + INNER JOIN guix_revisions + ON guix_revision_package_derivations.revision_id = guix_revisions.id + WHERE guix_revisions.commit = $1 +) +GROUP BY package_derivations.system, package_derivations.target +ORDER BY package_derivations.system DESC, package_derivations.target DESC") + + (exec-query conn query (list commit-hash))) |