Support excluding and including branches from a repository

So that you can have the Guix Data Service only pay attention to some of the
branches.
This commit is contained in:
Christopher Baines 2020-02-08 12:03:41 +00:00
parent bb271c366b
commit c31c9575e0
6 changed files with 70 additions and 15 deletions

View file

@ -16,6 +16,8 @@
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service branch-updated-emails)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (email email)
#:use-module (guix-data-service model git-repository)
@ -42,19 +44,31 @@
x-git-repo)))
(when git-repository-id
(insert-git-branch-entry conn
branch-name
(if (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
""
x-git-newrev)
git-repository-id
date)
(let-values
(((included-branches excluded-branches)
(select-includes-and-excluded-branches-for-git-repository
conn
git-repository-id)))
(let ((excluded-branch?
(member branch-name excluded-branches string=?))
(included-branch?
(member branch-name included-branches string=?)))
(when (and (not excluded-branch?)
(or (null? included-branches)
included-branch?))
(insert-git-branch-entry conn
branch-name
(if (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
""
x-git-newrev)
git-repository-id
date)
(unless (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
(enqueue-load-new-guix-revision-job
conn
git-repository-id
x-git-newrev
(string-append x-git-repo " " x-git-refname " updated"))))))))
(unless (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
(enqueue-load-new-guix-revision-job
conn
git-repository-id
x-git-newrev
(string-append x-git-repo " " x-git-refname " updated")))))))))))

View file

@ -19,9 +19,11 @@
#:use-module (ice-9 match)
#:use-module (json)
#:use-module (squee)
#:use-module (guix-data-service model utils)
#:export (all-git-repositories
select-git-repository
git-repository-id->url
select-includes-and-excluded-branches-for-git-repository
count-git-repositories-with-x-git-repo-header-values
git-repository-x-git-repo-header->git-repository-id
git-repository-url->git-repository-id
@ -61,6 +63,22 @@
(list id))
(((url)) url)))
(define (select-includes-and-excluded-branches-for-git-repository conn id)
(match (exec-query
conn
"
SELECT included_branches, excluded_branches
FROM git_repositories WHERE id = $1"
(list (number->string id)))
(((included_branches excluded_branches))
(values
(if (string=? included_branches "")
'()
(parse-postgresql-array-string included_branches))
(if (string=? excluded_branches "")
'()
(parse-postgresql-array-string excluded_branches))))))
(define (count-git-repositories-with-x-git-repo-header-values conn)
(match (exec-query
conn