little refactoring + add loggers

lib/file_formats.ml

@@ -42,3 +42,15 @@ type ready_dataset = {
   fna: nucleotide_fasta workflow ;
   faa: aminoacid_fasta workflow ;
   }
+
+
+type ('a,'b) w_dataset =
+  | Raw_dataset of 'a
+  | Ready_dataset of 'b
+
+
+type dataset = {
+  model_prefix: string ;
+  tree_prefix : string ;
+  dataset : (raw_dataset,ready_dataset) w_dataset
+  }

lib/pipeline.ml

@@ -31,7 +31,22 @@ let repo_of_raw_dataset (raw_dataset:raw_dataset) =
   ]
   |> Repo.shift "raw_dataset"
 
-let derive_from_model ~model ~tree ~tree_dataset ~preview =
+
+let repo_of_dataset_l dataset_l =
+  List.map dataset_l ~f:(fun dataset ->
+    let model_prefix = dataset.model_prefix in
+    let tree_prefix = dataset.tree_prefix in
+    let w_dataset = dataset.dataset in
+    let repo_d = match w_dataset with
+      | Ready_dataset d -> repo_of_ready_dataset d
+      | Raw_dataset d ->  repo_of_raw_dataset d
+    in
+      Repo.shift tree_prefix (Repo.shift model_prefix repo_d)
+      (*repo_d*)
+    )
+    |> List.concat
+
+let derive_from_model ~model ~tree ~tree_dataset ~tree_prefix ~preview =
   let nb_sites = if preview then 10 else 100 in
   let nodes = Tree_dataset.nodes tree_dataset model in
   let config = Convergence_hypothesis.bpp_config nodes model in
@@ -40,32 +55,37 @@ let derive_from_model ~model ~tree ~tree_dataset ~preview =
   let faa = Bppsuite.fna2faa ~fna in
   let raw_dataset = { input_tree = tree ; fna} in
   let ready_dataset = { input_tree = tree ; tree_dataset ; fna; faa} in
+  let model_prefix = Convergence_hypothesis.string_of_model model in
   if preview then
-    repo_of_ready_dataset ready_dataset
+    { model_prefix; tree_prefix; dataset = Ready_dataset ready_dataset }
   else
-    repo_of_raw_dataset raw_dataset
+    { model_prefix; tree_prefix; dataset = Raw_dataset raw_dataset }
 
 
 let derive_from_tree ~tree_dir ~tree ~preview =
+  let tree_prefix = Filename.chop_extension tree in
   let tree = input (Filename.concat tree_dir tree) in
   let tree_dataset = Tree_dataset.prepare tree in
   let models = Convergence_hypothesis.[H0; Ha] in
   List.map models ~f:(fun model ->
-      derive_from_model ~model ~tree ~tree_dataset ~preview
-      |> Repo.shift (Convergence_hypothesis.string_of_model model)
+      derive_from_model ~model ~tree ~tree_dataset ~tree_prefix ~preview
     )
-  |> List.concat
 
 let derive ~tree_dir ~trees ~preview =
   List.map trees ~f:(fun tree ->
-      let id = Filename.chop_extension tree in
-      Repo.shift id (derive_from_tree ~tree_dir ~tree ~preview))
+      derive_from_tree ~tree_dir ~tree ~preview)
   |> List.concat
 
 let main ~outdir ?(np = 2) ?(mem = 2) ~tree_dir ~preview () =
+ let logger =
+    Logger.tee [
+      Console_logger.create () ;
+      Dot_output.create "dag.dot" (*dot -Tpdf example/dag.dot -o dag.pdf*)
+    ] in
   let trees = Array.to_list @@ Sys.readdir tree_dir in
-  let repo = derive ~tree_dir ~trees ~preview in
-  Repo.build ~outdir ~np ~mem:(`GB mem) repo
+  let dataset_l = derive ~tree_dir ~trees ~preview in
+  let repo = repo_of_dataset_l dataset_l in
+  Repo.build ~outdir ~np ~mem:(`GB mem) ~logger repo
 
 let command =
   let open Command.Let_syntax in