Extract out view-revision/git-repositories

As this was duplicated in the functions for viewing known and unknown
revisions.
This commit is contained in:
Christopher Baines 2019-07-22 20:16:28 +01:00
parent 91be72df03
commit 7a70e9ca6f

View file

@ -394,6 +394,28 @@
(td ,(build-status-span status))))) (td ,(build-status-span status)))))
derivations))))))))) derivations)))))))))
(define (view-revision/git-repositories git-repositories-and-branches
commit-hash)
`((h3 "Git repositories")
,@(map
(match-lambda
(((id label url cgit-url-base) . branches)
`((a (@ (href ,(string-append
"/repository/" id)))
(h4 ,url))
,@(map
(match-lambda
((name datetime)
(if (string-null? cgit-url-base)
`(,name " at " ,datetime)
`(a (@ (href ,(string-append
cgit-url-base
"commit/?id="
commit-hash)))
,name " at " ,datetime))))
branches))))
git-repositories-and-branches)))
(define* (view-revision commit-hash packages-count (define* (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count git-repositories-and-branches derivations-count
jobs-and-events jobs-and-events
@ -421,28 +443,10 @@
(a (@ (href ,(string-append path-base "/packages"))) (a (@ (href ,(string-append path-base "/packages")))
"View packages") "View packages")
,@(if ,@(if (null? git-repositories-and-branches)
(null? git-repositories-and-branches) '()
'() (view-revision/git-repositories git-repositories-and-branches
`((h3 "Git repositories") commit-hash))
,@(map
(match-lambda
(((id label url cgit-url-base) . branches)
`((a (@ (href ,(string-append
"/repository/" id)))
(h4 ,url))
,@(map
(match-lambda
((name datetime)
(if (string-null? cgit-url-base)
`(,name " at " ,datetime)
`(a (@ (href ,(string-append
cgit-url-base
"commit/?id="
commit-hash)))
,name " at " ,datetime))))
branches))))
git-repositories-and-branches)))
(h3 "Jobs") (h3 "Jobs")
(table (table
(@ (class "table")) (@ (class "table"))
@ -1564,26 +1568,11 @@
(style "font-size: 2em; display: block;")) (style "font-size: 2em; display: block;"))
"Unknown") "Unknown")
,@(if ,@(if (null? git-repositories-and-branches)
(null? git-repositories-and-branches) '()
'() (view-revision/git-repositories
`((h3 "Git repositories") git-repositories-and-branches
,@(map commit-hash))
(match-lambda
(((id label url cgit-url-base) . branches)
`((h4 ,url)
,@(map
(match-lambda
((name datetime)
(if (string-null? cgit-url-base)
`(,name " at " ,datetime)
`(a (@ (href ,(string-append
cgit-url-base
"commit/?id="
commit-hash)))
,name " at " ,datetime))))
branches))))
git-repositories-and-branches)))
(h3 "Jobs") (h3 "Jobs")
(table (table
(@ (class "table")) (@ (class "table"))