diff --git a/Makefile.am b/Makefile.am index ad5b26a..bc07b88 100644 --- a/Makefile.am +++ b/Makefile.am @@ -110,6 +110,8 @@ SOURCES = \ guix-data-service/web/compare/controller.scm \ guix-data-service/web/compare/html.scm \ guix-data-service/web/dumps/controller.scm \ + guix-data-service/web/package/controller.scm \ + guix-data-service/web/package/html.scm \ guix-data-service/web/dumps/html.scm \ guix-data-service/web/controller.scm \ guix-data-service/web/html-utils.scm \ diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 7d58a8e..82d8ef3 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -34,7 +34,9 @@ package-derivations-for-branch package-outputs-for-branch - any-package-synopsis-or-descriptions-translations?)) + any-package-synopsis-or-descriptions-translations? + + branches-by-package-version)) (define (select-existing-package-entries package-entries) (string-append "SELECT id, packages.name, packages.version, " @@ -532,3 +534,46 @@ ORDER BY first_datetime DESC, package_version DESC") (or (string=? synopsis-locale locale) (string=? description-locale locale)))) packages)) + +(define (branches-by-package-version conn package-name system target) + (define query + " +WITH branches AS ( + SELECT DISTINCT ON (git_repository_id, name) git_repository_id, name, commit + FROM git_branches + WHERE commit <> '' + ORDER BY git_repository_id, name, datetime DESC +) +SELECT packages.version, + JSON_AGG( + json_build_object( + 'git_repository_id', branches.git_repository_id, + 'name', branches.name + ) + ) +FROM branches +INNER JOIN guix_revisions + ON branches.git_repository_id = guix_revisions.git_repository_id + AND branches.commit = guix_revisions.commit +INNER JOIN guix_revision_package_derivations + ON guix_revision_package_derivations.revision_id = guix_revisions.id +INNER JOIN package_derivations + ON package_derivations.id = guix_revision_package_derivations.package_derivation_id + AND package_derivations.system = $2 + AND package_derivations.target = $3 +INNER JOIN packages + ON package_derivations.package_id = packages.id +WHERE packages.name = $1 +GROUP BY packages.version +ORDER BY packages.version DESC") + + (list->vector + (map (match-lambda + ((version + branches-json) + `((version . ,version) + (branches . ,(json-string->scm branches-json))))) + (exec-query + conn + query + (list package-name system target))))) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 6adc093..5e10e41 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -69,6 +69,7 @@ #:use-module (guix-data-service web compare controller) #:use-module (guix-data-service web revision controller) #:use-module (guix-data-service web repository controller) + #:use-module (guix-data-service web package controller) #:export (%show-error-details controller)) @@ -646,6 +647,8 @@ (delegate-to repository-controller)) (('GET "repository" _ ...) (delegate-to repository-controller)) + (('GET "package" _ ...) + (delegate-to package-controller)) (('GET "gnu" "store" filename) ;; These routes are a little special, as the extensions aren't used for ;; content negotiation, so just use the path from the request diff --git a/guix-data-service/web/package/controller.scm b/guix-data-service/web/package/controller.scm new file mode 100644 index 0000000..465c2a3 --- /dev/null +++ b/guix-data-service/web/package/controller.scm @@ -0,0 +1,62 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2021 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 web package controller) + #:use-module (ice-9 match) + #:use-module (web uri) + #:use-module (web request) + #:use-module (guix-data-service utils) + #:use-module (guix-data-service database) + #:use-module (guix-data-service web render) + #:use-module (guix-data-service web query-parameters) + #:use-module (guix-data-service web util) + #:use-module (guix-data-service model package) + #:use-module (guix-data-service web package html) + #:export (package-controller)) + +(define (package-controller request + method-and-path-components + mime-types + body) + (match method-and-path-components + (('GET "package" name) + (let ((parsed-query-parameters + (parse-query-parameters + request + `((system ,parse-system #:default "x86_64-linux") + (target ,parse-target #:default ""))))) + (letpar& ((package-versions-with-branches + (with-thread-postgresql-connection + (lambda (conn) + (branches-by-package-version conn name + (assq-ref parsed-query-parameters + 'system) + (assq-ref parsed-query-parameters + 'target)))))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((name . ,name) + (versions . ,package-versions-with-branches)))) + (else + (render-html + #:sxml + (view-package name package-versions-with-branches))))))))) + + diff --git a/guix-data-service/web/package/html.scm b/guix-data-service/web/package/html.scm new file mode 100644 index 0000000..0d9b078 --- /dev/null +++ b/guix-data-service/web/package/html.scm @@ -0,0 +1,63 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2021 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 web package html) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (ice-9 match) + #:use-module (guix-data-service web html-utils) + #:use-module (guix-data-service web view html) + #:export (view-package)) + +(define* (view-package name package-version-with-branches) + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (h1 "Package: " ,name))) + ,@(map + (match-lambda + ((('version . version) + ('branches . branches)) + `(div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (h3 ,version) + (ul + (@ (class "list-inline")) + ,@(map + (lambda (branch) + `((li + (a + (@ + (href + ,(simple-format + #f + "/repository/~A/branch/~A/latest-processed-revision/package/~A/~A" + (assoc-ref branch "git_repository_id") + (assoc-ref branch "name") + name + version))) + ,(assoc-ref branch "name"))))) + (vector->list branches))))))) + (vector->list package-version-with-branches))))))