path lists in shell workflows

pveber · Feb 8, 2019 · 7d14bd9 · 7d14bd9
1 parent 3008205
commit 7d14bd9
Show file tree

Hide file tree

Showing 7 changed files with 39 additions and 2 deletions.
diff --git a/lib/bistro.ml b/lib/bistro.ml
@@ -115,6 +115,7 @@ module Template_dsl = struct
   let int i = string (Int.to_string i)
   let float f = string (Float.to_string f)
   let dep w = [ Template.D (Workflow.Path_token w) ]
+  let deps ?quote ~sep w = [ Template.D (Workflow.Path_list_token { elts = w ; quote ; sep }) ]
   let string_dep w = [ Template.D (Workflow.String_token w) ]
   let int_dep w = [ Template.D Workflow.(String_token (app (pure ~id:"__string_of_int__" Int.to_string) w)) ]
 

diff --git a/lib/bistro.mli b/lib/bistro.mli
@@ -72,6 +72,12 @@ module Template_dsl : sig
   (** [dep w] is interpreted as the path where to find the result of
       workflow [w] *)
 
+  val deps :
+    ?quote:char ->
+    sep:string ->
+    _ path list workflow ->
+    template
+
   val string_dep : string workflow -> template
   (** [string_dep w] is interpreted as the result of workflow [w] *)
 

diff --git a/lib/engine/execution_env.ml b/lib/engine/execution_env.ml
@@ -3,6 +3,11 @@ open Bistro_internals
 
 type insert =
   | Path of Workflow.path
+  | Path_list of {
+      elts : Workflow.path list ;
+      sep : string ;
+      quote : char option ;
+    }
   | String of string
 
 type t = {

diff --git a/lib/engine/execution_env.mli b/lib/engine/execution_env.mli
@@ -2,6 +2,11 @@ open Bistro_internals
 
 type insert =
   | Path of Workflow.path
+  | Path_list of {
+      elts : Workflow.path list ;
+      sep : string ;
+      quote : char option ;
+    }
   | String of string
 
 type t = {

diff --git a/lib/engine/scheduler.ml b/lib/engine/scheduler.ml
@@ -670,6 +670,8 @@ and shallow_eval_token sched =
   let open Template in
   function
   | D (Workflow.Path_token w) -> shallow_eval sched w >|= fun p -> D (Execution_env.Path p)
+  | D (Workflow.Path_list_token { elts ; quote ; sep }) ->
+    shallow_eval sched elts >|= fun elts -> D (Execution_env.Path_list { elts ; quote ; sep })
   | D (Workflow.String_token w) -> shallow_eval sched w >|= fun p -> D (Execution_env.String p)
   | F f -> shallow_eval_template sched f >|= fun t -> F t
   | DEST | TMP | NP | MEM | S _ as tok -> Lwt.return tok

diff --git a/lib/engine/shell_command.ml b/lib/engine/shell_command.ml
@@ -59,6 +59,13 @@ let string_of_token (env : Execution_env.t) =
   function
   | S s -> s
   | D (Execution_env.Path p) -> env.dep p
+  | D (Execution_env.Path_list { elts ; quote ; sep }) ->
+    let quote =
+      Option.value_map quote ~default:Fn.id ~f:(fun c p -> sprintf "%c%s%c" c p c)
+    in
+    List.map elts ~f:env.dep
+    |> List.map ~f:quote
+    |> String.concat ~sep
   | D (String s) -> s
   | F toks -> env.file_dump toks
   | DEST -> env.dest
@@ -112,9 +119,11 @@ let dest_mount env dck_env =
 let command_path_deps cmd =
   Command.deps cmd
   |> List.filter_map ~f:(function
-      | Execution_env.Path p -> Some p
+      | Execution_env.Path p -> Some [ p ]
+      | Path_list l -> Some l.elts
       | String _ -> None
     )
+  |> List.concat
 
 let rec string_of_command env =
   let open Command in

diff --git a/lib/internals/workflow.ml b/lib/internals/workflow.ml
@@ -66,7 +66,14 @@ and 'a plugin =
 
 and shell_command = token Command.t
 
-and token = Path_token of path t | String_token of string t
+and token =
+  | Path_token of path t
+  | Path_list_token of {
+      elts : path list t ;
+      sep : string ;
+      quote : char option ;
+    }
+  | String_token of string t
 
 and any = Any : _ t -> any
 
@@ -163,6 +170,7 @@ let eval_path w = Eval_path { id = digest (`Eval_path, id w) ; workflow = w }
 
 let digestible_cmd = Command.map ~f:(function
     | Path_token w -> id w
+    | Path_list_token { elts ; sep ; quote } -> digest (id elts, sep, quote)
     | String_token w -> id w
   )
 
@@ -178,6 +186,7 @@ let shell
       Command.deps cmd
       |> List.map (function
           | Path_token w -> any w
+          | Path_list_token { elts ; _ } -> any elts
           | String_token s -> any s
         )
     )