Remove the sha1_hash from the package_metadata table

I'm thinking about adding more fields to this table, and the sha1_hash values
will make this tricker.

Therefore, remove the value, and adjust the existing code to cope. This commit
also adds a new test which coveres some of the changed functionality.
This commit is contained in:
Christopher Baines 2019-05-12 17:01:51 +01:00
parent 0ab1c71722
commit 8eac26b17d
7 changed files with 97 additions and 44 deletions

View file

@ -8,20 +8,26 @@
#:use-module (guix base16)
#:use-module (guix inferior)
#:use-module (guix-data-service model utils)
#:export (select-package-metadata
select-package-metadata-by-revision-name-and-version
insert-package-metadata
#:export (select-package-metadata-by-revision-name-and-version
inferior-packages->package-metadata-ids))
(define (select-package-metadata hashes)
(string-append "SELECT id, sha1_hash "
(define (select-package-metadata package-metadata-values)
(string-append "SELECT id, package_metadata.synopsis, "
"package_metadata.description, package_metadata.home_page "
"FROM package_metadata "
"WHERE sha1_hash IN ("
(string-join (map (lambda (hash)
(simple-format #f "'~A'" hash))
hashes)
"JOIN (VALUES "
(string-join (map (lambda (field-values)
(apply
simple-format
#f "(~A, ~A, ~A)"
(map value->quoted-string-or-null
field-values)))
package-metadata-values)
",")
");"))
") AS vals (synopsis, description, home_page) "
"ON package_metadata.synopsis = vals.synopsis AND "
"package_metadata.description = vals.description AND "
"package_metadata.home_page = vals.home_page"))
(define (select-package-metadata-by-revision-name-and-version
conn revision-commit-hash name version)
@ -48,13 +54,13 @@ WHERE packages.id IN (
(define (insert-package-metadata metadata-rows)
(string-append "INSERT INTO package_metadata "
"(sha1_hash, synopsis, description, home_page) "
"(synopsis, description, home_page) "
"VALUES "
(string-join
(map (match-lambda
((sha1_hash synopsis description home_page)
((synopsis description home_page)
(string-append
"('" sha1_hash "',"
"("
(value->quoted-string-or-null synopsis) ","
(value->quoted-string-or-null description) ","
(value->quoted-string-or-null home_page) ")")))
@ -67,54 +73,41 @@ WHERE packages.id IN (
(define (inferior-packages->package-metadata-ids conn packages)
(define package-metadata
(map (lambda (package)
(let ((data (list (inferior-package-synopsis package)
(inferior-package-description package)
(inferior-package-home-page package))))
`(,(bytevector->base16-string
(sha1 (string->utf8
(string-join
(map (lambda (d)
(cond
((string? d) d)
((boolean? d) (simple-format #f "~A" d))
(else d)))
data)
":"))))
,@data)))
(list (inferior-package-synopsis package)
(inferior-package-description package)
(inferior-package-home-page package)))
packages))
(define package-metadata-hashes
(map first package-metadata))
(let* ((existing-package-metadata-entries
(exec-query->vhash conn
(select-package-metadata
package-metadata-hashes)
second ;; sha1_hash
(select-package-metadata package-metadata)
(lambda (results)
(cdr (take results 4)))
first)) ;; id))
(missing-package-metadata-entries
(delete-duplicates
(filter (lambda (metadata)
(not (vhash-assoc (first metadata)
(not (vhash-assoc metadata
existing-package-metadata-entries)))
package-metadata)))
(new-package-metadata-entries
(if (null? missing-package-metadata-entries)
'()
(map car (exec-query conn
(insert-package-metadata
missing-package-metadata-entries)))))
(map first
(exec-query conn
(insert-package-metadata
missing-package-metadata-entries)))))
(new-entries-id-lookup-vhash
(two-lists->vhash (map first missing-package-metadata-entries)
(two-lists->vhash missing-package-metadata-entries
new-package-metadata-entries)))
(map (lambda (sha1-hash)
(map (lambda (package-metadata-values)
(cdr
(or (vhash-assoc sha1-hash
(or (vhash-assoc package-metadata-values
existing-package-metadata-entries)
(vhash-assoc sha1-hash
(vhash-assoc package-metadata-values
new-entries-id-lookup-vhash)
(begin
sha1-hash
(error "missing package-metadata entry")))))
package-metadata-hashes)))
(error "missing package-metadata entry"
package-metadata-values)))))
package-metadata)))