about summary refs log tree commit diff
path: root/users/Profpatsch/my-prelude/src/Pretty.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/Profpatsch/my-prelude/src/Pretty.hs')
-rw-r--r--users/Profpatsch/my-prelude/src/Pretty.hs15
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