fix(users/Profpatsch/whatcd-resolver): pretty AppException r/8675

AppException would be a console-pretty-printed version for http
errors, which would print all the escape codes in the jaeger traces of
the exception, making it more-or-less unreadable.

So instead, let’s make AppException two cases, an ErrorTree case which
is printed as-is (no color), and a “Pretty” case which is printed
using the pretty module (colors on console, no colors in otel).

Somewhat involved, I guess this is temporary until I figure out what
is really needed.

Change-Id: Iff4a8651c5f5368a5b798541efc19cc7ab9de34b
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12232
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

1 files changed, 14 insertions, 1 deletions

diff --git a/users/Profpatsch/my-prelude/src/Pretty.hs b/users/Profpatsch/my-prelude/src/Pretty.hs
index d9d4ce132b11..6711ea951a48 100644
--- a/users/Profpatsch/my-prelude/src/Pretty.hs
+++ b/users/Profpatsch/my-prelude/src/Pretty.hs
@@ -8,6 +8,7 @@ module Pretty
     printShowedStringPretty,
     -- constructors hidden
     prettyErrs,
+    prettyErrsNoColor,
     message,
     messageString,
     pretty,
@@ -19,6 +20,7 @@ where
 import Data.Aeson qualified as Json
 import Data.Aeson.Encode.Pretty qualified as Aeson.Pretty
 import Data.List qualified as List
+import Data.String (IsString (fromString))
 import Data.Text.Lazy.Builder qualified as Text.Builder
 import Language.Haskell.HsColour
   ( Output (TTYg),
@@ -62,7 +64,6 @@ showPrettyJson val =
     & toStrict
 
 -- | Display a list of 'Err's as a colored error message
--- and abort the test.
 prettyErrs :: [Err] -> String
 prettyErrs errs = res
   where
@@ -74,6 +75,15 @@ prettyErrs errs = res
     prettyShowString :: String -> String
     prettyShowString = hscolour' . nicify
 
+-- | Display a list of 'Err's as a plain-colored error message
+prettyErrsNoColor :: [Err] -> String
+prettyErrsNoColor errs = res
+  where
+    res = List.intercalate "\n" $ map one errs
+    one = \case
+      ErrMsg s -> s
+      ErrPrettyString s -> nicify s
+
 -- | Small DSL for pretty-printing errors
 data Err
   = -- | Message to display in the error
@@ -81,6 +91,9 @@ data Err
   | -- | Pretty print a String that was produced by 'show'
     ErrPrettyString String
 
+instance IsString Err where
+  fromString s = ErrMsg s
+
 -- | Plain message to display, as 'Text'
 message :: Text -> Err
 message = ErrMsg . textToString