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

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
This commit is contained in:
Profpatsch 2024-08-18 17:30:29 +02:00
parent e9f1bb9917
commit b800bf2bd4
7 changed files with 84 additions and 70 deletions

View file

@ -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