From 7341d1725420b431160536c1cf2b34a662ff0a86 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 13 May 2019 21:02:53 +0100 Subject: Store and display the location of packages 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. --- Makefile.am | 1 + guix-data-service/model/git-repository.scm | 13 ++++ guix-data-service/model/location.scm | 54 ++++++++++++++++ guix-data-service/model/package-metadata.scm | 71 ++++++++++++++++------ guix-data-service/web/controller.scm | 8 ++- guix-data-service/web/view/html.scm | 27 ++++++-- .../deploy/add_git_repositories_cgit_url_base.sql | 7 +++ sqitch/deploy/add_location_information.sql | 20 ++++++ .../revert/add_git_repositories_cgit_url_base.sql | 7 +++ sqitch/revert/add_location_information.sql | 7 +++ sqitch/sqitch.plan | 2 + .../verify/add_git_repositories_cgit_url_base.sql | 7 +++ sqitch/verify/add_location_information.sql | 7 +++ tests/mock-inferior.scm | 10 ++- tests/model-package-metadata.scm | 4 +- 15 files changed, 217 insertions(+), 28 deletions(-) create mode 100644 guix-data-service/model/location.scm create mode 100644 sqitch/deploy/add_git_repositories_cgit_url_base.sql create mode 100644 sqitch/deploy/add_location_information.sql create mode 100644 sqitch/revert/add_git_repositories_cgit_url_base.sql create mode 100644 sqitch/revert/add_location_information.sql create mode 100644 sqitch/verify/add_git_repositories_cgit_url_base.sql create mode 100644 sqitch/verify/add_location_information.sql diff --git a/Makefile.am b/Makefile.am index 43248f1..2cf92ca 100644 --- a/Makefile.am +++ b/Makefile.am @@ -46,6 +46,7 @@ SOURCES = \ guix-data-service/model/git-repository.scm \ guix-data-service/model/guix-revision-package-derivation.scm \ guix-data-service/model/guix-revision.scm \ + guix-data-service/model/location.scm \ guix-data-service/model/package-derivation.scm \ guix-data-service/model/package-metadata.scm \ guix-data-service/model/package.scm \ diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm index 5f35cd3..16c57bf 100644 --- a/guix-data-service/model/git-repository.scm +++ b/guix-data-service/model/git-repository.scm @@ -4,6 +4,7 @@ #:export (all-git-repositories git-repository-id->url git-repository-url->git-repository-id + git-repositories-containing-commit guix-revisions-and-jobs-for-git-repository)) @@ -56,3 +57,15 @@ ORDER BY 1 DESC NULLS FIRST, 2 DESC LIMIT 10;") conn query (list git-repository-id))) + +(define (git-repositories-containing-commit conn commit) + (define query + " +SELECT id, label, url, cgit_url_base +FROM git_repositories WHERE id IN ( + SELECT git_repository_id + FROM git_branches + WHERE commit = $1 +)") + + (exec-query conn query (list commit))) diff --git a/guix-data-service/model/location.scm b/guix-data-service/model/location.scm new file mode 100644 index 0000000..1a01b9a --- /dev/null +++ b/guix-data-service/model/location.scm @@ -0,0 +1,54 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service model location) + #:use-module (ice-9 match) + #:use-module (guix utils) + #:use-module (squee) + #:export (location->location-id)) + +(define select-existing-location + (string-append + "SELECT id " + "FROM locations " + "WHERE file = $1 AND line = $2 AND column_number = $3")) + +(define insert-location + (string-append + "INSERT INTO locations " + "(file, line, column_number) VALUES " + "($1, $2, $3) " + "RETURNING id")) + +(define (location->location-id conn location) + (match location + (($ file line column) + (match (exec-query conn + select-existing-location + (list file + (number->string line) + (number->string column))) + (((id)) + (string->number id)) + (() + (string->number + (caar + (exec-query conn + insert-location + (list file + (number->string line) + (number->string column)))))))))) diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm index 8578bb1..644050e 100644 --- a/guix-data-service/model/package-metadata.scm +++ b/guix-data-service/model/package-metadata.scm @@ -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 diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 584392a..6b4167d 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -176,7 +176,10 @@ conn commit-hash name - version))) + version)) + (git-repositories + (git-repositories-containing-commit conn + commit-hash))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) @@ -202,7 +205,8 @@ name version metadata - derivations)))))) + derivations + git-repositories)))))) (define (render-compare-unknown-commit mime-types conn diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 079b23d..ecc2e83 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -302,7 +302,7 @@ (define (view-revision-package-and-version revision-commit-hash name version package-metadata - derivations) + derivations git-repositories) (layout #:extra-headers '((cache-control . ((max-age . 60)))) @@ -327,7 +327,7 @@ (div (@ (class "col-sm-12")) ,(match package-metadata - (((synopsis description home-page)) + (((synopsis description home-page file line column-number)) `(dl (@ (class "dl-horizontal")) (dt "Synopsis") @@ -335,8 +335,27 @@ (dt "Description") (dd ,(stexi->shtml (texi-fragment->stexi description))) (dt "Home page") - (dd (a (@ (href ,home-page)) - ,home-page))))))) + (dd (a (@ (href ,home-page)) ,home-page)) + ,@(if (and file (not (string-null? file)) + (not (null? git-repositories))) + `((dt "Location") + (dd ,@(map + (match-lambda + ((id label url cgit-url-base) + (if + (and cgit-url-base + (not (string-null? cgit-url-base))) + `(a (@ (href + ,(string-append + cgit-url-base "tree/" + file "?id=" revision-commit-hash + "#n" line))) + ,file + " (line: " ,line + ", column: " ,column-number ")") + '()))) + git-repositories))) + '())))))) (div (@ (class "row")) (div diff --git a/sqitch/deploy/add_git_repositories_cgit_url_base.sql b/sqitch/deploy/add_git_repositories_cgit_url_base.sql new file mode 100644 index 0000000..7a2d532 --- /dev/null +++ b/sqitch/deploy/add_git_repositories_cgit_url_base.sql @@ -0,0 +1,7 @@ +-- Deploy guix-data-service:add_git_repositories_cgit_url_base to pg + +BEGIN; + +ALTER TABLE git_repositories ADD COLUMN cgit_url_base character varying; + +COMMIT; diff --git a/sqitch/deploy/add_location_information.sql b/sqitch/deploy/add_location_information.sql new file mode 100644 index 0000000..7855feb --- /dev/null +++ b/sqitch/deploy/add_location_information.sql @@ -0,0 +1,20 @@ +-- Deploy guix-data-service:add_location_information to pg + +BEGIN; + +CREATE TABLE locations ( + id integer GENERATED BY DEFAULT AS IDENTITY, + file character varying NOT NULL, + line integer NOT NULL, + column_number integer NOT NULL, + CONSTRAINT file_line_column PRIMARY KEY(file, line, column_number), + UNIQUE (id) +); + +ALTER TABLE package_metadata ADD COLUMN location_id integer REFERENCES locations(id); + +ALTER TABLE package_metadata DROP CONSTRAINT synopsis_description_home_page; + +ALTER TABLE package_metadata ADD CONSTRAINT synopsis_description_home_page_location_id UNIQUE (synopsis, description, home_page, location_id); + +COMMIT; diff --git a/sqitch/revert/add_git_repositories_cgit_url_base.sql b/sqitch/revert/add_git_repositories_cgit_url_base.sql new file mode 100644 index 0000000..67c5a87 --- /dev/null +++ b/sqitch/revert/add_git_repositories_cgit_url_base.sql @@ -0,0 +1,7 @@ +-- Revert guix-data-service:add_git_repositories_cgit_url_base from pg + +BEGIN; + +ALTER TABLE git_repositories DROP COLUMN cgit_url_base; + +COMMIT; diff --git a/sqitch/revert/add_location_information.sql b/sqitch/revert/add_location_information.sql new file mode 100644 index 0000000..31220ed --- /dev/null +++ b/sqitch/revert/add_location_information.sql @@ -0,0 +1,7 @@ +-- Revert guix-data-service:add_location_information from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index 026aa7f..1898562 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -8,3 +8,5 @@ initial_import 2019-04-13T13:06:28Z Christopher Baines # Impo git_repositories 2019-05-04T19:03:38Z Christopher Baines # Add a git_repositories table git_branches 2019-05-05T14:53:12Z Christopher Baines # Add a git_branches table remove_package_metadata_sha1_hash 2019-05-12T10:37:40Z Christopher Baines # Remove the sha1_hash field from package_metadata +add_location_information 2019-05-12T20:27:48Z Christopher Baines # Add locations table and location to package_metadata +add_git_repositories_cgit_url_base 2019-05-13T18:45:14Z Christopher Baines # Add cgit_url_base to git_repositories diff --git a/sqitch/verify/add_git_repositories_cgit_url_base.sql b/sqitch/verify/add_git_repositories_cgit_url_base.sql new file mode 100644 index 0000000..9fa2dee --- /dev/null +++ b/sqitch/verify/add_git_repositories_cgit_url_base.sql @@ -0,0 +1,7 @@ +-- Verify guix-data-service:add_git_repositories_cgit_url_base on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/sqitch/verify/add_location_information.sql b/sqitch/verify/add_location_information.sql new file mode 100644 index 0000000..821c643 --- /dev/null +++ b/sqitch/verify/add_location_information.sql @@ -0,0 +1,7 @@ +-- Verify guix-data-service:add_location_information on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/tests/mock-inferior.scm b/tests/mock-inferior.scm index 6424cd9..b59874e 100644 --- a/tests/mock-inferior.scm +++ b/tests/mock-inferior.scm @@ -9,6 +9,7 @@ mock-inferior-package-synopsis mock-inferior-package-description mock-inferior-package-home-page + mock-inferior-package-location with-mock-inferior-packages)) @@ -19,7 +20,8 @@ (version mock-inferior-package-version) (synopsis mock-inferior-package-synopsis) (description mock-inferior-package-description) - (home-page mock-inferior-package-home-page)) + (home-page mock-inferior-package-home-page) + (location mock-inferior-package-location)) (define (with-mock-inferior-packages f) (mock @@ -42,4 +44,8 @@ ((guix inferior) inferior-package-home-page mock-inferior-package-home-page) - (f))))))) + (mock + ((guix inferior) + inferior-package-location + mock-inferior-package-location) + (f)))))))) diff --git a/tests/model-package-metadata.scm b/tests/model-package-metadata.scm index 4c2bc8e..83d77bf 100644 --- a/tests/model-package-metadata.scm +++ b/tests/model-package-metadata.scm @@ -1,6 +1,7 @@ (define-module (test-model-package-metadata) #:use-module (ice-9 match) #:use-module (srfi srfi-64) + #:use-module (guix utils) #:use-module (tests mock-inferior) #:use-module (guix-data-service database)) @@ -12,7 +13,8 @@ (version "2") (synopsis "Foo") (description "Foo description") - (home-page "https://example.com"))) + (home-page "https://example.com") + (location (location "file.scm" 5 0)))) (with-mock-inferior-packages (lambda () -- cgit v1.2.3