From 2b52da041ec27c84435f84f1154746b1456107a0 Mon Sep 17 00:00:00 2001
From: Etienne Marais <dev@maiste.fr>
Date: Thu, 20 Jun 2024 17:43:08 +0200
Subject: [PATCH] stdune: add header option to user_message

Signed-off-by: Etienne Marais <dev@maiste.fr>
---
 src/dune_rules/pkg_rules.ml | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml
index b981cff28497..dd1dbf133f6d 100644
--- a/src/dune_rules/pkg_rules.ml
+++ b/src/dune_rules/pkg_rules.ml
@@ -678,29 +678,48 @@ module Run_with_path = struct
                 [ Pp.text "Run_with_path: impossible to read data from a closed state" ]))
     ;;
 
-    let error_msg ~loc pkg_name error =
+    let error_msg ~loc report_type pkg_name error =
       let open Pp.O in
+      let report_msg, report_style =
+        match report_type with
+        | `Warning -> Pp.text "Warning", User_message.Style.Warning
+        | `Error -> Pp.text "Error", User_message.Style.Error
+      in
       let pp_package =
         match pkg_name with
         | None -> Pp.nop
         | Some pkg_name ->
           let pkg_name = Dune_pkg.Package_name.to_string pkg_name in
-          Pp.(char '[' ++ tag User_message.Style.Error (verbatim pkg_name) ++ char ']')
+          Pp.(
+            tag report_style (text "<><><>")
+            ++ space
+            ++ verbatim pkg_name
+            ++ space
+            ++ tag report_style (text "<><><><>"))
+      in
+      let pp_disclaimer =
+        Pp.(
+          concat
+            [ tag report_style report_msg
+              ++ char ','
+              ++ space
+              ++ text "the evaluation of the rule logs:"
+            ])
       in
-      User_message.make ~loc ~prefix:pp_package [ Pp.verbatim error ]
+      User_message.make ~headers:[ pp_package ] ~loc [ pp_disclaimer; Pp.verbatim error ]
     ;;
 
     let consume_and_print_error t display ~code ~loc =
       match Predicate.test t.accepted_exit_codes code, display with
       | false, _ ->
-        let msg = read t |> error_msg ~loc t.pkg_name in
+        let msg = read t |> error_msg ~loc `Error t.pkg_name in
         close t;
         raise (User_error.E msg)
       | true, Display.Verbose ->
         let error = read t in
         if has_output error
         then (
-          let msg = error_msg ~loc t.pkg_name error in
+          let msg = error_msg ~loc `Warning t.pkg_name error in
           close t;
           Console.print_user_message msg)
       | true, _ -> ()