ppx: renamed let%map style extension into deps and pdeps

lib/bioinfo/bistro_bioinfo.ml

@@ -2286,68 +2286,77 @@ module Kallisto = struct
   let abundance x =
     Workflow.select x [ "abundance.tsv" ]
 
-  let%pworkflow merge_eff_counts ~sample_ids ~kallisto_outputs =
-
-    let parse_eff_counts fn =
-      In_channel.read_lines fn
-      |> Fn.flip List.drop 1
-      |> List.map ~f:(fun l ->
-          String.split ~on:'\t' l
-          |> Fn.flip List.nth_exn 3
-        )
-    in
-    let parse_names fn =
-      In_channel.read_lines fn
-      |> Fn.flip List.drop 1
-      |> List.map ~f:(fun l ->
-          String.split ~on:'\t' l
-          |> List.hd_exn
-        )
-    in
+  let merge_eff_counts ~sample_ids ~kallisto_outputs =
+    Workflow.path_plugin ~descr:"kallisto.merge_eff_counts" (
+
+      let%pdeps kallisto_outputs = path_list kallisto_outputs
+      and             sample_ids = data sample_ids in
+
+      let parse_eff_counts fn =
+        In_channel.read_lines fn
+        |> Fn.flip List.drop 1
+        |> List.map ~f:(fun l ->
+            String.split ~on:'\t' l
+            |> Fn.flip List.nth_exn 3
+          )
+      in
+      let parse_names fn =
+        In_channel.read_lines fn
+        |> Fn.flip List.drop 1
+        |> List.map ~f:(fun l ->
+            String.split ~on:'\t' l
+            |> List.hd_exn
+          )
+      in
 
-    let names = parse_names [%path List.hd_exn kallisto_outputs] in
-    let counts  = List.map [%eval Workflow.(path_list kallisto_outputs)] ~f:parse_eff_counts in
+      let names = parse_names (List.hd_exn kallisto_outputs) in
+      let counts  = List.map kallisto_outputs ~f:parse_eff_counts in
 
-    let table = List.transpose_exn (names :: counts) in
+      let table = List.transpose_exn (names :: counts) in
 
-    let lines =
-      ("transcript" :: [%param sample_ids]) :: table
-      |> List.map ~f:(String.concat ~sep:"\t")
-    in
+      let lines =
+        ("transcript" :: sample_ids) :: table
+        |> List.map ~f:(String.concat ~sep:"\t")
+      in
 
-    Out_channel.write_lines [%dest] lines
+      Out_channel.write_lines [%dest] lines
+    )
 
+  let merge_tpms ~sample_ids ~kallisto_outputs =
+    Workflow.path_plugin ~descr:"kallisto.merge_tpms" (
 
-  let%pworkflow merge_tpms ~sample_ids ~kallisto_outputs =
+      let%pdeps kallisto_outputs = path_list kallisto_outputs
+      and             sample_ids = data sample_ids in
 
-    let parse_tpms fn =
-      In_channel.read_lines fn
-      |> Fn.flip List.drop 1
-      |> List.map ~f:(fun l ->
-          String.split ~on:'\t' l
-          |> Fn.flip List.nth_exn 4
-        )
-    in
-    let parse_names fn =
-      In_channel.read_lines fn
-      |> Fn.flip List.drop 1
-      |> List.map ~f:(fun l ->
-          String.split ~on:'\t' l
-          |> List.hd_exn
-        )
-    in
+      let parse_tpms fn =
+        In_channel.read_lines fn
+        |> Fn.flip List.drop 1
+        |> List.map ~f:(fun l ->
+            String.split ~on:'\t' l
+            |> Fn.flip List.nth_exn 4
+          )
+      in
+      let parse_names fn =
+        In_channel.read_lines fn
+        |> Fn.flip List.drop 1
+        |> List.map ~f:(fun l ->
+            String.split ~on:'\t' l
+            |> List.hd_exn
+          )
+      in
 
-    let names = parse_names [%eval Workflow.path (List.hd_exn kallisto_outputs)] in
-    let tpms  = List.map [%eval Workflow.(path_list kallisto_outputs)] ~f:parse_tpms in
+      let names = parse_names (List.hd_exn kallisto_outputs) in
+      let tpms  = List.map kallisto_outputs ~f:parse_tpms in
 
-    let table = List.transpose_exn (names :: tpms) in
+      let table = List.transpose_exn (names :: tpms) in
 
-    let lines =
-      ("transcript" :: [%param sample_ids]) :: table
-      |> List.map ~f:(String.concat ~sep:"\t")
-    in
+      let lines =
+        ("transcript" :: sample_ids) :: table
+        |> List.map ~f:(String.concat ~sep:"\t")
+      in
 
-    Out_channel.write_lines [%dest] lines
+      Out_channel.write_lines [%dest] lines
+    )
 end
 
 module Spades = struct

