diff options
author | Christopher Baines <mail@cbaines.net> | 2019-07-19 21:22:15 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-07-19 21:22:15 +0100 |
commit | 1f977f6c125e10061610dd62c7287e6e9448dea5 (patch) | |
tree | 9bc4f9d736378f8cb231eb15cb0e59b8ef4a2abf | |
parent | 6dd52f08edbe7525c26b86a0d1a414b96cf2288d (diff) | |
download | data-service-1f977f6c125e10061610dd62c7287e6e9448dea5.tar data-service-1f977f6c125e10061610dd62c7287e6e9448dea5.tar.gz |
Improve how repositories and branches are handled
Make the link between repositories and branches clearer, replacing the
/branches and /branch pages by /repository/ and /repository/*/branch/* pages.
-rw-r--r-- | guix-data-service/model/git-branch.scm | 16 | ||||
-rw-r--r-- | guix-data-service/model/git-repository.scm | 11 | ||||
-rw-r--r-- | guix-data-service/web/controller.scm | 26 | ||||
-rw-r--r-- | guix-data-service/web/view/html.scm | 27 |
4 files changed, 59 insertions, 21 deletions
diff --git a/guix-data-service/model/git-branch.scm b/guix-data-service/model/git-branch.scm index 985fd0d..94b00f3 100644 --- a/guix-data-service/model/git-branch.scm +++ b/guix-data-service/model/git-branch.scm @@ -48,7 +48,8 @@ WHERE git_branches.commit = $1") 3 (exec-query conn query (list commit)))) -(define* (most-recent-commits-for-branch conn branch-name +(define* (most-recent-commits-for-branch conn git-repository-id + branch-name #:key (limit 100) after-date @@ -67,7 +68,7 @@ WHERE git_branches.commit = $1") ) AS job_events " "FROM git_branches " "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit " - "WHERE name = $1 " + "WHERE name = $1 AND git_branches.git_repository_id = $2" (if after-date (simple-format #f " AND datetime > '~A'" (date->string after-date "~1 ~3")) @@ -93,7 +94,7 @@ WHERE git_branches.commit = $1") (exec-query conn query - (list branch-name)))) + (list branch-name git-repository-id)))) (define* (latest-processed-commit-for-branch conn branch-name) (define query @@ -114,7 +115,7 @@ WHERE git_branches.commit = $1") ('() #f))) -(define (all-branches-with-most-recent-commit conn) +(define (all-branches-with-most-recent-commit conn git-repository-id) (define query (string-append " @@ -131,8 +132,8 @@ SELECT DISTINCT ON (name) ) AS job_events FROM git_branches LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit -WHERE git_branches.commit IS NOT NULL -ORDER BY name, datetime DESC;")) +WHERE git_branches.commit IS NOT NULL AND git_branches.git_repository_id = $1 +ORDER BY name, datetime DESC")) (map (match-lambda @@ -146,5 +147,6 @@ ORDER BY name, datetime DESC;")) (vector->list (json-string->scm job_events)))))) (exec-query conn - query))) + query + (list git-repository-id)))) diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm index bbb5553..8eb7ee6 100644 --- a/guix-data-service/model/git-repository.scm +++ b/guix-data-service/model/git-repository.scm @@ -3,6 +3,7 @@ #:use-module (json) #:use-module (squee) #:export (all-git-repositories + select-git-repository git-repository-id->url git-repository-url->git-repository-id git-repositories-containing-commit @@ -15,6 +16,16 @@ (string-append "SELECT id, label, url FROM git_repositories ORDER BY id ASC"))) +(define (select-git-repository conn id) + (match (exec-query + conn + "SELECT label, url, cgit_url_base FROM git_repositories WHERE id = $1" + (list id)) + (() + #f) + ((result) + result))) + (define (git-repository-id->url conn id) (match (exec-query diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 8923da8..e49e0a7 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -682,11 +682,22 @@ (render-unknown-revision mime-types conn commit-hash))) - (('GET "branches") - (render-html - #:sxml (view-branches - (all-branches-with-most-recent-commit conn)))) - (('GET "branch" branch-name) + (('GET "repository" id) + (match (select-git-repository conn id) + ((label url cgit-url-base) + (render-html + #:sxml + (view-git-repository + id + label url cgit-url-base + (all-branches-with-most-recent-commit conn id)))) + (#f + (render-html + #:sxml (general-not-found + "Repository not found" + "") + #:code 404)))) + (('GET "repository" repository-id "branch" branch-name) (let ((parsed-query-parameters (parse-query-parameters request @@ -695,12 +706,15 @@ (limit_results ,parse-result-limit #:default 100))))) (render-html #:sxml (if (any-invalid-query-parameters? parsed-query-parameters) - (view-branch branch-name parsed-query-parameters '()) + (view-branch repository-id + branch-name parsed-query-parameters '()) (view-branch + repository-id branch-name parsed-query-parameters (most-recent-commits-for-branch conn + repository-id branch-name #:limit (assq-ref parsed-query-parameters 'limit_results) #:after-date (assq-ref parsed-query-parameters diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index bd0be26..78a7183 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -35,6 +35,7 @@ view-revision-package-and-version view-revision view-revision-packages + view-git-repository view-branches view-branch view-builds @@ -232,7 +233,7 @@ (h1 "Guix Data Service"))) ,@(map (match-lambda - (((id label url) . revisions) + (((repository-id label url) . revisions) `(div (@ (class "row")) (div @@ -249,7 +250,7 @@ (tbody ,@(map (match-lambda - ((id job-id job-events commit source branches) + ((revision-id job-id job-events commit source branches) `(tr (td ,@(map @@ -257,6 +258,8 @@ ((name date) `(span (a (@ (href ,(string-append + "/repository/" + repository-id "/branch/" name))) ,name) " at " @@ -267,7 +270,7 @@ (samp ,commit)) " " ,(cond - ((not (string-null? id)) + ((not (string-null? revision-id)) '(span (@ (class "label label-success")) "✓")) @@ -630,7 +633,9 @@ "Next page"))) '()))))) -(define* (view-branches 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) @@ -640,11 +645,12 @@ (@ (class "row")) (div (@ (class "col-md-12")) - (h1 "Branches"))) + (h1 ,url))) (div (@ (class "row")) (div (@ (class "col-md-12")) + (h3 "Branches") (table (@ (class "table table-responsive")) (thead @@ -658,7 +664,9 @@ ((name commit date revision-exists? job-events) `(tr (td - (a (@ (href ,(string-append "/branch/" name))) + (a (@ (href ,(string-append + "/repository/" git-repository-id + "/branch/" name))) ,name)) (td ,date) (td ,@(if (string=? commit "NULL") @@ -680,8 +688,8 @@ "No information yet"))))))))) branches-with-most-recent-commits))))))))) -(define (view-branch branch-name query-parameters - branch-commits) +(define (view-branch git-repository-id + branch-name query-parameters branch-commits) (layout #:body `(,(header) @@ -691,6 +699,8 @@ (@ (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 @@ -723,6 +733,7 @@ (@ (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 |