pretty-simple 2.2.0.1 → 3.0.0.0

raw patch · 7 files changed

+347/−61 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• pretty-simple.cabal +2/−2
• src/Debug/Pretty/Simple.hs +113/−14
• src/Text/Pretty/Simple.hs +129/−35
• src/Text/Pretty/Simple/Internal/ExprParser.hs +1/−1
• src/Text/Pretty/Simple/Internal/ExprToOutput.hs +2/−2
• src/Text/Pretty/Simple/Internal/OutputPrinter.hs +83/−7

@@ -1,3 +1,20 @@++## 3.0.0.0++*   pretty-simple now escapes non-printable characters by default.  A field+    called `outputOptionsEscapeNonPrintable` has been added to `OutputOptions`+    to control this behavior.  Implemented in+    [#44](https://github.com/cdepillabout/pretty-simple/pull/44). Thanks+    [dminuoso](https://github.com/dminuoso)!+*   pretty-simple now checks the output `Handle` to determine whether to print+    in color when using functions like `pPrint`.  This makes it so that you+    can redirect output to a file on disk and still be able to read the+    output from `pPrint`!  Implemented in+    [#47](https://github.com/cdepillabout/pretty-simple/pull/47).  Thanks+    [metiulekm](https://github.com/metiulekm)!+*   Add functions like `pHPrint` for specifying the `Handle` to output to.+    Added in [#47](https://github.com/cdepillabout/pretty-simple/pull/47).+ ## 2.2.0.1 *   Fixed a [bug](https://github.com/cdepillabout/pretty-simple/pull/41) where     the parser failed to parse escaped quotation marks in string literals.

@@ -1,5 +1,5 @@ name:                pretty-simple-version:             2.2.0.1+version:             3.0.0.0 synopsis:            pretty printer for data types with a 'Show' instance. description:         Please see <https://github.com/cdepillabout/pretty-simple#readme README.md>. homepage:            https://github.com/cdepillabout/pretty-simple@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Dennis Gosnell maintainer:          cdep.illabout@gmail.com-copyright:           2017 Dennis Gosnell+copyright:           2017-2019 Dennis Gosnell category:            Text build-type:          Simple extra-source-files:  CHANGELOG.md

