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

Improve the package and package-metadata modules

Browse source 
Add tests around the package module, extract out the use of the
inferior-package record assessors so that they aren't part of the tests, and
switch across the package-metadata module to use
insert-missing-data-and-return-all-ids.
This commit is contained in:
Christopher Baines 2019-09-04 19:28:48 +02:00
parent f29230e034
commit 1a55022524
5 changed files with 108 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -90,6 +90,7 @@ TESTS = \
tests/model-lint-checker.scm \
tests/model-lint-warning.scm \
tests/model-lint-warning-message.scm \
tests/model-package.scm \
tests/model-package-metadata.scm
AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"

9
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -454,7 +454,10 @@ WHERE job_id = $1"
(log-time "getting package-ids"
(lambda ()
(inferior-packages->package-ids
conn packages packages-metadata-ids)))))
conn
(zip (map inferior-package-name packages)
(map inferior-package-version packages)
packages-metadata-ids))))))
(define (insert-lint-warnings conn inferior-package-id->package-database-id
lint-checker-ids
@ -883,7 +886,9 @@ RETURNING id;")
(match (exec-query conn
query
(list git-repository-id commit source))
(list (number->string git-repository-id)
commit
source))
((result)
result)
(() #f)))

43
guix-data-service/model/package-metadata.scm
View file

@ -144,42 +144,9 @@ WHERE packages.id IN (
packages
license-set-ids))
(let* ((existing-package-metadata-entries
(exec-query->vhash conn
(select-package-metadata package-metadata)
(match-lambda
((id synopsis description home-page
location-id license-set-id)
(list synopsis
description
(non-empty-string-or-false home-page)
location-id
license-set-id)))
first)) ;; id))
(missing-package-metadata-entries
(delete-duplicates
(filter (lambda (metadata)
(not (vhash-assoc metadata
existing-package-metadata-entries)))
package-metadata)))
(new-package-metadata-entries
(if (null? missing-package-metadata-entries)
'()
(map first
(exec-query conn
(insert-package-metadata
missing-package-metadata-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash missing-package-metadata-entries
new-package-metadata-entries)))
(insert-missing-data-and-return-all-ids
conn
"package_metadata"
'(synopsis description home_page location_id license_set_id)
package-metadata))
(map (lambda (package-metadata-values)
(cdr
(or (vhash-assoc package-metadata-values
existing-package-metadata-entries)
(vhash-assoc package-metadata-values
new-entries-id-lookup-vhash)
(begin
(error "missing package-metadata entry"
package-metadata-values)))))
package-metadata)))

11
guix-data-service/model/package.scm
View file

@ -9,7 +9,6 @@
select-packages-in-revision
search-packages-in-revision
count-packages-in-revision
insert-into-package-entries
inferior-packages->package-ids))
(define (select-existing-package-entries package-entries)
@ -160,15 +159,7 @@ WHERE packages.id IN (
" 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))
(define (inferior-packages->package-ids conn package-entries)
(insert-missing-data-and-return-all-ids
conn
"packages"

94
tests/model-package.scm Normal file
View file

@ -0,0 +1,94 @@
(define-module (test-model-package)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (guix utils)
#:use-module (guix tests)
#:use-module (tests mock-inferior)
#:use-module (guix-data-service model license-set)
#:use-module (guix-data-service model package)
#:use-module (guix-data-service model package-metadata)
#:use-module (guix-data-service database))
(test-begin "test-model-package")
(define mock-inferior-package-foo
(mock-inferior-package
(name "foo")
(version "2")
(synopsis "Foo")
(description "Foo description")
(home-page "https://example.com")
(location (location "file.scm" 5 0))))
(define mock-inferior-package-foo-2
(mock-inferior-package
(name "foo")
(version "2")
(synopsis "Foo")
(description "Foo description")
(home-page #f)
(location #f)))
(define (test-license-set-ids conn)
(mock
((guix-data-service model license)
inferior-packages->license-data
(lambda (inf packages)
'((("License 1"
"https://gnu.org/licenses/test-1.html"
"https://example.com/why-license-1")))))
(inferior-packages->license-set-ids conn #f #f)))
(define mock-inferior-packages
(list mock-inferior-package-foo
mock-inferior-package-foo-2))
(with-mock-inferior-packages
(lambda ()
(use-modules (guix-data-service model package)
(guix-data-service model git-repository)
(guix-data-service model guix-revision)
(guix-data-service model package-metadata))
(with-postgresql-connection
"test-model-package"
(lambda (conn)
(with-postgresql-transaction
conn
(lambda (conn)
(test-assert "inferior-packages->package-ids works once"
(let ((package-metadata-ids (inferior-packages->package-metadata-ids
conn
mock-inferior-packages
(test-license-set-ids conn))))
(match (inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
package-metadata-ids))
((x) (number? x))))))
#:always-rollback? #t)
(with-postgresql-transaction
conn
(lambda (conn)
(let ((package-metadata-ids (inferior-packages->package-metadata-ids
conn
mock-inferior-packages
(test-license-set-ids conn))))
(test-equal
(inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
package-metadata-ids))
(inferior-packages->package-ids
conn
(zip (map mock-inferior-package-name mock-inferior-packages)
(map mock-inferior-package-version mock-inferior-packages)
package-metadata-ids)))))
#:always-rollback? #t)))))
(test-end)