aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-07-19 21:22:15 +0100
committerChristopher Baines <mail@cbaines.net>2019-07-19 21:22:15 +0100
commit1f977f6c125e10061610dd62c7287e6e9448dea5 (patch)
tree9bc4f9d736378f8cb231eb15cb0e59b8ef4a2abf
parent6dd52f08edbe7525c26b86a0d1a414b96cf2288d (diff)
downloaddata-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.scm16
-rw-r--r--guix-data-service/model/git-repository.scm11
-rw-r--r--guix-data-service/web/controller.scm26
-rw-r--r--guix-data-service/web/view/html.scm27
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