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:
parent
0ab1c71722
commit
8eac26b17d
7 changed files with 97 additions and 44 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue