cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source 
This is a service designed to provide information about Guix. At the
moment, this initial prototype gathers up information about packages,
the associated metadata and derivations.

The initial primary use case is to compare two different revisions of
Guix, detecting which packages are new, no longer present, updated or
otherwise different.

It's based on the Mumi project.

[1]: https://git.elephly.net/software/mumi.git
This commit is contained in:
Christopher Baines 2019-02-06 16:14:44 +00:00
commit 5a9262b38d
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
32 changed files with 9457 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

90
guix-data-service/model/package.scm Normal file
View file

@ -0,0 +1,90 @@
(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
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, packages.derivation_id "
"FROM packages "
"JOIN (VALUES "
(string-join (map (lambda (package-entry)
(apply
simple-format
#f "('~A', '~A', ~A, ~A)"
package-entry))
package-entries)
", ")
") AS vals (name, version, package_metadata_id, derivation_id) "
"ON packages.name = vals.name AND "
"packages.version = vals.version AND "
"packages.package_metadata_id = vals.package_metadata_id AND "
"packages.derivation_id = vals.derivation_id"
";"))
(define (insert-into-package-entries package-entries)
(string-append "INSERT INTO packages "
"(name, version, package_metadata_id, derivation_id) VALUES "
(string-join
(map
(match-lambda
((name version package_metadata_id derivation_id)
(simple-format #f "('~A', '~A', ~A, ~A)"
name
version
package_metadata_id
derivation_id)))
package-entries)
",")
" RETURNING id"
";"))
(define (inferior-packages->package-ids conn packages metadata-ids derivation-ids)
(define package-entries
(map (lambda (package metadata-id derivation-id)
(list (inferior-package-name package)
(inferior-package-version package)
metadata-id
derivation-id))
packages
metadata-ids
derivation-ids))
(let* ((existing-package-entry-ids
(exec-query->vhash conn
(select-existing-package-entries package-entries)
;; name, version, package_metadata_id and
;; derivation_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)))