diff options
Diffstat (limited to 'guix-data-service/web/view/html.scm')
| -rw-r--r-- | guix-data-service/web/view/html.scm | 259 |
1 files changed, 2 insertions, 257 deletions
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 2417888..3102106 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -35,15 +35,13 @@ display-store-item-short build-status-span + table/branches-with-most-recent-commits + index readme general-not-found unknown-revision view-statistics - view-git-repository - view-branches - view-branch - view-branch-package view-builds view-derivation view-store-item @@ -349,259 +347,6 @@ "No information yet"))))))))) branches-with-most-recent-commits)))) -(define* (view-git-repository git-repository-id - label url cgit-url-base - branches-with-most-recent-commits) - (layout - #:body - `(,(header) - (div - (@ (class "container")) - (div - (@ (class "row")) - (div - (@ (class "col-md-12")) - (h1 ,url))) - (div - (@ (class "row")) - (div - (@ (class "col-md-12")) - (h3 "Branches") - ,(table/branches-with-most-recent-commits - git-repository-id - branches-with-most-recent-commits))))))) - -(define (view-branch git-repository-id - branch-name query-parameters branch-commits) - (layout - #:body - `(,(header) - (div - (@ (class "container")) - (div - (@ (class "row")) - (div - (@ (class "col-md-12")) - (a (@ (href ,(string-append "/repository/" git-repository-id))) - (h3 "Repository")) - (h1 (@ (style "white-space: nowrap;")) - (samp ,branch-name) " branch"))) - (div - (@ (class "row")) - (div - (@ (class "col-md-12")) - (div - (@ (class "well")) - (form - (@ (method "get") - (action "") - (class "form-horizontal")) - ,(form-horizontal-control - "After date" query-parameters - #:help-text "Only show the branch history after this date.") - ,(form-horizontal-control - "Before date" query-parameters - #:help-text "Only show the branch history before this date.") - ,(form-horizontal-control - "Limit results" query-parameters - #:help-text "The maximum number of results to return.") - (div (@ (class "form-group form-group-lg")) - (div (@ (class "col-sm-offset-2 col-sm-10")) - (button (@ (type "submit") - (class "btn btn-lg btn-primary")) - "Update results"))))))) - (div - (@ (class "row")) - (div - (@ (class "col-sm-12")) - (a (@ (class "btn btn-default btn-lg pull-right") - (href ,(string-append - "/repository/" git-repository-id - "/branch/" branch-name "/latest-processed-revision"))) - "Latest processed revision"))) - (div - (@ (class "row")) - (div - (@ (class "col-md-12")) - (table - (@ (class "table") - (style "table-layout: fixed;")) - (thead - (tr - (th (@ (class "col-sm-3")) "Date") - (th (@ (class "col-sm-7")) "Commit") - (th (@ (class "col-sm-1"))))) - (tbody - ,@(map - (match-lambda* - (((commit date revision-exists? job-events) - (previous-commit previous-revision-exists?)) - `(tr - (td ,date) - (td ,@(if (string=? commit "") - '((samp "branch deleted")) - `((a (@ (href ,(string-append - "/revision/" commit))) - (samp ,commit)) - " " - ,(cond - (revision-exists? - '(span - (@ (class "label label-success")) - "✓")) - ((member "failure" job-events) - '(span (@ (class "label label-danger")) - "Failed to import data")) - (else - '(span (@ (class "label label-default")) - "No information yet")))))) - ,@(if (and previous-commit - revision-exists? - previous-revision-exists?) - `((td - (@ (style "vertical-align: middle;") - (rowspan "2")) - (div - (@ (class "btn-group") - (role "group")) - (a (@ (class "btn btn-sm btn-default") - (title "Compare") - (href ,(string-append - "/compare" - "?base_commit=" previous-commit - "&target_commit=" commit))) - "⇕ Compare")))) - '())))) - branch-commits - (append (map (match-lambda - ((commit date revision-exists? job-events) - (list commit - revision-exists?))) - (cdr branch-commits)) - '((#f #f)))))))))))) - -(define (view-branch-package git-repository-id - branch-name - package-name - versions-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-4")) "Version") - (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 third versions-by-revision-range) - (map fifth versions-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 - ((package-version first-guix-revision-commit - first-datetime - last-guix-revision-commit - last-datetime) - `((tr - (@ (style "border-bottom: 0;")) - (td ,package-version) - (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-by-revision-range)))))))))) - (define (view-builds stats builds) (layout #:body |