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

Move away from cgit to more flexible linking to repositories

Browse source
This commit is contained in:
Christopher Baines 2025-05-24 22:55:35 +01:00
parent 36f30551cb
commit 5717ce82ce
19 changed files with 405 additions and 262 deletions
Download patch file Download diff file Expand all files Collapse all files

5
guix-data-service/branch-updated-emails.scm
View file

@ -83,7 +83,7 @@
(select-git-repository conn git-repository-id))
(channel-for-commit
(channel (name 'guix)
(url (second git-repository-details))
(url (assq-ref git-repository-details 'url))
(commit x-git-newrev)))
(channel-instance
;; Obtain a session level lock here, to avoid conflicts with
@ -100,7 +100,8 @@
(latest-channel-instances store
(list channel-for-commit)
#:authenticate?
(fourth git-repository-details)))))))))
(assq-ref git-repository-details
'fetch-with-authentication?)))))))))
(when (string=? (channel-instance-commit channel-instance)
x-git-newrev)

4
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -2548,9 +2548,9 @@ SELECT store_path FROM derivation_source_files WHERE id = $1"
(let* ((git-repository-fields
(select-git-repository conn git-repository-id))
(git-repository-url
(second git-repository-fields))
(assq-ref git-repository-fields 'url))
(fetch-with-authentication?
(fourth git-repository-fields))
(assq-ref git-repository-fields 'fetch-with-authentication?))
(channel-for-commit
(channel (name 'guix)
(url git-repository-url)

16
guix-data-service/model/git-branch.scm
View file

@ -21,6 +21,7 @@
#:use-module (squee)
#:use-module (srfi srfi-19)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service model git-repository)
#:export (git-branch-for-repository-and-name
insert-git-branch-entry
git-branches-for-commit
@ -69,9 +70,7 @@ ORDER BY git_commits.datetime DESC")
(define (git-branches-with-repository-details-for-commit conn commit)
(define query
"
SELECT git_repositories.id, git_repositories.label,
git_repositories.url, git_repositories.cgit_url_base,
git_branches.name, git_commits.datetime
SELECT git_repositories.id, git_branches.name, git_commits.datetime
FROM git_commits
INNER JOIN git_branches
ON git_commits.git_branch_id = git_branches.id
@ -79,9 +78,14 @@ INNER JOIN git_repositories
ON git_branches.git_repository_id = git_repositories.id
WHERE git_commits.commit = $1")
(group-list-by-first-n-fields
4
(exec-query conn query (list commit))))
(map
(match-lambda
(((git-repository-id) . val)
(cons (select-git-repository conn git-repository-id)
val)))
(group-list-by-first-n-fields
1
(exec-query conn query (list commit)))))
(define* (latest-processed-commit-for-branch conn repository-id branch-name)
(define query

137
guix-data-service/model/git-repository.scm
View file

@ -18,6 +18,7 @@
(define-module (guix-data-service model git-repository)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 string-fun)
#:use-module (json)
#:use-module (squee)
#:use-module (guix-data-service database)
@ -34,28 +35,78 @@
git-repository-url->git-repository-id
git-repositories-containing-commit
guix-revisions-and-jobs-for-git-repository))
guix-revisions-and-jobs-for-git-repository
git-repository-commit-link-template->url
git-repository-commit-range-link-template->url
git-repository-file-link-template->url))
(define (make-regexes lst)
(map
(lambda (item)
(if (string-prefix? "/" item)
(make-regexp
(string-drop
(string-drop-right item 1)
1))
item))
lst))
(define (not-null-string-or-#f s)
(if s
(if (string-null? s)
#f
s)
#f))
(define (git-repository->alist fields)
(match fields
((id label url link_url x_git_repo_header included_branches excluded_branches
fetch_with_authentication query_substitutes
poll_interval job_priority
commit_link_url_template commit_range_link_url_template
file_link_url_template)
`((id . ,(string->number id))
(label . ,label)
(url . ,url)
(link-url . ,(not-null-string-or-#f link_url))
(x-git-repo-header . ,x_git_repo_header)
(included-branches
. ,(if (or (eq? #f included_branches)
(NULL? included_branches))
included_branches
(make-regexes
(parse-postgresql-array-string included_branches))))
(excluded-branches
. ,(if (or (eq? #f excluded_branches)
(NULL? excluded_branches))
excluded_branches
(make-regexes
(parse-postgresql-array-string excluded_branches))))
(fetch-with-authentication? . ,(string=? fetch_with_authentication "t"))
(query-substitutes? . ,(string=? query_substitutes "t"))
(poll-interval . ,(and=> poll_interval string->number))
(job-priority . ,(and=> job_priority string->number))
(commit-link-url-template . ,(not-null-string-or-#f
commit_link_url_template))
(commit-range-link-url-template . ,(not-null-string-or-#f
commit_range_link_url_template))
(file-link-url-template . ,(not-null-string-or-#f
file_link_url_template))))))
(define (all-git-repositories conn)
(map
(match-lambda
((id label url cgit-base-url poll-interval)
(list (string->number id)
label
url
cgit-base-url
(and=> poll-interval string->number))))
git-repository->alist
(exec-query
conn
"
SELECT id, label, url, cgit_url_base, poll_interval
FROM git_repositories ORDER BY id ASC")))
SELECT * FROM git_repositories ORDER BY id ASC")))
(define (select-git-repository conn id)
(match (exec-query
conn
"
SELECT label, url, cgit_url_base, fetch_with_authentication, poll_interval
SELECT *
FROM git_repositories
WHERE id = $1"
(list (if (number? id)
@ -63,12 +114,8 @@ WHERE id = $1"
id)))
(()
#f)
(((label url cgit_url_base fetch_with_authentication poll-interval))
(list label
url
cgit_url_base
(string=? fetch_with_authentication "t")
(and=> poll-interval string->number)))))
((fields)
(git-repository->alist fields))))
(define (specify-git-repositories repositories)
(with-postgresql-connection
@ -78,14 +125,16 @@ WHERE id = $1"
conn
(lambda (conn)
(let* ((existing-ids
(map first (all-git-repositories conn)))
(map (lambda (details)
(assq-ref details 'id))
(all-git-repositories conn)))
(target-ids
(map (lambda (repo)
(or (assq-ref repo 'id)
(error "repository missing id")))
repositories))
(repositories-to-delete
(lset-difference equal?
(lset-difference =
existing-ids
target-ids)))
(for-each
@ -128,17 +177,6 @@ WHERE id = $1"
(((url)) url)))
(define (select-includes-and-excluded-branches-for-git-repository conn id)
(define (make-regexes lst)
(map
(lambda (item)
(if (string-prefix? "/" item)
(make-regexp
(string-drop
(string-drop-right item 1)
1))
item))
lst))
(match (exec-query-with-null-handling
conn
"
@ -240,7 +278,7 @@ ORDER BY 1 DESC NULLS FIRST, 2 DESC LIMIT 10;")
(define (git-repositories-containing-commit conn commit)
(define query
"
SELECT id, label, url, cgit_url_base
SELECT *
FROM git_repositories WHERE id IN (
SELECT git_repository_id
FROM git_branches
@ -249,4 +287,39 @@ FROM git_repositories WHERE id IN (
WHERE commit = $1
)")
(exec-query conn query (list commit)))
(map git-repository->alist (exec-query conn query (list commit))))
(define (git-repository-commit-link-template->url template commit)
(and template
(string-replace-substring
template
"$1"
commit)))
(define (git-repository-commit-range-link-template->url template
base-commit
target-commit)
(and template
(string-replace-substring
(string-replace-substring
template
"$2"
target-commit)
"$1"
base-commit)))
(define* (git-repository-file-link-template->url template
commit
file
line)
(and template
(string-replace-substring
(string-replace-substring
(string-replace-substring
template
"$3"
line)
"$2"
file)
"$1"
commit)))

8
guix-data-service/model/guix-revision.scm
View file

@ -28,7 +28,7 @@
guix-commit-exists?
guix-revision-exists?
select-guix-revision-for-branch-and-datetime
guix-revisions-cgit-url-bases))
guix-revisions-commit-range-link-url-templates))
(define (count-guix-revisions conn)
(match (exec-query
@ -115,15 +115,15 @@ LIMIT 1")
(() #f)
((result) result)))
(define (guix-revisions-cgit-url-bases conn guix-revision-ids)
(define (guix-revisions-commit-range-link-url-templates conn guix-revision-ids)
(map
car
(exec-query
conn
(simple-format #f "
SELECT cgit_url_base
SELECT commit_range_link_url_template
FROM git_repositories
WHERE cgit_url_base IS NOT NULL AND id IN (
WHERE commit_range_link_url_template IS NOT NULL AND id IN (
SELECT git_repository_id
FROM guix_revisions
WHERE id IN (VALUES ~A));"

14
guix-data-service/poll-git-repository.scm
View file

@ -71,10 +71,12 @@
#:unwind? #t)
(and=>
(fifth (select-git-repository conn git-repository-id))
(lambda (poll-interval)
(sleep poll-interval)
(loop)))))))))
(select-git-repository conn git-repository-id)
(lambda (details)
(and=> (assq-ref details 'poll-interval)
(lambda (poll-interval)
(sleep poll-interval)
(loop)))))))))))
(define* (just-update-cached-checkout url
#:key
@ -117,11 +119,11 @@
;; I just want to update the cached checkout though, so trying to
;; checkout some revision is unnecessary, hence
;; just-update-cached-checkout
(just-update-cached-checkout (second git-repository-details))
(just-update-cached-checkout (assq-ref git-repository-details 'url))
(let* ((repository-directory
(url-cache-directory
(second git-repository-details)))
(assq-ref git-repository-details 'url)))
(included-branches
excluded-branches

60
guix-data-service/substitutes.scm
View file

@ -224,31 +224,39 @@
"exception when querying substitutes: ~A\n"
exn))
(lambda ()
(with-postgresql-connection
"substitute-query-thread"
(lambda (conn)
(for-each
(match-lambda
((git-repository-id rest ...)
(when (git-repository-query-substitutes? conn git-repository-id)
(for-each
(match-lambda
((branch-name rest ...)
(and=> (latest-processed-commit-for-branch
conn
(number->string git-repository-id)
branch-name)
(lambda (commit)
(query-build-server-substitutes
conn
#f ;; All build servers
(list commit)
#f)))))
(all-branches-with-most-recent-commit
conn
git-repository-id)))))
(all-git-repositories conn))))
(with-exception-handler
(lambda (exn)
(backtrace)
(raise-exception exn))
(lambda ()
(with-postgresql-connection
"substitute-query-thread"
(lambda (conn)
(for-each
(lambda (git-repository-details)
(let ((git-repository-id
(assq-ref git-repository-details 'id)))
(when (git-repository-query-substitutes?
conn
git-repository-id)
(for-each
(match-lambda
((branch-name rest ...)
(and=> (latest-processed-commit-for-branch
conn
(number->string git-repository-id)
branch-name)
(lambda (commit)
(query-build-server-substitutes
conn
#f ;; All build servers
(list commit)
#f)))))
(all-branches-with-most-recent-commit
conn
git-repository-id)))))
(all-git-repositories conn))))
(simple-format #t "finished checking substitutes, now sleeping\n")
(sleep (* 60 30)))
(simple-format #t "finished checking substitutes, now sleeping\n")
(sleep (* 60 30)))))
#:unwind? #t)))))

32
guix-data-service/web/compare/controller.scm
View file

@ -399,24 +399,24 @@
#:extra-headers http-headers-for-unchanging-content))
(else
(fibers-let ((lint-warnings-locale-options
(map
(match-lambda
((locale)
locale))
(with-resource-from-pool (connection-pool) conn
(lint-warning-message-locales-for-revision
conn
(assq-ref query-parameters 'target_commit)))))
(cgit-url-bases
(with-resource-from-pool (connection-pool) conn
(guix-revisions-cgit-url-bases
conn
(list base-revision-id
target-revision-id)))))
(map
(match-lambda
((locale)
locale))
(with-resource-from-pool (connection-pool) conn
(lint-warning-message-locales-for-revision
conn
(assq-ref query-parameters 'target_commit)))))
(commit-range-link-url-templates
(with-resource-from-pool (connection-pool) conn
(guix-revisions-commit-range-link-url-templates
conn
(list base-revision-id
target-revision-id)))))
(render-html
#:sxml (compare query-parameters
'revision
cgit-url-bases
commit-range-link-url-templates
new-packages
removed-packages
version-changes
@ -555,7 +555,7 @@
(target_commit . ,(second target-revision-details)))
'datetime
(with-resource-from-pool (connection-pool) conn
(guix-revisions-cgit-url-bases
(guix-revisions-commit-range-link-url-templates
conn
(list base-revision-id
target-revision-id)))

52
guix-data-service/web/compare/html.scm
View file

@ -24,6 +24,7 @@
#:use-module (texinfo)
#:use-module (texinfo html)
#:use-module (guix-data-service utils)
#:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web util)
#:use-module (guix-data-service web html-utils)
@ -75,7 +76,7 @@
(define (compare query-parameters
mode
cgit-url-bases
commit-range-link-url-templates
new-packages
removed-packages
version-changes
@ -120,12 +121,12 @@
" and "
(a (@ (href ,(string-append "/revision/" target-commit)))
(samp ,(string-take target-commit 8) "…")))
,@(if (apply string=? cgit-url-bases)
`((a (@ (href ,(string-append
(first cgit-url-bases)
"log/?qt=range&q="
base-commit ".." target-commit)))
"(View cgit)"))
,@(if (apply string=? commit-range-link-url-templates)
`((a (@ (href ,(git-repository-commit-range-link-template->url
(first commit-range-link-url-templates)
base-commit
target-commit)))
"(View)"))
'()))))
(div
(@ (class "col-sm-5"))
@ -1217,24 +1218,25 @@ enough builds to determine a change")))
(define (render-location git-repositories commit-hash
data)
(map
(match-lambda
((id label url cgit-url-base)
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
(match data
((('file . file)
('line . line)
('column_number . column-number))
`(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" commit-hash
"#n" (number->string line))))
,file
" (line: " ,line
", column: " ,column-number ")")))
'())))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template)))
(if file-link-url-template
(match data
((('file . file)
('line . line)
('column_number . column-number))
`(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
commit-hash
file
(number->string line))))
,file
" (line: " ,line
", column: " ,column-number ")")))
'())))
git-repositories))
(define cells

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

@ -809,7 +809,7 @@
(cons
git-repository-details
(all-branches-with-most-recent-commit
conn (first git-repository-details))))
conn (assq-ref git-repository-details 'id))))
(all-git-repositories conn))))))
(('GET "builds")
(delegate-to build-controller))

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

@ -16,6 +16,7 @@
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service web repository controller)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (web uri)
#:use-module (web request)
@ -59,11 +60,14 @@
(render-json
`((repositories
. ,(list->vector
(map (match-lambda
((id label url cgit-base-url _)
`((id . ,id)
(label . ,label)
(url . ,url))))
(map (lambda (details)
(filter-map
(match-lambda
((key . val)
(if (memq key '(id label url))
(cons key val)
#f)))
details))
git-repositories))))))
(else
(render-html
@ -72,7 +76,7 @@
(('GET "repository" id)
(match (with-resource-from-pool (connection-pool) conn
(select-git-repository conn id))
((label url cgit-url-base fetch-with-authentication? poll-interval)
(git-repository-details
(fibers-let ((branches
(with-resource-from-pool (connection-pool) conn
(all-branches-with-most-recent-commit
@ -83,9 +87,13 @@
mime-types)
((application/json)
(render-json
`((id . ,id)
(label . ,label)
(url . ,url)
`(,@(filter-map
(match-lambda
((key . val)
(if (memq key '(id label url))
(cons key val)
#f)))
git-repository-details)
(branches
. ,(list->vector
(map (match-lambda
@ -98,7 +106,8 @@
#:sxml
(view-git-repository
(string->number id)
label url cgit-url-base
(assq-ref git-repository-details 'label)
(assq-ref git-repository-details 'url)
branches))))))
(#f
(case (most-appropriate-mime-type

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

@ -47,27 +47,27 @@
(@ (class "col-md-12"))
(h1 ,page-header)))
,@(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))))))
(lambda (details)
(let ((id (assq-ref details 'id))
(label (assq-ref details 'label))
(url (assq-ref details 'url)))
`(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h3 ,url)
(a (@ (href ,(string-append "/repository/" id)))
"View repository")
(dl
(@ (class "dl-horizontal"))
(dt "Label")
(dd ,label)
(dt "URL")
(dd ,url))))))
git-repositories)))))
(define* (view-git-repository git-repository-id
label url cgit-url-base
label url
branches-with-most-recent-commits)
(define page-header (string-append "Repository " (string-drop url 8)))

214
guix-data-service/web/revision/html.scm
View file

@ -23,6 +23,7 @@
#:use-module (texinfo html)
#:use-module (json)
#:use-module (guix-data-service database)
#:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service web util)
#:use-module (guix-data-service web html-utils)
@ -132,13 +133,14 @@
(@ (class "col-sm-12"))
,(append-map
(match-lambda
(((id label url cgit-url-base) . branches)
((git-repository-details . branches)
(map (match-lambda
((branch-name datetime)
`(a (@ (class "btn btn-default btn-lg pull-right")
(href ,(simple-format
#f "/repository/~A/branch/~A/package/~A"
id branch-name name)))
(assq-ref git-repository-details 'id)
branch-name name)))
,(simple-format #f "View ~A branch version history"
branch-name))))
branches)))
@ -255,20 +257,21 @@
(not (null? git-repositories)))
`((dt "Location")
(dd ,@(map
(match-lambda
((id label url cgit-url-base)
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" revision-commit-hash
"#n" line)))
,file
" (line: " ,line
", column: " ,column-number ")")
'())))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template)))
(if file-link-url-template
`(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
revision-commit-hash
file
line)))
,file
" (line: " ,line
", column: " ,column-number ")")
'())))
git-repositories)))
'())
,@(if (> (vector-length licenses) 0)
@ -356,26 +359,27 @@
`((ul
(@ (class "list-unstyled"))
,@(map
(match-lambda
((id label url cgit-url-base)
(let ((output
`(,file
" "
(span
(@ (style "white-space: nowrap"))
"(line: " ,line-number
", column: " ,column-number ")"))))
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(li
(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" revision-commit-hash
"#n" line-number)))
,@output))
`(li ,@output)))))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template))
(output
`(,file
" "
(span
(@ (style "white-space: nowrap"))
"(line: " ,line-number
", column: " ,column-number ")"))))
(if file-link-url-template
`(li
(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
revision-commit-hash
file
line-number)))
,@output))
`(li ,@output))))
git-repositories)))
'())))))
lint-warnings))))))))))
@ -385,26 +389,33 @@
`((h3 "Git repositories")
,@(map
(match-lambda
(((id label url cgit-url-base) . branches)
((git-repository-details . branches)
`((a (@ (href ,(string-append
"/repository/" id)))
(h4 ,url))
"/repository/"
(number->string
(assq-ref git-repository-details 'id)))))
(h4 ,(assq-ref git-repository-details 'url)))
,@(map
(match-lambda
((name datetime)
`(div
(a (@ (href ,(string-append "/repository/" id
"/branch/" name)))
(a (@ (href ,(string-append
"/repository/"
(number->string
(assq-ref git-repository-details 'id))
"/branch/" name)))
,name)
" at " ,datetime
,@(if (string-null? cgit-url-base)
'()
`(" "
(a (@ (href ,(string-append
cgit-url-base
"commit/?id="
commit-hash)))
"(View cgit)"))))))
,@(let ((commit-link-url-template
(assq-ref git-repository-details
'commit-link-url-template)))
(if commit-link-url-template
`(" "
(a (@ (href ,(git-repository-commit-link-template->url
commit-link-url-template
commit-hash)))
"(View)"))
'())))))
branches))))
git-repositories-and-branches)))
@ -692,23 +703,24 @@
(not (string-null? location-file)))
`((ul
,@(map
(match-lambda
((id label url cgit-url-base)
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(li
(a (@ (href
,(string-append
cgit-url-base "tree/"
location-file "?id=" revision-commit-hash
"#n" location-line)))
,location-file
" (line: " ,location-line
", column: " ,location-column-number ")"))
`(li ,location-file
" (line: " ,location-line
", column: " ,location-column-number ")"))))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template)))
(if file-link-url-template
`(li
(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
revision-commit-hash
location-file
location-line)))
,location-file
" (line: " ,location-line
", column: " ,location-column-number ")"))
`(li ,location-file
" (line: " ,location-line
", column: " ,location-column-number ")"))))
git-repositories)))
'())))
'())
@ -930,20 +942,21 @@
,(stexi->shtml
(texi-fragment->stexi description)))
(td ,@(map
(match-lambda
((id label url cgit-url-base)
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" commit-hash
"#n" (number->string line))))
,file
" (line: " ,line
", column: " ,column-number ")")
'())))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template)))
(if file-link-url-template
`(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
commit-hash
file
(number->string line))))
,file
" (line: " ,line
", column: " ,column-number ")")
'())))
git-repositories))
(td (a (@ (href ,derivation-file-name))
,(display-store-item-short derivation-file-name)))
@ -2471,26 +2484,27 @@ figure {
`((ul
(@ (class "list-unstyled"))
,@(map
(match-lambda
((id label url cgit-url-base)
(let ((output
`(,file
" "
(span
(@ (style "white-space: nowrap"))
"(line: " ,line-number
", column: " ,column-number ")"))))
(if
(and cgit-url-base
(not (string-null? cgit-url-base)))
`(li
(a (@ (href
,(string-append
cgit-url-base "tree/"
file "?id=" revision-commit-hash
"#n" line-number)))
,@output))
`(li ,@output)))))
(lambda (git-repository-details)
(let ((file-link-url-template
(assq-ref git-repository-details
'file-link-url-template))
(output
`(,file
" "
(span
(@ (style "white-space: nowrap"))
"(line: " ,line-number
", column: " ,column-number ")"))))
(if file-link-url-template
`(li
(a (@ (href
,(git-repository-file-link-template->url
file-link-url-template
revision-commit-hash
file
(number->string line-number))))
,@output))
`(li ,@output))))
git-repositories)))
'())))
'()))))

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

@ -309,22 +309,23 @@
"Jobs"))))
,@(map
(match-lambda
(((repository-id label url cgit-url-base poll-interval) . branches-with-most-recent-commits)
((git-repository-details . branches-with-most-recent-commits)
`(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 (@ (style "display: inline-block;"))
,url)
,@(if (string-null? cgit-url-base)
'()
`((a (@ (style "padding-left: 0.8em;")
(href ,cgit-url-base))
"(View cgit)")))
,(assq-ref git-repository-details 'url))
,@(or (and=> (assq-ref git-repository-details 'link-url)
(lambda (link-url)
`((a (@ (style "padding-left: 0.8em;")
(href ,link-url))
"(View)"))))
'())
,(if (null? branches-with-most-recent-commits)
'(p "No branches")
(table/branches-with-most-recent-commits
repository-id
(assq-ref git-repository-details 'id)
(filter (lambda (data)
(not (string-null? (second data))))
branches-with-most-recent-commits)))))))

13
scripts/guix-data-service.in
View file

@ -212,13 +212,14 @@
(for-each
(lambda (git-repository-details)
(when (fifth git-repository-details)
(simple-format #t "starting thread to poll ~A (~A)\n"
(second git-repository-details)
(third git-repository-details))
(let ((id (assq-ref git-repository-details 'id)))
(when (assq-ref git-repository-details
'poll-interval)
(simple-format #t "starting thread to poll ~A (~A)\n"
id
(assq-ref git-repository-details 'url))
(start-thread-to-poll-git-repository
(first git-repository-details))))
(start-thread-to-poll-git-repository id))))
(with-postgresql-connection
"poll-startup"
all-git-repositories))

13
sqitch/deploy/git_repository_link_fields.sql Normal file
View file

@ -0,0 +1,13 @@
-- Deploy guix-data-service:git_repository_link_fields to pg
BEGIN;
ALTER TABLE git_repositories RENAME COLUMN cgit_url_base TO link_url;
ALTER TABLE git_repositories ADD COLUMN commit_link_url_template varchar;
ALTER TABLE git_repositories ADD COLUMN commit_range_link_url_template varchar;
ALTER TABLE git_repositories ADD COLUMN file_link_url_template varchar;
COMMIT;

7
sqitch/revert/git_repository_link_fields.sql Normal file
View file

@ -0,0 +1,7 @@
-- Revert guix-data-service:git_repository_link_fields from pg
BEGIN;
-- XXX Add DDLs here.
COMMIT;

1
sqitch/sqitch.plan
View file

@ -101,3 +101,4 @@ git_repositories_job_priority 2024-03-07T09:39:27Z Chris <chris@felis> # Add git
build_server_build_id_index 2024-09-07T17:42:28Z Chris <chris@felis> # Add index on builds.build_server_build_id
alter_build_servers_id_default 2024-12-15T20:48:51Z Chris <chris@fang> # Alter build_servers id default
build_background_processing_queue 2025-05-14T14:18:14Z Chris <chris@fang> # Add build_background_processing_queue
git_repository_link_fields 2025-05-23T14:42:24Z Chris <chris@fang> # Change git repository link related fields

7
sqitch/verify/git_repository_link_fields.sql Normal file
View file

@ -0,0 +1,7 @@
-- Verify guix-data-service:git_repository_link_fields on pg
BEGIN;
-- XXX Add verifications here.
ROLLBACK;