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

Add a very basic repositories page

Browse source
This commit is contained in:
Christopher Baines 2020-02-01 13:33:14 +01:00
parent 6bc753dd0e
commit 744ab9366b
3 changed files with 40 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -289,6 +289,8 @@
(count-derivations conn)))) (count-derivations conn))))
(('GET "revision" args ...) (('GET "revision" args ...)
(delegate-to revision-controller)) (delegate-to revision-controller))
(('GET "repositories")
(delegate-to repository-controller))
(('GET "repository" _ ...) (('GET "repository" _ ...)
(delegate-to repository-controller)) (delegate-to repository-controller))
(('GET "gnu" "store" filename) (('GET "gnu" "store" filename)

5
guix-data-service/web/repository/controller.scm
View file

@ -42,6 +42,11 @@
(uri-path (request-uri request))) (uri-path (request-uri request)))
(match method-and-path-components (match method-and-path-components
(('GET "repositories")
(let ((git-repositories (all-git-repositories conn)))
(render-html
#:sxml
(view-git-repositories git-repositories))))
(('GET "repository" id) (('GET "repository" id)
(match (select-git-repository conn id) (match (select-git-repository conn id)
((label url cgit-url-base) ((label url cgit-url-base)

34
guix-data-service/web/repository/html.scm
View file

@ -21,12 +21,44 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (guix-data-service web html-utils) #:use-module (guix-data-service web html-utils)
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
#:export (view-git-repository #:export (view-git-repositories
view-git-repository
view-branches view-branches
view-branch view-branch
view-branch-package view-branch-package
view-branch-package-derivations)) view-branch-package-derivations))
(define* (view-git-repositories git-repositories)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 "Git repositories")))
,@(map
(match-lambda
((id label url cgit-base-url)
`(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h3 ,url)
(a (@ (href ,(string-append "/repository/" (number->string id))))
"View repository")
(dl
(@ (class "dl-horizontal"))
(dt "Label")
(dd ,label)
(dt "URL")
(dd ,url)
(dt "cgit base URL")
(dd ,cgit-base-url))))))
git-repositories)))))
(define* (view-git-repository git-repository-id (define* (view-git-repository git-repository-id
label url cgit-url-base label url cgit-url-base
branches-with-most-recent-commits) branches-with-most-recent-commits)