@@ -16,6 +16,8 @@  module Debug.Pretty.Simple   ( -- * Trace with color on dark background+    -- This determines whether to print in color by looking at whether 'stderr'+    -- is a TTY device.     pTrace   , pTraceId   , pTraceShow@@ -28,6 +30,19 @@   , pTraceEventIO   , pTraceMarker   , pTraceMarkerIO+    -- * Trace forcing color+  , pTraceForceColor+  , pTraceIdForceColor+  , pTraceShowForceColor+  , pTraceShowIdForceColor+  , pTraceMForceColor+  , pTraceShowMForceColor+  , pTraceStackForceColor+  , pTraceEventForceColor+  , pTraceEventIOForceColor+  , pTraceMarkerForceColor+  , pTraceMarkerIOForceColor+  , pTraceIOForceColor     -- * Trace without color   , pTraceNoColor   , pTraceIdNoColor@@ -43,11 +58,17 @@   , pTraceIONoColor   ) where -import Data.Text.Lazy (unpack)+import Control.Monad ((<=<))+import Data.Text.Lazy (Text, unpack) import Debug.Trace        (trace, traceEvent, traceEventIO, traceIO, traceM, traceMarker,         traceMarkerIO, traceStack)-import Text.Pretty.Simple (pShow, pShowNoColor, pString, pStringNoColor)+import System.IO (stderr)+import System.IO.Unsafe (unsafePerformIO)+import Text.Pretty.Simple+       (pShow, pShowNoColor, pString, pStringNoColor, pStringOpt,+       defaultOutputOptionsDarkBg)+import Text.Pretty.Simple.Internal (hCheckTTY)  #if __GLASGOW_HASKELL__ < 710 -- We don't need this import for GHC 7.10 as it exports all required functions@@ -62,7 +83,7 @@ @since 2.0.1.0 -} pTraceIO :: String -> IO ()-pTraceIO = traceIO . unpack . pString+pTraceIO = traceIO . unpack <=< pStringTTYIO  {-| The 'pTrace' function pretty prints the trace message given as its first@@ -80,7 +101,7 @@ @since 2.0.1.0 -} pTrace :: String -> a -> a-pTrace = trace . unpack . pString+pTrace = trace . unpack . pStringTTY  {-| Like 'pTrace' but returns the message instead of a third value.@@ -106,7 +127,7 @@ @since 2.0.1.0 -} pTraceShow :: (Show a) => a -> b -> b-pTraceShow = trace . unpack . pShow+pTraceShow = trace . unpack . pShowTTY  {-| Like 'pTraceShow' but returns the shown value instead of a third value.@@ -114,7 +135,7 @@ @since 2.0.1.0 -} pTraceShowId :: (Show a) => a -> a-pTraceShowId a = trace (unpack (pShow a)) a+pTraceShowId a = trace (unpack (pShowTTY a)) a  {-| Like 'pTrace' but returning unit in an arbitrary 'Applicative' context. Allows@@ -140,7 +161,7 @@ #else pTraceM :: (Applicative f) => String -> f () #endif-pTraceM string = trace (unpack (pString string)) $ pure ()+pTraceM string = trace (unpack (pStringTTY string)) $ pure ()  {-| Like 'pTraceM', but uses 'show' on the argument to convert it to a 'String'.@@ -158,7 +179,7 @@ #else pTraceShowM :: (Show a, Applicative f) => a -> f () #endif-pTraceShowM = traceM . unpack . pShow+pTraceShowM = traceM . unpack . pShowTTY  {-| like 'pTrace', but additionally prints a call stack if one is@@ -173,7 +194,7 @@ @since 2.0.1.0 -} pTraceStack :: String -> a -> a-pTraceStack = traceStack . unpack . pString+pTraceStack = traceStack . unpack . pStringTTY  {-| The 'pTraceEvent' function behaves like 'trace' with the difference that@@ -190,7 +211,7 @@ @since 2.0.1.0 -} pTraceEvent :: String -> a -> a-pTraceEvent = traceEvent . unpack . pString+pTraceEvent = traceEvent . unpack . pStringTTY  {-| The 'pTraceEventIO' function emits a message to the eventlog, if eventlog@@ -202,7 +223,7 @@ @since 2.0.1.0 -} pTraceEventIO :: String -> IO ()-pTraceEventIO = traceEventIO . unpack . pString+pTraceEventIO = traceEventIO . unpack <=< pStringTTYIO  -- | The 'pTraceMarker' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. The @String@ is the name of@@ -218,7 +239,7 @@ -- -- @since 2.0.1.0 pTraceMarker :: String -> a -> a-pTraceMarker = traceMarker . unpack . pString+pTraceMarker = traceMarker . unpack . pStringTTY  -- | The 'pTraceMarkerIO' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime.@@ -228,9 +249,87 @@ -- -- @since 2.0.1.0 pTraceMarkerIO :: String -> IO ()-pTraceMarkerIO = traceMarkerIO . unpack . pString+pTraceMarkerIO = traceMarkerIO . unpack <=< pStringTTYIO  ------------------------------------------+-- Helpers+------------------------------------------++pStringTTYIO :: String -> IO Text+pStringTTYIO v = do+  realOutputOpts <- hCheckTTY stderr defaultOutputOptionsDarkBg+  pure $ pStringOpt realOutputOpts v++pStringTTY :: String -> Text+pStringTTY = unsafePerformIO . pStringTTYIO++pShowTTYIO :: Show a => a -> IO Text+pShowTTYIO = pStringTTYIO . show++pShowTTY :: Show a => a -> Text+pShowTTY = unsafePerformIO . pShowTTYIO++------------------------------------------+-- Traces forcing color+------------------------------------------++-- | Similar to 'pTrace', but forcing color.+pTraceForceColor :: String -> a -> a+pTraceForceColor = trace . unpack . pString++-- | Similar to 'pTraceId', but forcing color.+pTraceIdForceColor :: String -> String+pTraceIdForceColor a = pTraceForceColor a a++-- | Similar to 'pTraceShow', but forcing color.+pTraceShowForceColor :: (Show a) => a -> b -> b+pTraceShowForceColor = trace . unpack . pShow++-- | Similar to 'pTraceShowId', but forcing color.+pTraceShowIdForceColor :: (Show a) => a -> a+pTraceShowIdForceColor a = trace (unpack (pShow a)) a++-- | Similar to 'pTraceM', but forcing color.+#if __GLASGOW_HASKELL__ < 800+pTraceMForceColor :: (Monad f) => String -> f ()+#else+pTraceMForceColor :: (Applicative f) => String -> f ()+#endif+pTraceMForceColor string = trace (unpack (pString string)) $ pure ()++-- | Similar to 'pTraceShowM', but forcing color.+#if __GLASGOW_HASKELL__ < 800+pTraceShowMForceColor :: (Show a, Monad f) => a -> f ()+#else+pTraceShowMForceColor :: (Show a, Applicative f) => a -> f ()+#endif+pTraceShowMForceColor = traceM . unpack . pShow++-- | Similar to 'pTraceStack', but forcing color.+pTraceStackForceColor :: String -> a -> a+pTraceStackForceColor = traceStack . unpack . pString++-- | Similar to 'pTraceEvent', but forcing color.+pTraceEventForceColor :: String -> a -> a+pTraceEventForceColor = traceEvent . unpack . pString++-- | Similar to 'pTraceEventIO', but forcing color.+pTraceEventIOForceColor :: String -> IO ()+pTraceEventIOForceColor = traceEventIO . unpack . pString++-- | Similar to 'pTraceMarker', but forcing color.+pTraceMarkerForceColor :: String -> a -> a+pTraceMarkerForceColor = traceMarker . unpack . pString++-- | Similar to 'pTraceMarkerIO', but forcing color.+pTraceMarkerIOForceColor :: String -> IO ()+pTraceMarkerIOForceColor = traceMarkerIO . unpack . pString++-- | Similar to 'pTraceIO', but forcing color.+pTraceIOForceColor :: String -> IO ()+pTraceIOForceColor = traceIO . unpack . pString++------------------------------------------ -- Traces without color ------------------------------------------ @@ -300,7 +399,7 @@ #else pTraceMNoColor :: (Applicative f) => String -> f () #endif-pTraceMNoColor string = trace (unpack (pString string)) $ pure ()+pTraceMNoColor string = trace (unpack (pStringNoColor string)) $ pure ()  -- | Similar to 'pTraceShowM', but without color. --

