From 581c63f6caeb69bada7750a45c31baf915795722 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Fri, 3 Mar 2017 12:46:54 +0000
Subject: [PATCH] Added --debug-action

---
 bin/main.ml         | 12 ++++++++++++
 src/ansi_color.ml   | 13 +++++++------
 src/build_system.ml |  3 +++
 src/clflags.ml      |  1 +
 src/clflags.mli     |  3 +++
 5 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index 9c368462..6844410b 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -11,6 +11,7 @@ let (>>=) = Future.(>>=)
 type common =
   { concurrency    : int
   ; debug_rules    : bool
+  ; debug_actions  : bool
   ; debug_dep_path : bool
   ; debug_findlib  : bool
   ; dev_mode       : bool
@@ -25,6 +26,7 @@ let prefix_target common s = common.target_prefix ^ s
 let set_common c =
   Clflags.concurrency := c.concurrency;
   Clflags.debug_rules := c.debug_rules;
+  Clflags.debug_actions := c.debug_actions;
   Clflags.debug_dep_path := c.debug_dep_path;
   Clflags.debug_findlib := c.debug_findlib;
   Clflags.dev_mode := c.dev_mode;
@@ -111,6 +113,7 @@ let common =
         concurrency
         only_packages
         debug_rules
+        debug_actions
         debug_dep_path
         debug_findlib
         dev_mode
@@ -124,6 +127,7 @@ let common =
     in
     { concurrency
     ; debug_rules
+    ; debug_actions
     ; debug_dep_path
     ; debug_findlib
     ; dev_mode
@@ -160,6 +164,13 @@ let common =
              ~doc:"Print all internal rules."
         )
   in
+  let dactions =
+    Arg.(value
+         & flag
+         & info ["debug-actions"] ~docs
+             ~doc:"Print out internal actions."
+        )
+  in
   let ddep_path =
     Arg.(value
          & flag
@@ -199,6 +210,7 @@ let common =
         $ concurrency
         $ only_packages
         $ drules
+        $ dactions
         $ ddep_path
         $ dfindlib
         $ dev
diff --git a/src/ansi_color.ml b/src/ansi_color.ml
index 93f7696b..cd89500e 100644
--- a/src/ansi_color.ml
+++ b/src/ansi_color.ml
@@ -168,13 +168,14 @@ let setup_env_for_ocaml_colors = lazy(
 )
 
 let styles_of_tag = function
-  | "loc" -> [Bold]
-  | "error" -> [Bold; Foreground Red]
+  | "loc"     -> [Bold]
+  | "error"   -> [Bold; Foreground Red]
   | "warning" -> [Bold; Foreground Magenta]
-  | "kwd" -> [Bold; Foreground Blue]
-  | "id" -> [Bold; Foreground Yellow]
-  | "prompt" -> [Bold; Foreground Green]
-  | _ -> []
+  | "kwd"     -> [Bold; Foreground Blue]
+  | "id"      -> [Bold; Foreground Yellow]
+  | "prompt"  -> [Bold; Foreground Green]
+  | "debug"   -> [Underlined; Foreground Bright_cyan]
+  | _         -> []
 
 let setup_err_formatter_colors () =
   let open Format in
diff --git a/src/build_system.ml b/src/build_system.ml
index e3277491..b7a901c9 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -254,6 +254,9 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
     >>= fun () ->
     Build_exec.exec t build () ~targeting
     >>= fun action ->
+    if !Clflags.debug_actions then
+      Format.eprintf "@{<debug>Action@}: %s@."
+        (Sexp.to_string (Action.sexp_of_t action));
     Action.exec action
   ) in
   let rule =
diff --git a/src/clflags.ml b/src/clflags.ml
index 7dbb4d11..03f91a9f 100644
--- a/src/clflags.ml
+++ b/src/clflags.ml
@@ -2,6 +2,7 @@ let concurrency = ref 4
 (*let ocaml_comp_flags = ref ["-g"]*)
 let g = ref true
 let debug_rules = ref false
+let debug_actions = ref false
 let debug_run = ref true
 let debug_findlib = ref false
 let warnings = ref "-40"
diff --git a/src/clflags.mli b/src/clflags.mli
index ad610368..d7f8b698 100644
--- a/src/clflags.mli
+++ b/src/clflags.mli
@@ -12,6 +12,9 @@ val g : bool ref
 (** Print rules *)
 val debug_rules : bool ref
 
+(** Print actions *)
+val debug_actions : bool ref
+
 (** Print executed commands *)
 val debug_run : bool ref