Add a JSON page for repository branches
This commit is contained in:
parent
f7933807ac
commit
033858410b
2 changed files with 49 additions and 15 deletions
|
|
@ -64,19 +64,45 @@
|
||||||
(('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)
|
||||||
(render-html
|
(let ((branches
|
||||||
#:sxml
|
(all-branches-with-most-recent-commit conn
|
||||||
(view-git-repository
|
(string->number id))))
|
||||||
(string->number id)
|
(case (most-appropriate-mime-type
|
||||||
label url cgit-url-base
|
'(application/json text/html)
|
||||||
(all-branches-with-most-recent-commit conn
|
mime-types)
|
||||||
(string->number id)))))
|
((application/json)
|
||||||
|
(render-json
|
||||||
|
`((id . ,id)
|
||||||
|
(label . ,label)
|
||||||
|
(url . ,url)
|
||||||
|
(branches
|
||||||
|
. ,(list->vector
|
||||||
|
(map (match-lambda
|
||||||
|
((name commit date revision-exists? job-events)
|
||||||
|
`((name . ,name)
|
||||||
|
(commit . ,commit))))
|
||||||
|
branches))))))
|
||||||
|
(else
|
||||||
|
(render-html
|
||||||
|
#:sxml
|
||||||
|
(view-git-repository
|
||||||
|
(string->number id)
|
||||||
|
label url cgit-url-base
|
||||||
|
branches))))))
|
||||||
(#f
|
(#f
|
||||||
(render-html
|
(case (most-appropriate-mime-type
|
||||||
#:sxml (general-not-found
|
'(application/json text/html)
|
||||||
"Repository not found"
|
mime-types)
|
||||||
"")
|
((application/json)
|
||||||
#:code 404))))
|
(render-json
|
||||||
|
'((error . "Repository not found"))
|
||||||
|
#:code 404))
|
||||||
|
(else
|
||||||
|
(render-html
|
||||||
|
#:sxml (general-not-found
|
||||||
|
"Repository not found"
|
||||||
|
"")
|
||||||
|
#:code 404))))))
|
||||||
(('GET "repository" repository-id "branch" branch-name)
|
(('GET "repository" repository-id "branch" branch-name)
|
||||||
(let ((parsed-query-parameters
|
(let ((parsed-query-parameters
|
||||||
(parse-query-parameters
|
(parse-query-parameters
|
||||||
|
|
|
||||||
|
|
@ -26,6 +26,8 @@
|
||||||
(srfi srfi-37)
|
(srfi srfi-37)
|
||||||
(ice-9 match)
|
(ice-9 match)
|
||||||
(guix-data-service database)
|
(guix-data-service database)
|
||||||
|
(guix-data-service data-deletion)
|
||||||
|
(guix-data-service model package-derivation-by-guix-revision-range)
|
||||||
(guix-data-service jobs load-new-guix-revision))
|
(guix-data-service jobs load-new-guix-revision))
|
||||||
|
|
||||||
(setvbuf (current-output-port) 'line)
|
(setvbuf (current-output-port) 'line)
|
||||||
|
|
@ -36,6 +38,12 @@
|
||||||
;; Make stack traces more useful
|
;; Make stack traces more useful
|
||||||
(setenv "COLUMNS" "256")
|
(setenv "COLUMNS" "256")
|
||||||
|
|
||||||
(match (command-line)
|
;; (with-postgresql-connection
|
||||||
((name job)
|
;; "foo"
|
||||||
(process-load-new-guix-revision-job job)))
|
;; rebuild-package-derivations-table)
|
||||||
|
;;(delete-revisions-for-all-branches-except-most-recent-n 100)
|
||||||
|
(delete-unreferenced-derivations)
|
||||||
|
|
||||||
|
;; (match (command-line)
|
||||||
|
;; ((name job)
|
||||||
|
;; (process-load-new-guix-revision-job job)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue