diff options
| -rwxr-xr-x | bin/ravanan | 1 | ||||
| -rw-r--r-- | ravanan/command-line-tool.scm | 83 | ||||
| -rw-r--r-- | ravanan/workflow.scm | 10 |
3 files changed, 71 insertions, 23 deletions
diff --git a/bin/ravanan b/bin/ravanan index eed7167..f5a991b 100755 --- a/bin/ravanan +++ b/bin/ravanan @@ -142,6 +142,7 @@ files that have the token in the @verbatim{SLURM_JWT=token} format." (scm->json (run-workflow (file-name-stem workflow-file) (canonicalize-path (assq-ref args 'guix-manifest-file)) + #f (read-workflow workflow-file) (read-inputs inputs-file) (case (assq-ref args 'batch-system) diff --git a/ravanan/command-line-tool.scm b/ravanan/command-line-tool.scm index 065cd42..83dec50 100644 --- a/ravanan/command-line-tool.scm +++ b/ravanan/command-line-tool.scm @@ -29,6 +29,7 @@ #:use-module ((gnu packages guile-xyz) #:select (guile-filesystem)) #:use-module (guix derivations) #:use-module (guix gexp) + #:use-module (guix inferior) #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix profiles) @@ -371,17 +372,18 @@ path." (string-append (basename script) ".stderr")) store)) -(define* (run-command-line-tool name manifest-file cwl inputs +(define* (run-command-line-tool name manifest-file channels cwl inputs scratch store batch-system #:key guix-daemon-socket) "Run @code{CommandLineTool} class workflow @var{cwl} named @var{name} with @var{inputs} using tools from Guix manifest in @var{manifest-file}. -@var{scratch}, @var{store}, @var{batch-system} and @var{guix-daemon-socket} are -the same as in @code{run-workflow} from @code{(ravanan workflow)}." +@var{channels}, @var{scratch}, @var{store}, @var{batch-system} and +@var{guix-daemon-socket} are the same as in @code{run-workflow} from +@code{(ravanan workflow)}." ;; TODO: Write to the store atomically. (let* ((script - (build-command-line-tool-script name manifest-file cwl inputs + (build-command-line-tool-script name manifest-file channels cwl inputs scratch store batch-system guix-daemon-socket)) (requirements (inherit-requirements (or (assoc-ref cwl "requirements") @@ -559,6 +561,13 @@ maybe-monadic value." (guix gexp) (guix profiles)))) +(define (call-with-inferior inferior proc) + "Call @var{proc} with @var{inferior} and return the return value of @var{proc}. +Close @var{inferior} when done, even if @var{proc} exits non-locally." + (dynamic-wind (const #t) + (cut proc inferior) + (cut close-inferior inferior))) + (define (manifest-file->environment manifest-file channels guix-daemon-socket) "Build @var{manifest-file} and return an association list of environment variables to set to use the built profile. Connect to the Guix daemon specified @@ -575,27 +584,63 @@ in a Guix inferior with @var{channels}." (built-derivations (list drv)) (return (derivation->output-path drv)))))))) - (let ((manifest (load-manifest manifest-file))) - (map (match-lambda - ((specification . value) - (cons (search-path-specification-variable specification) - value))) - (evaluate-search-paths - (manifest-search-paths manifest) - (list (build-derivation - (profile-derivation manifest - #:allow-collisions? #t) - guix-daemon-socket)))))) - -(define (build-command-line-tool-script name manifest-file cwl inputs + (if channels + (call-with-inferior (inferior-for-channels channels) + (cut inferior-eval + `(begin + (use-modules (ice-9 match) + (guix search-paths) + (gnu packages) + (guile) + (guix gexp) + (guix profiles)) + + (define (build-derivation drv guix-daemon-socket) + (if guix-daemon-socket + (parameterize ((%daemon-socket-uri guix-daemon-socket)) + (build-derivation drv)) + (with-store store + (run-with-store store + (mlet %store-monad ((drv drv)) + (mbegin %store-monad + (built-derivations (list drv)) + (return (derivation->output-path drv)))))))) + + ;; Do not auto-compile manifest files. + (set! %load-should-auto-compile #f) + (let ((manifest (load ,(canonicalize-path manifest-file)))) + (map (match-lambda + ((specification . value) + (cons (search-path-specification-variable specification) + value))) + (evaluate-search-paths + (manifest-search-paths manifest) + (list (build-derivation + (profile-derivation manifest + #:allow-collisions? #t) + ,guix-daemon-socket)))))) + <>)) + (let ((manifest (load-manifest manifest-file))) + (map (match-lambda + ((specification . value) + (cons (search-path-specification-variable specification) + value))) + (evaluate-search-paths + (manifest-search-paths manifest) + (list (build-derivation + (profile-derivation manifest + #:allow-collisions? #t) + guix-daemon-socket))))))) + +(define (build-command-line-tool-script name manifest-file channels cwl inputs scratch store batch-system guix-daemon-socket) "Build and return script to run @code{CommandLineTool} class workflow @var{cwl} named @var{name} with @var{inputs} using tools from Guix manifest in @var{manifest-file} and on @var{batch-system}. -@var{scratch}, @var{store} and @var{guix-daemon-socket} are the same as in -@code{run-workflow} from @code{(ravanan workflow)}." +@var{channels}, @var{scratch}, @var{store} and @var{guix-daemon-socket} are the +same as in @code{run-workflow} from @code{(ravanan workflow)}." (define (environment-variables env-var-requirement) (just (vector-map->list (lambda (environment-definition) #~(list #$(assoc-ref* environment-definition diff --git a/ravanan/workflow.scm b/ravanan/workflow.scm index d263b4b..09d733c 100644 --- a/ravanan/workflow.scm +++ b/ravanan/workflow.scm @@ -246,7 +246,7 @@ propagator." merge-values scheduler)) -(define* (workflow-scheduler manifest-file scratch store batch-system +(define* (workflow-scheduler manifest-file channels scratch store batch-system #:key guix-daemon-socket) (define (schedule proc inputs scheduler) "Schedule @var{proc} with inputs from the @var{inputs} association list. Return a @@ -291,6 +291,7 @@ job state object. @var{proc} may either be a @code{<propnet>} object or a (command-line-tool-state (run-command-line-tool name manifest-file + channels cwl inputs scratch @@ -594,11 +595,12 @@ error out." formal-inputs)) formal-inputs)) -(define* (run-workflow name manifest-file cwl inputs +(define* (run-workflow name manifest-file channels cwl inputs scratch store batch-system #:key guix-daemon-socket) "Run a workflow @var{cwl} named @var{name} with @var{inputs} using -tools from Guix manifest in @var{manifest-file}. +tools from Guix manifest in @var{manifest-file}. If @var{channels} is not +@code{#f}, build the manifest in a Guix inferior with @var{channels}. @var{scratch} is the path to the scratch area on all worker nodes. The scratch area need not be shared. @var{store} is the path to the shared ravanan store. @@ -606,7 +608,7 @@ area need not be shared. @var{store} is the path to the shared ravanan store. @var{guix-daemon-socket} is the Guix daemon socket to connect to." (let ((scheduler (workflow-scheduler - manifest-file scratch store batch-system + manifest-file channels scratch store batch-system #:guix-daemon-socket guix-daemon-socket))) (let loop ((state ((scheduler-schedule scheduler) (scheduler-proc name cwl %nothing %nothing) |