lib/utils/html_report.ml

@@ -49,12 +49,12 @@ let picture  ?(alt = "") format path =
     ~alt ()
 
 let render_cell = function
-  | Text str -> [%workflow_expr H.p [ H.txt [%param str] ]]
-  | Pdf w -> [%workflow_expr picture `svg [%path svg_of_pdf w] ]
-  | Svg w -> [%workflow_expr picture `svg [%path w] ]
-  | Png w -> [%workflow_expr picture `png [%path w] ]
-  | Section s -> [%workflow_expr H.h2 [ H.txt [%param s] ]]
-  | Subsection s -> [%workflow_expr H.h3 [ H.txt [%param s] ]]
+  | Text str -> [%workflow H.p [ H.txt [%param str] ]]
+  | Pdf w -> [%workflow picture `svg [%path svg_of_pdf w] ]
+  | Svg w -> [%workflow picture `svg [%path w] ]
+  | Png w -> [%workflow picture `png [%path w] ]
+  | Section s -> [%workflow H.h2 [ H.txt [%param s] ]]
+  | Subsection s -> [%workflow H.h3 [ H.txt [%param s] ]]
 
 let%pworkflow render nb =
   let cells = [%eval Workflow.list @@ List.map nb.cells ~f:render_cell] in

lib/utils/repo.ml

@@ -96,9 +96,9 @@ let generate outdir items =
 
 let item_to_workflow = function
   | Item (path, w) ->
-    [%workflow_expr [ normalized_repo_item ~repo_path:path ~id:(W.id (Private.reveal w)) ~cache_path:[%path w] ]]
+    [%workflow [ normalized_repo_item ~repo_path:path ~id:(W.id (Private.reveal w)) ~cache_path:[%path w] ]]
   | Item_list l ->
