cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve how repositories and branches are handled

Browse source 
Make the link between repositories and branches clearer, replacing the
/branches and /branch pages by /repository/ and /repository/*/branch/* pages.
This commit is contained in:
Christopher Baines 2019-07-19 21:22:15 +01:00
parent 6dd52f08ed
commit 1f977f6c12
4 changed files with 59 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

16
guix-data-service/model/git-branch.scm
View file

@ -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))))

11
guix-data-service/model/git-repository.scm
View file

@ -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

24
guix-data-service/web/controller.scm
View file

@ -682,11 +682,22 @@
(render-unknown-revision mime-types
conn
commit-hash)))
(('GET "branches")
(('GET "repository" id)
(match (select-git-repository conn id)
((label url cgit-url-base)
(render-html
#:sxml (view-branches
(all-branches-with-most-recent-commit conn))))
(('GET "branch" branch-name)
#: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

27
guix-data-service/web/view/html.scm
View file

@ -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