diff options
Diffstat (limited to 'scripts/guix-build-coordinator.in')
| -rw-r--r-- | scripts/guix-build-coordinator.in | 101 |
1 files changed, 40 insertions, 61 deletions
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index e6ebc01..3992c6f 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -280,67 +280,46 @@ (remove-tags . ()))) (define %service-options - (list (option '("pid-file") #t #f - (lambda (opt name arg result) - (alist-cons 'pid-file - arg - result))) - (option '("agent-communication") #t #f - (lambda (opt name arg result) - (alist-cons 'agent-communication - (string->uri arg) - (alist-delete 'agent-communication result)))) - (option '("client-communication") #t #f - (lambda (opt name arg result) - (alist-cons 'client-communication - (string->uri arg) - (alist-delete 'client-communication result)))) - (option '("allocation-strategy") #t #f - (lambda (opt name arg result) - (alist-cons - 'allocation-strategy - (or (assoc-ref - `(("basic" . ,basic-build-allocation-strategy) - ("derivation-ordered" - . ,derivation-ordered-build-allocation-strategy)) - arg) - (begin - (simple-format - (current-error-port) - "error: ~A is not a known allocation strategy\n" - arg) - (exit 1))) - result))) - (option '("build-submitted-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-submitted-hook - (read/eval arg) - (alist-delete 'build-submitted-hook result)))) - (option '("build-canceled-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-canceled-hook - (read/eval arg) - (alist-delete 'build-canceled-hook result)))) - (option '("build-started-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-started-hook - (read/eval arg) - (alist-delete 'build-started-hook result)))) - (option '("build-success-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-success-hook - (read/eval arg) - (alist-delete 'build-success-hook result)))) - (option '("build-failure-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-failure-hook - (read/eval arg) - (alist-delete 'build-failure-hook result)))) - (option '("build-missing-inputs-hook") #t #f - (lambda (opt name arg result) - (alist-cons 'build-missing-inputs-hook - (read/eval arg) - (alist-delete 'build-missing-inputs-hook result)))))) + (append + (list (option '("pid-file") #t #f + (lambda (opt name arg result) + (alist-cons 'pid-file + arg + result))) + (option '("agent-communication") #t #f + (lambda (opt name arg result) + (alist-cons 'agent-communication + (string->uri arg) + (alist-delete 'agent-communication result)))) + (option '("client-communication") #t #f + (lambda (opt name arg result) + (alist-cons 'client-communication + (string->uri arg) + (alist-delete 'client-communication result)))) + (option '("allocation-strategy") #t #f + (lambda (opt name arg result) + (alist-cons + 'allocation-strategy + (or (assoc-ref + `(("basic" . ,basic-build-allocation-strategy) + ("derivation-ordered" + . ,derivation-ordered-build-allocation-strategy)) + arg) + (begin + (simple-format + (current-error-port) + "error: ~A is not a known allocation strategy\n" + arg) + (exit 1))) + result)))) + (map (lambda (hook) + (option (list (simple-format #f "~A-hook" hook)) #t #f + (lambda (opt name arg result) + (alist-cons (symbol-append hook '-hook) + (read/eval arg) + (alist-delete (symbol-append hook '-hook) + result))))) + %known-hooks))) (define %service-option-defaults ;; Alist of default option values |