-    [%workflow_expr
+    [%workflow
       let id = W.id (Private.reveal l.elts) in
       let elts = [%eval Workflow.spawn l.elts ~f:Workflow.path] in
       let n = List.length elts in
@@ -124,7 +124,7 @@ let to_workflow ~outdir items =
     List.map items ~f:item_to_workflow
     |> Workflow.list
   in
-  [%workflow_expr
+  [%workflow
     [%eval normalized_items]
     |> List.concat
     |> remove_redundancies

ppx/ppx_bistro.ml

@@ -46,7 +46,7 @@ let insert_type_of_ext = function
   | "param" -> Param
   | ext -> failwith ("Unknown insert " ^ ext)
 
-class payload_rewriter = object
+class payload_env_rewriter = object
   inherit [(string * expression * insert_type) list] Ast_traverse.fold_map as super
   method! expression expr acc =
     match expr with
@@ -65,6 +65,13 @@ class payload_rewriter = object
         | _ -> failwith "expected empty payload"
 
       )
+    | _ -> super#expression expr acc
+end
+
+class payload_rewriter = object
+  inherit payload_env_rewriter as super
+  method! expression expr acc =
+    match expr with
     | { pexp_desc = Pexp_extension ({txt = ("eval" | "path" | "param" as ext) ; loc ; _}, payload) ; _ } -> (
         match payload with
         | PStr [ { pstr_desc = Pstr_eval (e, _) ; _ } ] ->
@@ -149,9 +156,14 @@ let str_item_rewriter ~loc ~path:_ descr version var expr =
   in
   [%stri let [%p B.pvar var] = [%e replace_body workflow_body_with_type expr]]
 
-let gen_letin_rewriter ~loc (vbs : value_binding list) (body : expression) =
+let gen_letin_rewriter ~loc ~env_rewrite (vbs : value_binding list) (body : expression) =
   let id = digest body in
-  let f = List.fold_right vbs ~init:body ~f:(fun vb acc ->
+  let rewritten_body, _ =
+    if env_rewrite
+    then new payload_env_rewriter#expression body []
+    else body, []
+  in
+  let f = List.fold_right vbs ~init:rewritten_body ~f:(fun vb acc ->
       B.pexp_fun Nolabel None vb.pvb_pat acc
     )
   in
@@ -162,8 +174,8 @@ let gen_letin_rewriter ~loc (vbs : value_binding list) (body : expression) =
       [%expr Bistro.Workflow.app [%e acc] [%e e]]
     )
 
-let letin_rewriter ~loc ~path:_ vbs body = gen_letin_rewriter ~loc vbs [%expr fun () -> [%e body]]
-let pletin_rewriter ~loc ~path:_ vbs body = gen_letin_rewriter ~loc vbs [%expr fun __dest__ -> [%e body]]
+let letin_rewriter ~loc ~path:_ vbs body = gen_letin_rewriter ~loc vbs ~env_rewrite:false [%expr fun () -> [%e body]]
+let pletin_rewriter ~loc ~path:_ vbs body = gen_letin_rewriter ~loc ~env_rewrite:true vbs [%expr fun __dest__ -> [%e body]]
 
 let pstr_item_rewriter ~loc ~path:_ descr version var expr =
   let descr = match descr with
@@ -235,15 +247,15 @@ let script_ext =
 
 let expression_ext =
   let open Extension in
-  declare "workflow_expr" Context.expression Ast_pattern.(single_expr_payload __) expression_rewriter
+  declare "workflow" Context.expression Ast_pattern.(single_expr_payload __) expression_rewriter
 
 let letin_ext =
   let open Extension in
-  declare "workflow" Context.expression Ast_pattern.(single_expr_payload (pexp_let nonrecursive __ __)) letin_rewriter
+  declare "deps" Context.expression Ast_pattern.(single_expr_payload (pexp_let nonrecursive __ __)) letin_rewriter
 
 let pletin_ext =
   let open Extension in
-  declare "pworkflow" Context.expression Ast_pattern.(single_expr_payload (pexp_let nonrecursive __ __)) pletin_rewriter
+  declare "pdeps" Context.expression Ast_pattern.(single_expr_payload (pexp_let nonrecursive __ __)) pletin_rewriter
 
 let _np_attr =
   Attribute.declare "bistro.np"

test/test.ml

@@ -1,21 +1,21 @@
 open Core
 open Bistro
 
-let echo3 ~sep x = Workflow.path_plugin (
-    let%pworkflow x = x
-    and         sep = data sep in
+let echo3 ~sep x = Workflow.path_plugin ~descr:"echo3" (
+    let%pdeps x = x
+    and     sep = data sep in
     Out_channel.write_lines __dest__ [ x ; sep ; x ; sep ; x ]
   )
 
-let wc x = Workflow.plugin (
-    let%workflow x = path x in
+let wc x = Workflow.plugin ~descr:"wc" (
+    let%deps x = path x in
     In_channel.read_lines x
     |> List.length
   )
 
 let request x =
-  Workflow.plugin (
-    let%workflow x = data x in
+  Workflow.plugin ~descr:"request" (
+    let%deps x = data x in
     String.split ~on:' ' x
   )
 

test/test1.ml

@@ -1,7 +1,7 @@
 open Core
 open Bistro
 
-let add x y = Workflow.plugin (fun%workflow_expr () ->
+let add x y = Workflow.plugin ~descr:"add" (fun%workflow () ->
     [%eval x] + [%eval y]
   )
 

test/test2.ml

@@ -3,7 +3,7 @@ open Bistro
 open Bistro_nlp
 open Bistro_utils
 
-let cut_deps x = [%workflow_expr
+let cut_deps x = [%workflow
   let lines = In_channel.read_lines [%path x] in
   List.group lines ~break:(fun _ l -> String.equal l "")
   |> List.filter ~f:(Poly.( <> ) [""])

test/test_ppx.ml

@@ -2,7 +2,7 @@ open Bistro
 
 let f x y =
   Workflow.plugin ~descr:"add" (
-    let%workflow x = x
-    and          y = y in
+    let%deps x = x
+    and      y = y in
     x + y
   )