From aefa4e8f20088854f5a9263926ac5a2dfddbddca Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Wed, 18 Dec 2024 13:35:26 -1000
Subject: [PATCH] imp:cli: show first line of error messages in red

error' and usageError now redden and bolden the first line of error
messages, when ANSI codes are supported and permitted.
And warn goldens and boldens the first line of warning messages.
---
 hledger-lib/Hledger/Utils/IO.hs | 38 +++++++++++++++++++++++++--------
 1 file changed, 29 insertions(+), 9 deletions(-)

diff --git a/hledger-lib/Hledger/Utils/IO.hs b/hledger-lib/Hledger/Utils/IO.hs
index a4d43634a..da163e0cb 100644
--- a/hledger-lib/Hledger/Utils/IO.hs
+++ b/hledger-lib/Hledger/Utils/IO.hs
@@ -83,6 +83,7 @@ module Hledger.Utils.IO (
   brightCyan',
   brightWhite',
   rgb',
+  sgrresetall,
 
   -- ** Generic
 
@@ -186,22 +187,39 @@ pprint' = pPrintOpt NoCheckColorTty prettyoptsNoColor
 
 -- Errors
 
--- | Simpler alias for errorWithoutStackTrace
+-- | Call errorWithoutStackTrace, prepending a "Error:" label.
+-- Also do some ANSI styling of the first line when allowed (using unsafe IO).
 error' :: String -> a
-error' = errorWithoutStackTrace . ("Error: " <>)
+error' =
+  if useColorOnStderrUnsafe
+  then  -- color the program name as well
+    unsafePerformIO $ do
+      putStr fmt
+      return $ errorWithoutStackTrace . modifyFirstLine ((<>sgrresetall) . (label<>))
+  else
+    errorWithoutStackTrace . modifyFirstLine (label<>)
+  where
+    label = "Error: "
+    fmt = sgrbrightred <> sgrbold
 
--- | A version of errorWithoutStackTrace that adds a usage hint.
+-- | Like error', but add a hint about using -h.
 usageError :: String -> a
 usageError = error' . (++ " (use -h to see usage)")
 
--- | Show a warning message on stderr before returning the given value.
--- Use this when you want to show the user a message on stderr, without stopping the program.
--- Currently we do this very sparingly in hledger; we prefer to either quietly work,
--- or loudly raise an error. Variable output can make scripting harder.
+-- | Show a message, with "Warning:" label, on stderr before returning the given value.
+-- Also do some ANSI styling of the first line when we detect that's supported (using unsafe IO).
+-- Currently we use this very sparingly in hledger; we prefer to either quietly work,
+-- or loudly raise an error. (Varying output can make scripting harder.)
 warn :: String -> a -> a
-warn msg = trace ("Warning: " <> msg)
-
+warn msg = trace (modifyFirstLine f (label <> msg))
+  where
+    label = "Warning: "
+    f = if useColorOnStderrUnsafe then ((<>sgrresetall).(fmt<>)) else id
+      where
+        fmt = sgrbrightyellow <> sgrbold
 
+-- Transform a string's first line.
+modifyFirstLine f s = unlines $ map f l <> ls where (l,ls) = splitAt 1 $ lines s  -- total
 
 -- Time
 
@@ -554,6 +572,8 @@ sgrbold          = setSGRCode [SetConsoleIntensity BoldIntensity]
 sgrfaint         = setSGRCode [SetConsoleIntensity FaintIntensity]
 sgrnormal        = setSGRCode [SetConsoleIntensity NormalIntensity]
 sgrresetfg       = setSGRCode [SetDefaultColor Foreground]
+sgrresetbg       = setSGRCode [SetDefaultColor Background]
+sgrresetall      = sgrresetfg <> sgrresetbg <> sgrnormal
 sgrblack         = setSGRCode [SetColor Foreground Dull Black]
 sgrred           = setSGRCode [SetColor Foreground Dull Red]
 sgrgreen         = setSGRCode [SetColor Foreground Dull Green]