Add options to the query-build-servers script

So you can select to query specific build servers.

1 files changed, 36 insertions, 4 deletions

diff --git a/scripts/guix-data-service-query-build-servers.in b/scripts/guix-data-service-query-build-servers.in
index aa66a9f..9ef8347 100644
--- a/scripts/guix-data-service-query-build-servers.in
+++ b/scripts/guix-data-service-query-build-servers.in
@@ -26,7 +26,39 @@
              (guix-data-service database)
              (guix-data-service builds))
 
-(with-postgresql-connection
- "query-build-servers"
- (lambda (conn)
-   (query-build-servers conn (cdr (command-line)))))
+(define %options
+  ;; Specifications of the command-line options
+  (list (option '("build-server-id") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons
+                   'build-server-ids
+                   (cons (string->number arg)
+                         (or (assoc-ref result 'build-server-ids)
+                             '()))
+                   (alist-delete 'build-server-ids result))))))
+
+(define %default-options
+  ;; Alist of default option values
+  '())
+
+(define (parse-options args)
+  (args-fold
+   args %options
+   (lambda (opt name arg result)
+     (error "unrecognized option" name))
+   (lambda (arg result)
+     (alist-cons
+      'revision-commits
+      (cons arg
+            (or (assoc-ref result 'revision-commits)
+                '()))
+      (alist-delete 'revision-commits result)))
+   %default-options))
+
+(let ((opts (parse-options (cdr (program-arguments)))))
+  (with-postgresql-connection
+   "query-build-servers"
+   (lambda (conn)
+     (query-build-servers conn
+                          (assq-ref opts 'build-server-ids)
+                          (assq-ref opts 'revision-commits)))))