From c911f8ed50e6ecb8d91e093898099f397e5fbe65 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= <antonin@tarides.com>
Date: Mon, 14 Nov 2022 11:29:04 +0100
Subject: [PATCH] mdx: add colors to console logs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

If Dune should ouput ANSI colors to stderr, so can mdx.

Signed-off-by: Antonin Décimo <antonin@tarides.com>
---
 CHANGES.md            |  3 +++
 src/dune_rules/mdx.ml | 20 ++++++++++++++------
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 8ca9ff730f52..cbbe2d20fa3e 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Use colored output with MDX when Dune colors are enabled.
+  (#6462, @MisterDA)
+
 - Make `dune describe workspace` return consistent dependencies for
   executables and for libraries. By default, compile-time dependencies
   towards PPX-rewriters are from now not taken into account (but
diff --git a/src/dune_rules/mdx.ml b/src/dune_rules/mdx.ml
index b7d4d0af11d6..3111aca5a4aa 100644
--- a/src/dune_rules/mdx.ml
+++ b/src/dune_rules/mdx.ml
@@ -2,6 +2,12 @@ open Import
 
 let mdx_version_required = "1.6.0"
 
+let color_always =
+  lazy
+    (if Lazy.force Ansi_color.stderr_supports_color then
+     [ Command.Args.A "--color=always" ]
+    else [])
+
 module Files = struct
   type t =
     { src : Path.Build.t
@@ -64,8 +70,10 @@ module Deps = struct
         ]
 
   let rule ~dir ~mdx_prog files =
+    let open Command.Args in
     Command.run ~dir:(Path.build dir) mdx_prog
-      [ A "deps"; Dep (Path.build files.Files.src) ]
+      ([ A "deps" ] @ Lazy.force color_always
+      @ [ Dep (Path.build files.Files.src) ])
       ~stdout_to:files.Files.deps
 
   let path_escapes_dir str =
@@ -315,7 +323,7 @@ let gen_rules_for_single_file stanza ~sctx ~dir ~expander ~mdx_prog
             List.concat_map stanza.preludes ~f:(Prelude.to_args ~dir)
           in
           ( mdx_prog
-          , [ A "test" ] @ prelude_args
+          , [ A "test" ] @ prelude_args @ Lazy.force color_always
             @ [ A "-o"; Target files.corrected; Dep (Path.build files.src) ] )
       in
       let deps, sandbox =
@@ -365,13 +373,13 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~expander ~mdx_prog =
     in
     S args
   in
-  let prelude_args =
-    Command.Args.S (List.concat_map t.preludes ~f:(Prelude.to_args ~dir))
-  in
+  let open Command.Args in
+  let prelude_args = S (List.concat_map t.preludes ~f:(Prelude.to_args ~dir)) in
   (* We call mdx to generate the testing executable source *)
   let action =
     Command.run ~dir:(Path.build dir) mdx_prog ~stdout_to:file
-      [ A "dune-gen"; prelude_args; Resolve.Memo.args directory_args ]
+      ([ A "dune-gen"; prelude_args; Resolve.Memo.args directory_args ]
+      @ Lazy.force color_always)
   in
   let open Memo.O in
   let* () = Super_context.add_rule sctx ~loc ~dir action in