From 1a55022524043bdf2f120dd38990d42949ecb6e2 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 4 Sep 2019 19:28:48 +0200 Subject: Improve the package and package-metadata modules 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. --- Makefile.am | 1 + guix-data-service/jobs/load-new-guix-revision.scm | 9 ++- guix-data-service/model/package-metadata.scm | 43 ++--------- guix-data-service/model/package.scm | 11 +-- tests/model-package.scm | 94 +++++++++++++++++++++++ 5 files changed, 108 insertions(+), 50 deletions(-) create mode 100644 tests/model-package.scm diff --git a/Makefile.am b/Makefile.am index 8046df9..abf828e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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)" diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 75eae4d..64e955b 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -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))) diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm index 178d783..daca676 100644 --- a/guix-data-service/model/package-metadata.scm +++ b/guix-data-service/model/package-metadata.scm @@ -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))) diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 477a25c..49ebab0 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -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" diff --git a/tests/model-package.scm b/tests/model-package.scm new file mode 100644 index 0000000..8029c3b --- /dev/null +++ b/tests/model-package.scm @@ -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) -- cgit v1.2.3