diff options
| -rw-r--r-- | guix-data-service/model/package.scm | 44 | ||||
| -rw-r--r-- | guix-data-service/web/repository/controller.scm | 36 | ||||
| -rw-r--r-- | guix-data-service/web/repository/html.scm | 154 |
3 files changed, 232 insertions, 2 deletions
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index c1cd2ae..0253a5a 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -12,7 +12,8 @@ inferior-packages->package-ids select-package-versions-for-revision - package-versions-for-branch)) + package-versions-for-branch + package-derivations-for-branch)) (define (select-existing-package-entries package-entries) (string-append "SELECT id, packages.name, packages.version, " @@ -236,3 +237,44 @@ ORDER BY first_datetime DESC, package_version DESC" (number->string git-repository-id) branch-name))) +(define (package-derivations-for-branch conn + git-repository-id + branch-name + system + target + package-name) + (exec-query + conn + " +SELECT package_version, + derivations.file_name, + first_guix_revisions.commit AS first_guix_revision_commit, + first_git_branches.datetime AS first_datetime, + last_guix_revisions.commit AS last_guix_revision_commit, + last_git_branches.datetime AS last_datetime +FROM package_derivations_by_guix_revision_range +INNER JOIN derivations + ON package_derivations_by_guix_revision_range.derivation_id = derivations.id +INNER JOIN guix_revisions AS first_guix_revisions + ON first_guix_revision_id = first_guix_revisions.id +INNER JOIN git_branches AS first_git_branches + ON first_guix_revisions.git_repository_id = first_git_branches.git_repository_id + AND first_guix_revisions.commit = first_git_branches.commit +INNER JOIN guix_revisions AS last_guix_revisions + ON last_guix_revision_id = last_guix_revisions.id +INNER JOIN git_branches AS last_git_branches + ON last_guix_revisions.git_repository_id = last_git_branches.git_repository_id + AND last_guix_revisions.commit = last_git_branches.commit +WHERE package_name = $1 +AND package_derivations_by_guix_revision_range.git_repository_id = $2 +AND package_derivations_by_guix_revision_range.branch_name = $3 +AND first_git_branches.name = $3 +AND last_git_branches.name = $3 +AND package_derivations_by_guix_revision_range.system = $4 +AND package_derivations_by_guix_revision_range.target = $5 +ORDER BY first_datetime DESC, package_version DESC" + (list package-name + (number->string git-repository-id) + branch-name + system + target))) diff --git a/guix-data-service/web/repository/controller.scm b/guix-data-service/web/repository/controller.scm index 23e3559..cdc89d6 100644 --- a/guix-data-service/web/repository/controller.scm +++ b/guix-data-service/web/repository/controller.scm @@ -111,6 +111,42 @@ branch-name package-name package-versions)))))) + (('GET "repository" repository-id "branch" branch-name "package" package-name "derivation-history") + (let ((package-derivations + (package-derivations-for-branch conn + (string->number repository-id) + branch-name + "x86_64-linux" + "x86_64-linux" + package-name))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((versions . ,(list->vector + (map (match-lambda + ((package-version derivation-file-name + first-guix-revision-commit + first-datetime + last-guix-revision-commit + last-datetime) + `((version . ,package-version) + (derivation . ,derivation-file-name) + (first_revision + . ((commit . ,first-guix-revision-commit) + (datetime . ,first-datetime))) + (last_revision + . ((commit . ,last-guix-revision-commit) + (datetime . ,last-datetime)))))) + package-versions)))))) + (else + (render-html + #:sxml (view-branch-package-derivations + repository-id + branch-name + package-name + package-derivations)))))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision") (let ((commit-hash (latest-processed-commit-for-branch conn repository-id branch-name))) diff --git a/guix-data-service/web/repository/html.scm b/guix-data-service/web/repository/html.scm index 43f3df7..129279d 100644 --- a/guix-data-service/web/repository/html.scm +++ b/guix-data-service/web/repository/html.scm @@ -23,7 +23,8 @@ #:export (view-git-repository view-branches view-branch - view-branch-package)) + view-branch-package + view-branch-package-derivations)) (define* (view-git-repository git-repository-id label url cgit-url-base @@ -277,3 +278,154 @@ (rationalize margin-left 1) (rationalize width 1))))))))))) versions-by-revision-range)))))))))) + +(define (view-branch-package-derivations git-repository-id + branch-name + package-name + derivations-by-revision-range) + (define versions-list + (pair-fold (match-lambda* + (((last) (count result ...)) + (cons (cons last count) + result)) + (((a b rst ...) (count result ...)) + (peek a b) + (if (string=? a b) + (cons (+ 1 count) + (cons #f result)) + (cons 1 + (cons (cons a count) + result))))) + '(1) + (reverse + (map first derivations-by-revision-range)))) + + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (a (@ (href ,(string-append "/repository/" git-repository-id))) + (h3 "Repository")) + (a (@ (href ,(string-append "/repository/" git-repository-id + "/branch/" branch-name))) + (h3 ,(string-append branch-name " branch"))) + (a (@ (class "btn btn-default btn-lg pull-right") + (href ,(string-append + "/repository/" git-repository-id + "/branch/" branch-name + "/package/" package-name + ".json"))) + "View JSON") + (h1 (@ (style "white-space: nowrap;")) + (samp ,package-name)))) + (div + (@ (class "row")) + (div + (@ (class "col-md-12")) + (table + (@ (class "table") + (style "table-layout: fixed;")) + (thead + (tr + (th (@ (class "col-sm-3")) "Version") + (th (@ (class "col-sm-5")) "Derivation") + (th (@ (class "col-sm-4")) "From") + (th (@ (class "col-sm-4")) "To"))) + (tbody + ,@(let* ((times-in-seconds + (map (lambda (d) + (time-second + (date->time-monotonic + (string->date d "~Y-~m-~d ~H:~M:~S")))) + (append (map fourth derivations-by-revision-range) + (map sixth derivations-by-revision-range)))) + (earliest-date-seconds + (apply min + times-in-seconds)) + (latest-date-seconds + (apply max + times-in-seconds)) + (min-to-max-seconds + (- latest-date-seconds + earliest-date-seconds))) + (map + (match-lambda* + ((version-column-entry + (package-version derivation-file-name + first-guix-revision-commit + first-datetime + last-guix-revision-commit + last-datetime)) + `((tr + (@ (style "border-bottom: 0;")) + ,@(match version-column-entry + (#f '()) + ((package-version . rowspan) + `((td (@ (rowspan ,(* 2 ; To account for the extra rows + rowspan))) + ,package-version)))) + (td + (a (@ (href ,derivation-file-name)) + ,(display-store-item-short derivation-file-name))) + (td (a (@ (href ,(string-append + "/revision/" first-guix-revision-commit))) + ,first-datetime) + (br) + (a (@ (href ,(string-append + "/revision/" + first-guix-revision-commit + "/package/" + package-name "/" package-version))) + "(More information)")) + (td (a (@ (href ,(string-append + "/revision/" last-guix-revision-commit))) + ,last-datetime) + (br) + (a (@ (href ,(string-append + "/revision/" + last-guix-revision-commit + "/package/" + package-name "/" package-version))) + "(More information)"))) + (tr + (td + (@ (colspan 3) + (style "border-top: 0; padding-top: 0;")) + (div + (@ + (style + ,(let* ((start-seconds + (time-second + (date->time-monotonic + (string->date first-datetime + "~Y-~m-~d ~H:~M:~S")))) + (end-seconds + (time-second + (date->time-monotonic + (string->date last-datetime + "~Y-~m-~d ~H:~M:~S")))) + (margin-left + (min + (* (/ (- start-seconds earliest-date-seconds) + min-to-max-seconds) + 100) + 98)) + (width + (max + (- (* (/ (- end-seconds earliest-date-seconds) + min-to-max-seconds) + 100) + margin-left) + 2))) + (simple-format + #f + "margin-left: ~A%; width: ~A%; height: 10px; background: #DCDCDC;" + (rationalize margin-left 1) + (rationalize width 1))))))))))) + versions-list + derivations-by-revision-range)))))))))) |