@@ -39,22 +39,33 @@   (   -- * Output with color on dark background     pPrint+  , pHPrint+  , pPrintForceColor+  , pHPrintForceColor   , pShow   , pString   -- * Aliases for output with color on dark background   , pPrintDarkBg+  , pHPrintDarkBg+  , pPrintForceColorDarkBg+  , pHPrintForceColorDarkBg   , pShowDarkBg   , pStringDarkBg   -- * Output with color on light background   , pPrintLightBg+  , pHPrintLightBg+  , pPrintForceColorLightBg+  , pHPrintForceColorLightBg   , pShowLightBg   , pStringLightBg   -- * Output with NO color   , pPrintNoColor+  , pHPrintNoColor   , pShowNoColor   , pStringNoColor   -- * Output With 'OutputOptions'   , pPrintOpt+  , pHPrintOpt   , pShowOpt   , pStringOpt   -- * 'OutputOptions'@@ -62,6 +73,7 @@   , defaultOutputOptionsDarkBg   , defaultOutputOptionsLightBg   , defaultOutputOptionsNoColor+  , CheckColorTty(..)   -- * 'ColorOptions'   -- $colorOptions   , defaultColorOptionsDarkBg@@ -78,15 +90,19 @@  import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Foldable (toList)-import Data.Text.Lazy (Text, pack, unpack)+import Data.Text.Lazy (Text) import Data.Text.Lazy.IO as LText+import System.IO (Handle, stdout)  import Text.Pretty.Simple.Internal-       (OutputOptions(..), defaultColorOptionsDarkBg,+       (CheckColorTty(..), OutputOptions(..), defaultColorOptionsDarkBg,         defaultColorOptionsLightBg, defaultOutputOptionsDarkBg,         defaultOutputOptionsLightBg, defaultOutputOptionsNoColor,-        expressionParse, expressionsToOutputs, render)+        hCheckTTY, expressionParse, expressionsToOutputs, render) +-- $setup+-- >>> import Data.Text.Lazy (unpack)+ ---------------------------------------------------------- -- functions for printing in color to a dark background -- ----------------------------------------------------------@@ -100,12 +116,30 @@ --  pPrint :: Show a => a -> IO () -- @ ----- This function is for printing to a dark background.+-- This function will only use colors if it detects it's printing to a TTY.+--+-- This function is for printing to a dark background.  Use 'pPrintLightBg' for+-- printing to a terminal with a light background.  Different colors are used.+--+-- Prints to 'stdout'.  Use 'pHPrint' to print to a different 'Handle'. pPrint :: (MonadIO m, Show a) => a -> m ()-pPrint = pPrintOpt defaultOutputOptionsDarkBg+pPrint = pPrintOpt CheckColorTty defaultOutputOptionsDarkBg --- | Similar to 'pPrint', but just return the resulting pretty-printed data--- type as a 'Text' instead of printing it to the screen.+-- | Similar to 'pPrint', but take a 'Handle' to print to.+pHPrint :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrint = pHPrintOpt CheckColorTty defaultOutputOptionsDarkBg++-- | Similar to 'pPrint', but print in color regardless of whether the output+-- goes to a TTY or not.+pPrintForceColor :: (MonadIO m, Show a) => a -> m ()+pPrintForceColor = pPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg++-- | Similar to 'pPrintForceColor', but take a 'Handle' to print to.+pHPrintForceColor :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintForceColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg++-- | Similar to 'pPrintForceColor', but just return the resulting pretty-printed+-- data type as a 'Text' instead of printing it to the screen. -- -- This function is for printing to a dark background. pShow :: Show a => a -> Text@@ -131,6 +165,18 @@ pPrintDarkBg :: (MonadIO m, Show a) => a -> m () pPrintDarkBg = pPrint +-- | Alias for 'pHPrint'.+pHPrintDarkBg :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintDarkBg = pHPrint++-- | Alias for 'pPrintForceColor'.+pPrintForceColorDarkBg :: (MonadIO m, Show a) => a -> m ()+pPrintForceColorDarkBg = pPrintForceColor++-- | Alias for 'pHPrintForceColor'.+pHPrintForceColorDarkBg :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintForceColorDarkBg = pHPrintForceColor+ -- | Alias for 'pShow'. pShowDarkBg :: Show a => a -> Text pShowDarkBg = pShow@@ -145,8 +191,22 @@  -- | Just like 'pPrintDarkBg', but for printing to a light background. pPrintLightBg :: (MonadIO m, Show a) => a -> m ()-pPrintLightBg = pPrintOpt defaultOutputOptionsLightBg+pPrintLightBg = pPrintOpt CheckColorTty defaultOutputOptionsLightBg +-- | Just like 'pHPrintDarkBg', but for printing to a light background.+pHPrintLightBg :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintLightBg = pHPrintOpt CheckColorTty defaultOutputOptionsLightBg++-- | Just like 'pPrintForceColorDarkBg', but for printing to a light+-- background.+pPrintForceColorLightBg :: (MonadIO m, Show a) => a -> m ()+pPrintForceColorLightBg = pPrintOpt NoCheckColorTty defaultOutputOptionsLightBg++-- | Just like 'pHPrintForceColorDarkBg', but for printing to a light+-- background.+pHPrintForceColorLightBg :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintForceColorLightBg = pHPrintOpt NoCheckColorTty defaultOutputOptionsLightBg+ -- | Just like 'pShowDarkBg', but for printing to a light background. pShowLightBg :: Show a => a -> Text pShowLightBg = pShowOpt defaultOutputOptionsLightBg@@ -168,8 +228,12 @@ --     , "bye" --     ] pPrintNoColor :: (MonadIO m, Show a) => a -> m ()-pPrintNoColor = pPrintOpt defaultOutputOptionsNoColor+pPrintNoColor = pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor +-- | Like 'pPrintNoColor', but take a 'Handle' to determine where to print to.+pHPrintNoColor :: (MonadIO m, Show a) => Handle -> a -> m ()+pHPrintNoColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsNoColor+ -- | Like 'pShow', but without color. pShowNoColor :: Show a => a -> Text pShowNoColor = pShowOpt defaultOutputOptionsNoColor@@ -190,7 +254,7 @@ -- -- This is what the normal indentation looks like: ----- >>> pPrintOpt defaultOutputOptionsNoColor $ Just ("hello", "bye")+-- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor $ Just ("hello", "bye") -- Just --     ( "hello" --     , "bye"@@ -199,7 +263,7 @@ -- This is what smaller indentation looks like: -- -- >>> let smallIndent = defaultOutputOptionsNoColor {outputOptionsIndentAmount = 1}--- >>> pPrintOpt smallIndent $ Just ("hello", "bye")+-- >>> pPrintOpt CheckColorTty smallIndent $ Just ("hello", "bye") -- Just --  ( "hello" --  , "bye"@@ -207,7 +271,7 @@ -- -- Lines in strings get indented ----- >>> pPrintOpt defaultOutputOptionsNoColor (1, (2, "foo\nbar\nbaz", 3))+-- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor (1, (2, "foo\nbar\nbaz", 3)) -- ( 1 -- , --     ( 2@@ -222,7 +286,7 @@ -- -- >>> data Foo = Foo -- >>> instance Show Foo where show _ = "foo\nbar\nbaz"--- >>> pPrintOpt defaultOutputOptionsNoColor (1, (2, Foo, 3))+-- >>> pPrintOpt CheckColorTty defaultOutputOptionsNoColor (1, (2, Foo, 3)) -- ( 1 -- , --     ( 2@@ -232,9 +296,39 @@ --     , 3 --     ) -- )+--+-- 'CheckColorTty' determines whether to test 'stdout' for whether or not it is+-- connected to a TTY.+--+-- If set to 'NoCheckColorTty', then 'pPrintOpt' won't+-- check if 'stdout' is a TTY.  It will print in color depending on the value+-- of 'outputOptionsColorOptions'.+--+-- If set to 'CheckColorTty', then 'pPrintOpt' will check if 'stdout' is+-- conneted to a TTY.  If 'stdout' is determined to be connected to a TTY, then+-- it will print in color depending on the value of+-- 'outputOptionsColorOptions'.  If 'stdout' is determined to NOT be connected+-- to a TTY, then it will NOT print in color, regardless of the value of+-- 'outputOptionsColorOptions'.+pPrintOpt :: (MonadIO m, Show a) => CheckColorTty -> OutputOptions -> a -> m ()+pPrintOpt checkColorTty outputOptions =+  pHPrintOpt checkColorTty outputOptions stdout -pPrintOpt :: (MonadIO m, Show a) => OutputOptions -> a -> m ()-pPrintOpt outputOptions = liftIO . LText.putStrLn . pShowOpt outputOptions+-- | Similar to 'pPrintOpt', but take a 'Handle' to determine where to print+-- to.+pHPrintOpt ::+     (MonadIO m, Show a)+  => CheckColorTty+  -> OutputOptions+  -> Handle+  -> a+  -> m ()+pHPrintOpt checkColorTty outputOptions handle a = do+  realOutputOpts <-+    case checkColorTty of+      CheckColorTty -> hCheckTTY handle outputOptions+      NoCheckColorTty -> pure outputOptions+  liftIO $ LText.hPutStrLn handle $ pShowOpt realOutputOpts a  -- | Like 'pShow' but takes 'OutputOptions' to change how the -- pretty-printing is done.@@ -244,7 +338,8 @@ -- | Like 'pString' but takes 'OutputOptions' to change how the -- pretty-printing is done. pStringOpt :: OutputOptions -> String -> Text-pStringOpt outputOptions = render outputOptions . toList . expressionsToOutputs . expressionParse +pStringOpt outputOptions =+  render outputOptions . toList . expressionsToOutputs . expressionParse  -- $colorOptions --@@ -256,22 +351,16 @@ -- Here are some examples of using 'pPrint' on different data types.  You can -- look at these examples to get an idea of what 'pPrint' will output. ----- The following examples are all using 'pPrintNoColor' instead of 'pPrint'--- because their output is being checked using--- <https://github.com/sol/doctest#readme doctest>.  'pPrint' outputs ANSI--- escape codes in order to produce color, so the following examples would be--- hard to read had 'pPrint' been used.--- -- __Simple Haskell data type__ -- -- >>> data Foo a = Foo a String deriving Show ----- >>> pPrintNoColor $ Foo 3 "hello"+-- >>> pPrint $ Foo 3 "hello" -- Foo 3 "hello" -- -- __List__ ----- >>> pPrintNoColor $ [1,2,3]+-- >>> pPrint $ [1,2,3] -- [ 1 -- , 2 -- , 3@@ -279,14 +368,14 @@ -- -- __Slightly more complicated list__ ----- >>> pPrintNoColor $ [ Foo [ (), () ] "hello" ]+-- >>> pPrint $ [ Foo [ (), () ] "hello" ] -- [ Foo --     [ () --     , () --     ] "hello" -- ] ----- >>> pPrintNoColor $ [ Foo [ "bar", "baz" ] "hello", Foo [] "bye" ]+-- >>> pPrint $ [ Foo [ "bar", "baz" ] "hello", Foo [] "bye" ] -- [ Foo --     [ "bar" --     , "baz"@@ -304,7 +393,7 @@ --   } deriving Show -- :} ----- >>> pPrintNoColor $ Bar 1 [10, 11] [Foo 1.1 "", Foo 2.2 "hello"]+-- >>> pPrint $ Bar 1 [10, 11] [Foo 1.1 "", Foo 2.2 "hello"] -- Bar --     { barInt = 1 --     , barA =@@ -321,7 +410,7 @@ -- -- >>> newtype Baz = Baz { unBaz :: [String] } deriving Show ----- >>> pPrintNoColor $ Baz ["hello", "bye"]+-- >>> pPrint $ Baz ["hello", "bye"] -- Baz --     { unBaz = --         [ "hello"@@ -333,20 +422,20 @@ -- -- >>> data Foo = A | B Foo | C [Foo] [Foo] deriving Show ----- >>> pPrintNoColor $ B ( B A )+-- >>> pPrint $ B ( B A ) -- B ( B A ) ----- >>> pPrintNoColor $ B ( B ( B A ) )+-- >>> pPrint $ B ( B ( B A ) ) -- B --     ( B ( B A ) ) ----- >>> pPrintNoColor $ B ( B ( B ( B A ) ) )+-- >>> pPrint $ B ( B ( B ( B A ) ) ) -- B --     ( B --         ( B ( B A ) ) --     ) ----- >>> pPrintNoColor $ B ( C [A, A] [B A, B (B (B A))] )+-- >>> pPrint $ B ( C [A, A] [B A, B (B (B A))] ) -- B --     ( C --         [ A@@ -365,7 +454,7 @@ -- -- __Unicode__ ----- >>> pPrintNoColor $ Baz ["猫", "犬", "ヤギ"]+-- >>> pPrint $ Baz ["猫", "犬", "ヤギ"] -- Baz --     { unBaz = --         [ "猫"@@ -376,9 +465,14 @@ -- -- __Other__ ----- Making sure the spacing after a string is correct+-- Making sure the spacing after a string is correct. -- -- >>> data Foo = Foo String Int deriving Show ----- >>> pPrintNoColor $ Foo "bar" 0+-- >>> pPrint $ Foo "bar" 0 -- Foo "bar" 0+--+-- Non-printable characters will get escaped.+--+-- >>> pPrint "this string has non-printable characters: \x8 and \x9"+-- "this string has non-printable characters: \x8 and \x9"

@@ -60,7 +60,7 @@ parseStringLit ('"':rest) = ("", rest) parseStringLit ('\\':c:cs) = ('\\':c:cs', rest)   where (cs', rest) = parseStringLit cs-parseStringLit (c:cs)   = (c:cs', rest)+parseStringLit (c:cs) = (c:cs', rest)   where (cs', rest) = parseStringLit cs  parseOther :: String -> (String, String)

@@ -143,7 +143,7 @@     isMultiLine (Braces commaSeparated) = isMultiLine' commaSeparated     isMultiLine (Parens commaSeparated) = isMultiLine' commaSeparated     isMultiLine _ = (False, False)-    +     isMultiLine' (CommaSeparated []) = (False, False)     isMultiLine' (CommaSeparated [es]) = (True, fst $ thisAndNextMulti es)     isMultiLine' _ = (True, True)@@ -215,7 +215,7 @@   modify (\printState -> printState {currLine = currLine printState + diff})  putExpression :: MonadState PrinterState m => Expr -> m [Output]-putExpression (Brackets commaSeparated) = +putExpression (Brackets commaSeparated) =   putSurroundExpr OutputOpenBracket OutputCloseBracket commaSeparated putExpression (Braces commaSeparated) =   putSurroundExpr OutputOpenBrace OutputCloseBrace commaSeparated

@@ -26,7 +26,10 @@ import Control.Applicative #endif -import Control.Monad.Reader (MonadReader(reader), runReader)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader(ask, reader), runReader)+import Data.Char (isPrint, ord)+import Numeric (showHex) import Data.Foldable (fold) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder, fromString, toLazyText)@@ -35,6 +38,7 @@ import Data.Maybe (fromMaybe) import Text.Read (readMaybe) import GHC.Generics (Generic)+import System.IO (Handle, hIsTerminalDevice)  import Text.Pretty.Simple.Internal.Color        (ColorOptions(..), colorReset, defaultColorOptionsDarkBg,@@ -42,6 +46,21 @@ import Text.Pretty.Simple.Internal.Output        (NestLevel(..), Output(..), OutputType(..)) +-- | Determines whether pretty-simple should check if the output 'Handle' is a+-- TTY device.  Normally, users only want to print in color if the output+-- 'Handle' is a TTY device.+data CheckColorTty+  = CheckColorTty+  -- ^ Check if the output 'Handle' is a TTY device.  If the output 'Handle' is+  -- a TTY device, determine whether to print in color based on+  -- 'outputOptionsColorOptions'. If not, then set 'outputOptionsColorOptions'+  -- to 'Nothing' so the output does not get colorized.+  | NoCheckColorTty+  -- ^ Don't check if the output 'Handle' is a TTY device.  Determine whether to+  -- colorize the output based solely on the value of+  -- 'outputOptionsColorOptions'.+  deriving (Eq, Generic, Show, Typeable)+ -- | Data-type wrapping up all the options available when rendering the list -- of 'Output's. data OutputOptions = OutputOptions@@ -51,6 +70,10 @@   , outputOptionsColorOptions :: Maybe ColorOptions   -- ^ If this is 'Nothing', then don't colorize the output.  If this is   -- @'Just' colorOptions@, then use @colorOptions@ to colorize the output.+  --+  , outputOptionsEscapeNonPrintable :: Bool+  -- ^ Whether to replace non-printable characters with hexadecimal escape+  -- sequences.   } deriving (Eq, Generic, Show, Typeable)  -- | Default values for 'OutputOptions' when printing to a console with a dark@@ -61,6 +84,7 @@   OutputOptions   { outputOptionsIndentAmount = 4   , outputOptionsColorOptions = Just defaultColorOptionsDarkBg+  , outputOptionsEscapeNonPrintable = True   }  -- | Default values for 'OutputOptions' when printing to a console with a light@@ -71,6 +95,7 @@   OutputOptions   { outputOptionsIndentAmount = 4   , outputOptionsColorOptions = Just defaultColorOptionsLightBg+  , outputOptionsEscapeNonPrintable = True   }  -- | Default values for 'OutputOptions' when printing using using ANSI escape@@ -79,8 +104,23 @@ defaultOutputOptionsNoColor :: OutputOptions defaultOutputOptionsNoColor =   OutputOptions-  {outputOptionsIndentAmount = 4, outputOptionsColorOptions = Nothing}+  { outputOptionsIndentAmount = 4+  , outputOptionsColorOptions = Nothing+  , outputOptionsEscapeNonPrintable = True+  } +-- | Given 'OutputOptions', disable colorful output if the given handle+-- is not connected to a TTY.+hCheckTTY :: MonadIO m => Handle -> OutputOptions -> m OutputOptions+hCheckTTY h options = liftIO $ conv <$> tty+  where+    conv :: Bool -> OutputOptions+    conv True = options+    conv False = options { outputOptionsColorOptions = Nothing }++    tty :: IO Bool+    tty = hIsTerminalDevice h+ -- | Given 'OutputOptions' and a list of 'Output', turn the 'Output' into a -- lazy 'Text'. render :: OutputOptions -> [Output] -> Text@@ -109,8 +149,7 @@   -- TODO: This probably shouldn't be a string to begin with.   pure $ fromString $ indentSubsequentLinesWith spaces string renderOutput (Output _ (OutputStringLit string)) = do-  indentSpaces <- reader outputOptionsIndentAmount-  let spaces = replicate (indentSpaces + 2) ' '+  options <- ask    sequenceFold     [ useColorQuote@@ -118,14 +157,52 @@     , useColorReset     , useColorString     -- TODO: This probably shouldn't be a string to begin with.-    , pure $ fromString $ indentSubsequentLinesWith spaces $ readStr string+    , pure (fromString (process options string))     , useColorReset     , useColorQuote     , pure "\""     , useColorReset     ]-  where readStr s = fromMaybe s . readMaybe $ '"':s ++ "\""+  where+    process :: OutputOptions -> String -> String+    process opts =+      if outputOptionsEscapeNonPrintable opts+        then indentSubsequentLinesWith spaces . escapeNonPrintable . readStr+        else indentSubsequentLinesWith spaces . readStr+      where+        spaces :: String+        spaces = replicate (indentSpaces + 2) ' ' +        indentSpaces :: Int+        indentSpaces =  outputOptionsIndentAmount opts++        readStr :: String -> String+        readStr s = fromMaybe s . readMaybe $ '"':s ++ "\""++-- | Replace non-printable characters with hex escape sequences.+--+-- >>> escapeNonPrintable "\x1\x2"+-- "\\x1\\x2"+--+-- Newlines will not be escaped.+--+-- >>> escapeNonPrintable "hello\nworld"+-- "hello\nworld"+--+-- Printable characters will not be escaped.+--+-- >>> escapeNonPrintable "h\101llo"+-- "hello"+escapeNonPrintable :: String -> String+escapeNonPrintable input = foldr escape "" input++-- Replace an unprintable character except a newline+-- with a hex escape sequence.+escape :: Char -> ShowS+escape c+  | isPrint c || c == '\n' = (c:)+  | otherwise = ('\\':) . ('x':) . showHex (ord c)+ -- | -- >>> indentSubsequentLinesWith "  " "aaa" -- "aaa"@@ -139,7 +216,6 @@ indentSubsequentLinesWith indent input =   intercalate "\n" $ (start ++) $ map (indent ++) $ end   where (start, end) = splitAt 1 $ lines input-  -- | Produce a 'Builder' corresponding to the ANSI escape sequence for the -- color for the @\"@, based on whether or not 'outputOptionsColorOptions' is