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 3
(exec-query conn query (list commit)))) (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 #:key
(limit 100) (limit 100)
after-date after-date
@ -67,7 +68,7 @@ WHERE git_branches.commit = $1")
) AS job_events " ) AS job_events "
"FROM git_branches " "FROM git_branches "
"LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit " "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 (if after-date
(simple-format #f " AND datetime > '~A'" (simple-format #f " AND datetime > '~A'"
(date->string after-date "~1 ~3")) (date->string after-date "~1 ~3"))
@ -93,7 +94,7 @@ WHERE git_branches.commit = $1")
(exec-query (exec-query
conn conn
query query
(list branch-name)))) (list branch-name git-repository-id))))
(define* (latest-processed-commit-for-branch conn branch-name) (define* (latest-processed-commit-for-branch conn branch-name)
(define query (define query
@ -114,7 +115,7 @@ WHERE git_branches.commit = $1")
('() ('()
#f))) #f)))
(define (all-branches-with-most-recent-commit conn) (define (all-branches-with-most-recent-commit conn git-repository-id)
(define query (define query
(string-append (string-append
" "
@ -131,8 +132,8 @@ SELECT DISTINCT ON (name)
) AS job_events ) AS job_events
FROM git_branches FROM git_branches
LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit
WHERE git_branches.commit IS NOT NULL WHERE git_branches.commit IS NOT NULL AND git_branches.git_repository_id = $1
ORDER BY name, datetime DESC;")) ORDER BY name, datetime DESC"))
(map (map
(match-lambda (match-lambda
@ -146,5 +147,6 @@ ORDER BY name, datetime DESC;"))
(vector->list (json-string->scm job_events)))))) (vector->list (json-string->scm job_events))))))
(exec-query (exec-query
conn 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 (json)
#:use-module (squee) #:use-module (squee)
#:export (all-git-repositories #:export (all-git-repositories
select-git-repository
git-repository-id->url git-repository-id->url
git-repository-url->git-repository-id git-repository-url->git-repository-id
git-repositories-containing-commit git-repositories-containing-commit
@ -15,6 +16,16 @@
(string-append (string-append
"SELECT id, label, url FROM git_repositories ORDER BY id ASC"))) "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) (define (git-repository-id->url conn id)
(match (match
(exec-query (exec-query

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

@ -682,11 +682,22 @@
(render-unknown-revision mime-types (render-unknown-revision mime-types
conn conn
commit-hash))) commit-hash)))
(('GET "branches") (('GET "repository" id)
(render-html (match (select-git-repository conn id)
#:sxml (view-branches ((label url cgit-url-base)
(all-branches-with-most-recent-commit conn)))) (render-html
(('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 (let ((parsed-query-parameters
(parse-query-parameters (parse-query-parameters
request request
@ -695,12 +706,15 @@
(limit_results ,parse-result-limit #:default 100))))) (limit_results ,parse-result-limit #:default 100)))))
(render-html (render-html
#:sxml (if (any-invalid-query-parameters? parsed-query-parameters) #: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 (view-branch
repository-id
branch-name branch-name
parsed-query-parameters parsed-query-parameters
(most-recent-commits-for-branch (most-recent-commits-for-branch
conn conn
repository-id
branch-name branch-name
#:limit (assq-ref parsed-query-parameters 'limit_results) #:limit (assq-ref parsed-query-parameters 'limit_results)
#:after-date (assq-ref parsed-query-parameters #: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-package-and-version
view-revision view-revision
view-revision-packages view-revision-packages
view-git-repository
view-branches view-branches
view-branch view-branch
view-builds view-builds
@ -232,7 +233,7 @@
(h1 "Guix Data Service"))) (h1 "Guix Data Service")))
,@(map ,@(map
(match-lambda (match-lambda
(((id label url) . revisions) (((repository-id label url) . revisions)
`(div `(div
(@ (class "row")) (@ (class "row"))
(div (div
@ -249,7 +250,7 @@
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
((id job-id job-events commit source branches) ((revision-id job-id job-events commit source branches)
`(tr `(tr
(td (td
,@(map ,@(map
@ -257,6 +258,8 @@
((name date) ((name date)
`(span `(span
(a (@ (href ,(string-append (a (@ (href ,(string-append
"/repository/"
repository-id
"/branch/" name))) "/branch/" name)))
,name) ,name)
" at " " at "
@ -267,7 +270,7 @@
(samp ,commit)) (samp ,commit))
" " " "
,(cond ,(cond
((not (string-null? id)) ((not (string-null? revision-id))
'(span '(span
(@ (class "label label-success")) (@ (class "label label-success"))
"✓")) "✓"))
@ -630,7 +633,9 @@
"Next page"))) "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 (layout
#:body #:body
`(,(header) `(,(header)
@ -640,11 +645,12 @@
(@ (class "row")) (@ (class "row"))
(div (div
(@ (class "col-md-12")) (@ (class "col-md-12"))
(h1 "Branches"))) (h1 ,url)))
(div (div
(@ (class "row")) (@ (class "row"))
(div (div
(@ (class "col-md-12")) (@ (class "col-md-12"))
(h3 "Branches")
(table (table
(@ (class "table table-responsive")) (@ (class "table table-responsive"))
(thead (thead
@ -658,7 +664,9 @@
((name commit date revision-exists? job-events) ((name commit date revision-exists? job-events)
`(tr `(tr
(td (td
(a (@ (href ,(string-append "/branch/" name))) (a (@ (href ,(string-append
"/repository/" git-repository-id
"/branch/" name)))
,name)) ,name))
(td ,date) (td ,date)
(td ,@(if (string=? commit "NULL") (td ,@(if (string=? commit "NULL")
@ -680,8 +688,8 @@
"No information yet"))))))))) "No information yet")))))))))
branches-with-most-recent-commits))))))))) branches-with-most-recent-commits)))))))))
(define (view-branch branch-name query-parameters (define (view-branch git-repository-id
branch-commits) branch-name query-parameters branch-commits)
(layout (layout
#:body #:body
`(,(header) `(,(header)
@ -691,6 +699,8 @@
(@ (class "row")) (@ (class "row"))
(div (div
(@ (class "col-md-12")) (@ (class "col-md-12"))
(a (@ (href ,(string-append "/repository/" git-repository-id)))
(h3 "Repository"))
(h1 (@ (style "white-space: nowrap;")) (h1 (@ (style "white-space: nowrap;"))
(samp ,branch-name) " branch"))) (samp ,branch-name) " branch")))
(div (div
@ -723,6 +733,7 @@
(@ (class "col-sm-12")) (@ (class "col-sm-12"))
(a (@ (class "btn btn-default btn-lg pull-right") (a (@ (class "btn btn-default btn-lg pull-right")
(href ,(string-append (href ,(string-append
"/repository/" git-repository-id
"/branch/" branch-name "/latest-processed-revision"))) "/branch/" branch-name "/latest-processed-revision")))
"Latest processed revision"))) "Latest processed revision")))
(div (div