Allow customising the maximum number of processes

guix-data-service/jobs.scm

@@ -2,9 +2,11 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (guix-data-service jobs load-new-guix-revision)
-  #:export (process-jobs))
+  #:export (process-jobs
 
-(define (process-jobs conn)
+            default-max-processes))
+
+(define* (process-jobs conn #:key max-processes)
   (define (fetch-new-jobs)
     (fetch-unlocked-jobs conn))
 
@@ -23,7 +25,8 @@
 
   (process-jobs-concurrently fetch-new-jobs
                              process-job
-                             handle-job-failure))
+                             handle-job-failure
+                             #:max-processes max-processes))
 
 (define default-max-processes
   (max (round (/ (current-processor-count)

scripts/guix-data-service-process-jobs.in

@@ -30,8 +30,36 @@
 (setvbuf (current-output-port) 'line)
 (setvbuf (current-error-port) 'line)
 
+(define %options
+  ;; Specifications of the command-line options
+  (list (option '("max-processes") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-processes
+                              (string->number arg)
+                              result)))))
+
+(define %default-options
+  ;; Alist of default option values
+  `((max-processes ,default-max-processes)))
+
+(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
    "process-jobs"
    (lambda (conn)
      (simple-format #t "Ready to process jobs...\n")
-   (process-jobs conn)))
+     (process-jobs conn
+                   #:max-processes (assq-ref opts 'max-processes)))))