1 files changed, 72 insertions, 8 deletions

diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm
index feae290..b5f9fbe 100644
--- a/guix-data-service/model/git-repository.scm
+++ b/guix-data-service/model/git-repository.scm
@@ -16,15 +16,19 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-data-service model git-repository)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (json)
   #:use-module (squee)
+  #:use-module (guix-data-service database)
   #:use-module (guix-data-service model utils)
   #:export (all-git-repositories
             select-git-repository
+            specify-git-repositories
             git-repository-query-substitutes?
             git-repository-id->url
             select-includes-and-excluded-branches-for-git-repository
+            branch-in-list?
             count-git-repositories-with-x-git-repo-header-values
             git-repository-x-git-repo-header->git-repository-id
             git-repository-url->git-repository-id
@@ -66,6 +70,46 @@ WHERE id = $1"
            (string=? fetch_with_authentication "t")
            (and=> poll-interval string->number)))))
 
+(define (specify-git-repositories repositories)
+  (with-postgresql-connection
+   "specify-git-repositories"
+   (lambda (conn)
+     (with-postgresql-transaction
+      conn
+      (lambda (conn)
+        (let* ((existing-ids
+                (map first (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?
+                                 existing-ids
+                                 target-ids)))
+          (for-each
+           (lambda (id-to-remove)
+             (simple-format (current-error-port)
+                            "deleting repository ~A\n"
+                            id-to-remove)
+             (exec-query
+              conn
+              "DELETE FROM git_repositories WHERE id = $1"
+              (list (number->string id-to-remove))))
+           repositories-to-delete)
+
+          (for-each
+           (lambda (repo)
+             (let ((fields (map car repo))
+                   (field-vals (map cdr repo)))
+               (update-or-insert
+                conn
+                "git_repositories"
+                fields
+                field-vals)))
+           repositories)))))))
+
 (define (git-repository-query-substitutes? conn id)
   (match (exec-query
           conn
@@ -84,7 +128,18 @@ WHERE id = $1"
     (((url)) url)))
 
 (define (select-includes-and-excluded-branches-for-git-repository conn id)
-  (match (exec-query
+  (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
           "
 SELECT included_branches, excluded_branches
@@ -92,14 +147,23 @@ FROM git_repositories WHERE id = $1"
           (list (number->string id)))
     (((included_branches excluded_branches))
      (values
-      (if (or (eq? #f included_branches)
-              (string-null? included_branches))
-          '()
-          (parse-postgresql-array-string included_branches))
-      (if (or (eq? excluded_branches #f)
-              (string-null? excluded_branches))
+      (if (NULL? included_branches)
+          included_branches
+          (make-regexes
+           (parse-postgresql-array-string included_branches)))
+      (if (NULL? excluded_branches)
           '()
-          (parse-postgresql-array-string excluded_branches))))))
+          (make-regexes
+           (parse-postgresql-array-string excluded_branches)))))))
+
+(define (branch-in-list? lst branch)
+  (any
+   (lambda (item)
+     (->bool
+      (if (string? item)
+          (string=? item branch)
+          (regexp-exec item branch))))
+   lst))
 
 (define (count-git-repositories-with-x-git-repo-header-values conn)
   (match (exec-query