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

Store and display the location of packages

Browse source 
Store the location a package can be found at, and display this on the package
page.

If available, link off to the git repository containing the package.
This commit is contained in:
Christopher Baines 2019-05-13 21:02:53 +01:00
parent 9aaab6b751
commit 7341d17254
15 changed files with 217 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -7,36 +7,64 @@
#:use-module (rnrs bytevectors)
#:use-module (guix base16)
#:use-module (guix inferior)
#:use-module (guix-data-service model location)
#:use-module (guix-data-service model utils)
#:export (select-package-metadata-by-revision-name-and-version
inferior-packages->package-metadata-ids))
(define (select-package-metadata package-metadata-values)
(string-append "SELECT id, package_metadata.synopsis, "
"package_metadata.description, package_metadata.home_page "
(define fields
'("synopsis" "description" "home_page" "location_id"))
(string-append "SELECT id, " (string-join (map
(lambda (name)
(string-append
"package_metadata." name))
fields)
", ") " "
"FROM package_metadata "
"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)
(string-join (map
(match-lambda
((synopsis description home-page location-id)
(apply
simple-format
#f
(string-append
"("
(string-join
(list-tabulate
(length fields)
(lambda (n) "~A"))
",")
")")
(list
(value->quoted-string-or-null synopsis)
(value->quoted-string-or-null description)
(value->quoted-string-or-null home-page)
location-id))))
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"))
") AS vals (" (string-join fields ", ") ") "
"ON "
(string-join
(map (lambda (field)
(string-append
"package_metadata." field " = vals." field))
fields)
" AND ")))
(define (select-package-metadata-by-revision-name-and-version
conn revision-commit-hash name version)
(define query "
SELECT package_metadata.synopsis, package_metadata.description,
package_metadata.home_page
package_metadata.home_page,
locations.file, locations.line, locations.column_number
FROM package_metadata
INNER JOIN packages
ON package_metadata.id = packages.package_metadata_id
LEFT OUTER JOIN locations
ON package_metadata.location_id = locations.id
WHERE packages.id IN (
SELECT package_derivations.package_id
FROM package_derivations
@ -54,16 +82,18 @@ WHERE packages.id IN (
(define (insert-package-metadata metadata-rows)
(string-append "INSERT INTO package_metadata "
"(synopsis, description, home_page) "
"(synopsis, description, home_page, location_id) "
"VALUES "
(string-join
(map (match-lambda
((synopsis description home_page)
((synopsis description home_page location_id)
(string-append
"("
(value->quoted-string-or-null synopsis) ","
(value->quoted-string-or-null description) ","
(value->quoted-string-or-null home_page) ")")))
(value->quoted-string-or-null home_page) ","
(number->string location_id)
")")))
metadata-rows)
",")
" RETURNING id"
@ -75,14 +105,17 @@ WHERE packages.id IN (
(map (lambda (package)
(list (inferior-package-synopsis package)
(inferior-package-description package)
(inferior-package-home-page package)))
(inferior-package-home-page package)
(location->location-id
conn
(inferior-package-location package))))
packages))
(let* ((existing-package-metadata-entries
(exec-query->vhash conn
(select-package-metadata package-metadata)
(lambda (results)
(cdr (take results 4)))
(cdr (take results 5)))
first)) ;; id))
(missing-package-metadata-entries
(delete-duplicates