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

Start to handle information about Git branches

Browse source 
Add some new pages /branches and /branch/... as well as a new git_branches
table. Also extend the email processing to enter the branch information in to
the database.
This commit is contained in:
Christopher Baines 2019-05-05 20:06:28 +01:00
parent ce4c3c6ed3
commit 5028dfe706
11 changed files with 382 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -30,6 +30,8 @@
view-revision-package-and-version
view-revision
view-revision-packages
view-branches
view-branch
view-builds
view-derivation
view-store-item
@ -160,13 +162,21 @@
(tbody
,@(map
(match-lambda
((id job-id commit source)
((id job-id commit source branches)
`(tr
(td ,(if (string-null? id)
`(samp ,commit)
`(a (@ (href ,(string-append
"/revision/" commit)))
(samp ,commit)))))))
(samp ,commit))))
(td
,@(map
(match-lambda
((name date)
`(a (@ (href ,(string-append
"/branch/" name)))
,name)))
branches)))))
revisions))))))))
git-repositories-and-revisions)))))
@ -348,6 +358,87 @@
"More information")))))
packages)))))))))
(define (view-branches branches-with-most-recent-commits)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 "Branches")))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(table
(@ (class "table table-responsive"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-3")) "Commit")
(th (@ (class "col-md-3")) "Date")))
(tbody
,@(map
(match-lambda
((name commit date revision-exists)
`(tr
(td
(a (@ (href ,(string-append "/branch/" name)))
,name))
(td ,date)
(td ,(if (string=? revision-exists "t")
`(a (@ (href ,(string-append
"/revision/" commit)))
(samp ,commit))
`(samp ,(if (string=? commit "NULL")
"branch deleted"
commit)))))))
branches-with-most-recent-commits)))))))))
(define (view-branch branch-name branch-commits)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 (@ (style "white-space: nowrap;"))
(samp ,branch-name) " branch")))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(table
(@ (class "table table-responsive"))
(thead
(tr
(th (@ (class "col-md-3")) "Date")
(th (@ (class "col-md-3")) "Commit")))
(tbody
,@(map
(match-lambda
((commit date revision-exists)
`(tr
(td ,date)
(td ,(if (string=? revision-exists "t")
`(a (@ (href ,(string-append
"/revision/" commit)))
(samp ,commit))
`(samp ,(if (string=? commit "NULL")
"branch deleted"
commit)))))))
branch-commits)))))))))
(define (view-builds stats builds)
(layout
#:extra-headers