diff options
author | Profpatsch <mail@profpatsch.de> | 2023-08-06T10·46+0200 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2023-08-06T11·17+0000 |
commit | 1fd59f51580244bac8e75b4c08f103daa20674d9 (patch) | |
tree | 701df9da2d8ff52f7c881e221b416472b0988be3 /users/Profpatsch/my-prelude/src/Pretty.hs | |
parent | ce4acc08a53fca8bc00282ca0eb4ca5fc048a222 (diff) |
chore(users/Profpatsch): clean up haskell libs a little r/6464
Change-Id: Ia9a6c5a754ca8f2912308feb5a26f5276a08d24c Reviewed-on: https://cl.tvl.fyi/c/depot/+/9011 Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/my-prelude/src/Pretty.hs')
-rw-r--r-- | users/Profpatsch/my-prelude/src/Pretty.hs | 91 |
1 files changed, 0 insertions, 91 deletions
diff --git a/users/Profpatsch/my-prelude/src/Pretty.hs b/users/Profpatsch/my-prelude/src/Pretty.hs deleted file mode 100644 index 8046c83e459c..000000000000 --- a/users/Profpatsch/my-prelude/src/Pretty.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE LambdaCase #-} - -module Pretty - ( -- * Pretty printing for error messages - Err, - printPretty, - showPretty, - -- constructors hidden - prettyErrs, - message, - messageString, - pretty, - prettyString, - hscolour', - ) -where - -import Data.List qualified as List -import Data.Text qualified as Text -import Language.Haskell.HsColour - ( Output (TTYg), - hscolour, - ) -import Language.Haskell.HsColour.ANSI (TerminalType (..)) -import Language.Haskell.HsColour.Colourise - ( defaultColourPrefs, - ) -import MyPrelude -import System.Console.ANSI (setSGRCode) -import System.Console.ANSI.Types - ( Color (Red), - ColorIntensity (Dull), - ConsoleLayer (Foreground), - SGR (Reset, SetColor), - ) -import Text.Nicify (nicify) - --- | Print any 'Show'able type to stderr, formatted nicely and in color. Very helpful for debugging. -printPretty :: Show a => a -> IO () -printPretty a = - a & pretty & (: []) & prettyErrs & stringToText & putStderrLn - -showPretty :: Show a => a -> Text -showPretty a = a & pretty & (: []) & prettyErrs & stringToText - --- | Display a list of 'Err's as a colored error message --- and abort the test. -prettyErrs :: [Err] -> String -prettyErrs errs = res - where - res = List.intercalate "\n" $ map one errs - one = \case - ErrMsg s -> color Red s - ErrPrettyString s -> prettyShowString s - -- Pretty print a String that was produced by 'show' - prettyShowString :: String -> String - prettyShowString = hscolour' . nicify - --- | Small DSL for pretty-printing errors -data Err - = -- | Message to display in the error - ErrMsg String - | -- | Pretty print a String that was produced by 'show' - ErrPrettyString String - --- | Plain message to display, as 'Text' -message :: Text -> Err -message = ErrMsg . Text.unpack - --- | Plain message to display, as 'String' -messageString :: String -> Err -messageString = ErrMsg - --- | Any 'Show'able to pretty print -pretty :: Show a => a -> Err -pretty x = ErrPrettyString $ show x - --- | Pretty print a String that was produced by 'show' -prettyString :: String -> Err -prettyString s = ErrPrettyString s - --- Prettifying Helpers, mostly stolen from --- https://hackage.haskell.org/package/hspec-expectations-pretty-diff-0.7.2.5/docs/src/Test.Hspec.Expectations.Pretty.html#prettyColor - -hscolour' :: String -> String -hscolour' = - hscolour (TTYg Ansi16Colour) defaultColourPrefs False False "" False - -color :: Color -> String -> String -color c s = setSGRCode [SetColor Foreground Dull c] ++ s ++ setSGRCode [Reset] |