pretty-simple-4.1.2.0/app/0000755000000000000000000000000014314136566013451 5ustar0000000000000000pretty-simple-4.1.2.0/bench/0000755000000000000000000000000014314136566013750 5ustar0000000000000000pretty-simple-4.1.2.0/example/0000755000000000000000000000000014314136566014324 5ustar0000000000000000pretty-simple-4.1.2.0/example/Example/0000755000000000000000000000000014314136566015717 5ustar0000000000000000pretty-simple-4.1.2.0/img/0000755000000000000000000000000014314136566013445 5ustar0000000000000000pretty-simple-4.1.2.0/src/0000755000000000000000000000000014314136566013460 5ustar0000000000000000pretty-simple-4.1.2.0/src/Debug/0000755000000000000000000000000014314136566014506 5ustar0000000000000000pretty-simple-4.1.2.0/src/Debug/Pretty/0000755000000000000000000000000014314136566015775 5ustar0000000000000000pretty-simple-4.1.2.0/src/Text/0000755000000000000000000000000014314136566014404 5ustar0000000000000000pretty-simple-4.1.2.0/src/Text/Pretty/0000755000000000000000000000000014322623346015667 5ustar0000000000000000pretty-simple-4.1.2.0/src/Text/Pretty/Simple/0000755000000000000000000000000014314136566017124 5ustar0000000000000000pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal/0000755000000000000000000000000014322623346020674 5ustar0000000000000000pretty-simple-4.1.2.0/test/0000755000000000000000000000000014314136566013650 5ustar0000000000000000pretty-simple-4.1.2.0/src/Debug/Pretty/Simple.hs0000644000000000000000000005224114314136566017566 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module : Debug.Pretty.Simple Copyright : (c) Dennis Gosnell, 2017 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX This module contains the same functionality with Prelude's "Debug.Trace" module, with pretty printing the debug strings. Warning: This module also shares the same unsafety of "Debug.Trace" module. -} 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 , pTraceShowId , pTraceIO , pTraceM , pTraceShowM , pTraceStack , pTraceEvent , pTraceEventIO , pTraceMarker , pTraceMarkerIO , pTraceWith , pTraceShowWith -- * Trace forcing color , pTraceForceColor , pTraceIdForceColor , pTraceShowForceColor , pTraceShowIdForceColor , pTraceMForceColor , pTraceShowMForceColor , pTraceStackForceColor , pTraceEventForceColor , pTraceEventIOForceColor , pTraceMarkerForceColor , pTraceMarkerIOForceColor , pTraceIOForceColor -- * Trace without color , pTraceNoColor , pTraceIdNoColor , pTraceShowNoColor , pTraceShowIdNoColor , pTraceMNoColor , pTraceShowMNoColor , pTraceStackNoColor , pTraceEventNoColor , pTraceEventIONoColor , pTraceMarkerNoColor , pTraceMarkerIONoColor , pTraceIONoColor -- * Trace With 'OutputOptions' , pTraceOpt , pTraceIdOpt , pTraceShowOpt , pTraceShowIdOpt , pTraceOptIO , pTraceOptM , pTraceShowOptM , pTraceStackOpt , pTraceEventOpt , pTraceEventOptIO , pTraceMarkerOpt , pTraceMarkerOptIO ) where import Control.Monad ((<=<)) import Data.Text.Lazy (Text, unpack) import Debug.Trace (trace, traceEvent, traceEventIO, traceIO, traceM, traceMarker, traceMarkerIO, traceStack) import System.IO (stderr) import System.IO.Unsafe (unsafePerformIO) import Text.Pretty.Simple (CheckColorTty(..), OutputOptions, pStringOpt, defaultOutputOptionsNoColor, 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 -- from Prelude import Control.Applicative #endif {-| The 'pTraceIO' function outputs the trace message from the IO monad. This sequences the output with respect to other IO actions. @since 2.0.1.0 -} {-# WARNING pTraceIO "'pTraceIO' remains in code" #-} pTraceIO :: String -> IO () pTraceIO = pTraceOptIO CheckColorTty defaultOutputOptionsDarkBg {-| The 'pTrace' function pretty prints the trace message given as its first argument, before returning the second argument as its result. For example, this returns the value of @f x@ but first outputs the message. > pTrace ("calling f with x = " ++ show x) (f x) The 'pTrace' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the trace message. @since 2.0.1.0 -} {-# WARNING pTrace "'pTrace' remains in code" #-} pTrace :: String -> a -> a pTrace = pTraceOpt CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTrace' but returns the message instead of a third value. @since 2.0.1.0 -} {-# WARNING pTraceId "'pTraceId' remains in code" #-} pTraceId :: String -> String pTraceId = pTraceIdOpt CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTrace', but uses 'show' on the argument to convert it to a 'String'. This makes it convenient for printing the values of interesting variables or expressions inside a function. For example here we print the value of the variables @x@ and @z@: > f x y = > pTraceShow (x, z) $ result > where > z = ... > ... @since 2.0.1.0 -} {-# WARNING pTraceShow "'pTraceShow' remains in code" #-} pTraceShow :: (Show a) => a -> b -> b pTraceShow = pTraceShowOpt CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTraceShow' but returns the shown value instead of a third value. @since 2.0.1.0 -} {-# WARNING pTraceShowId "'pTraceShowId' remains in code" #-} pTraceShowId :: (Show a) => a -> a pTraceShowId = pTraceShowIdOpt CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTrace' but returning unit in an arbitrary 'Applicative' context. Allows for convenient use in do-notation. Note that the application of 'pTraceM' is not an action in the 'Applicative' context, as 'pTraceIO' is in the 'IO' type. While the fresh bindings in the following example will force the 'traceM' expressions to be reduced every time the @do@-block is executed, @traceM "not crashed"@ would only be reduced once, and the message would only be printed once. If your monad is in 'MonadIO', @liftIO . pTraceIO@ may be a better option. > ... = do > x <- ... > pTraceM $ "x: " ++ show x > y <- ... > pTraceM $ "y: " ++ show y @since 2.0.1.0 -} {-# WARNING pTraceM "'pTraceM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceM :: (Monad f) => String -> f () #else pTraceM :: (Applicative f) => String -> f () #endif pTraceM = pTraceOptM CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTraceM', but uses 'show' on the argument to convert it to a 'String'. > ... = do > x <- ... > pTraceShowM $ x > y <- ... > pTraceShowM $ x + y @since 2.0.1.0 -} {-# WARNING pTraceShowM "'pTraceShowM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowM :: (Show a, Monad f) => a -> f () #else pTraceShowM :: (Show a, Applicative f) => a -> f () #endif pTraceShowM = pTraceShowOptM CheckColorTty defaultOutputOptionsDarkBg {-| like 'pTrace', but additionally prints a call stack if one is available. In the current GHC implementation, the call stack is only available if the program was compiled with @-prof@; otherwise 'pTraceStack' behaves exactly like 'pTrace'. Entries in the call stack correspond to @SCC@ annotations, so it is a good idea to use @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically. @since 2.0.1.0 -} {-# WARNING pTraceStack "'pTraceStack' remains in code" #-} pTraceStack :: String -> a -> a pTraceStack = pTraceStackOpt CheckColorTty defaultOutputOptionsDarkBg {-| The 'pTraceEvent' function behaves like 'trace' with the difference that the message is emitted to the eventlog, if eventlog profiling is available and enabled at runtime. It is suitable for use in pure code. In an IO context use 'pTraceEventIO' instead. Note that when using GHC's SMP runtime, it is possible (but rare) to get duplicate events emitted if two CPUs simultaneously evaluate the same thunk that uses 'pTraceEvent'. @since 2.0.1.0 -} {-# WARNING pTraceEvent "'pTraceEvent' remains in code" #-} pTraceEvent :: String -> a -> a pTraceEvent = pTraceEventOpt CheckColorTty defaultOutputOptionsDarkBg {-| The 'pTraceEventIO' function emits a message to the eventlog, if eventlog profiling is available and enabled at runtime. Compared to 'pTraceEvent', 'pTraceEventIO' sequences the event with respect to other IO actions. @since 2.0.1.0 -} {-# WARNING pTraceEventIO "'pTraceEventIO' remains in code" #-} pTraceEventIO :: String -> IO () pTraceEventIO = pTraceEventOptIO CheckColorTty defaultOutputOptionsDarkBg -- | The 'pTraceMarker' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. The @String@ is the name of -- the marker. The name is just used in the profiling tools to help you keep -- clear which marker is which. -- -- This function is suitable for use in pure code. In an IO context use -- 'pTraceMarkerIO' instead. -- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'pTraceMarker'. -- -- @since 2.0.1.0 {-# WARNING pTraceMarker "'pTraceMarker' remains in code" #-} pTraceMarker :: String -> a -> a pTraceMarker = pTraceMarkerOpt CheckColorTty defaultOutputOptionsDarkBg -- | The 'pTraceMarkerIO' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. -- -- Compared to 'pTraceMarker', 'pTraceMarkerIO' sequences the event with respect -- to other IO actions. -- -- @since 2.0.1.0 {-# WARNING pTraceMarkerIO "'pTraceMarkerIO' remains in code" #-} pTraceMarkerIO :: String -> IO () pTraceMarkerIO = pTraceMarkerOptIO CheckColorTty defaultOutputOptionsDarkBg -- | The 'pTraceWith' function pretty prints the result of -- applying @f to @a and returns back @a -- -- @since ? {-# WARNING pTraceWith "'pTraceWith' remains in code" #-} pTraceWith :: (a -> String) -> a -> a pTraceWith f a = pTrace (f a) a -- | The 'pTraceShowWith' function similar to 'pTraceWith' except that -- @f can return any type that implements Show -- -- @since ? {-# WARNING pTraceShowWith "'pTraceShowWith' remains in code" #-} pTraceShowWith :: Show b => (a -> b) -> a -> a pTraceShowWith f = (show . f) >>= pTraceShow ------------------------------------------ -- Helpers ------------------------------------------ {-# WARNING pStringTTYOptIO "'pStringTTYOptIO' remains in code" #-} pStringTTYOptIO :: CheckColorTty -> OutputOptions -> String -> IO Text pStringTTYOptIO checkColorTty outputOptions v = do realOutputOpts <- case checkColorTty of CheckColorTty -> hCheckTTY stderr outputOptions NoCheckColorTty -> pure outputOptions pure $ pStringOpt realOutputOpts v {-# WARNING pStringTTYOpt "'pStringTTYOpt' remains in code" #-} pStringTTYOpt :: CheckColorTty -> OutputOptions -> String -> Text pStringTTYOpt checkColorTty outputOptions = unsafePerformIO . pStringTTYOptIO checkColorTty outputOptions {-# WARNING pShowTTYOptIO "'pShowTTYOptIO' remains in code" #-} pShowTTYOptIO :: Show a => CheckColorTty -> OutputOptions -> a -> IO Text pShowTTYOptIO checkColorTty outputOptions = pStringTTYOptIO checkColorTty outputOptions . show {-# WARNING pShowTTYOpt "'pShowTTYOpt' remains in code" #-} pShowTTYOpt :: Show a => CheckColorTty -> OutputOptions -> a -> Text pShowTTYOpt checkColorTty outputOptions = unsafePerformIO . pShowTTYOptIO checkColorTty outputOptions ------------------------------------------ -- Traces forcing color ------------------------------------------ -- | Similar to 'pTrace', but forcing color. {-# WARNING pTraceForceColor "'pTraceForceColor' remains in code" #-} pTraceForceColor :: String -> a -> a pTraceForceColor = pTraceOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceId', but forcing color. {-# WARNING pTraceIdForceColor "'pTraceIdForceColor' remains in code" #-} pTraceIdForceColor :: String -> String pTraceIdForceColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShow', but forcing color. {-# WARNING pTraceShowForceColor "'pTraceShowForceColor' remains in code" #-} pTraceShowForceColor :: (Show a) => a -> b -> b pTraceShowForceColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShowId', but forcing color. {-# WARNING pTraceShowIdForceColor "'pTraceShowIdForceColor' remains in code" #-} pTraceShowIdForceColor :: (Show a) => a -> a pTraceShowIdForceColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceM', but forcing color. {-# WARNING pTraceMForceColor "'pTraceMForceColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceMForceColor :: (Monad f) => String -> f () #else pTraceMForceColor :: (Applicative f) => String -> f () #endif pTraceMForceColor = pTraceOptM NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShowM', but forcing color. {-# WARNING pTraceShowMForceColor "'pTraceShowMForceColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowMForceColor :: (Show a, Monad f) => a -> f () #else pTraceShowMForceColor :: (Show a, Applicative f) => a -> f () #endif pTraceShowMForceColor = pTraceShowOptM NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceStack', but forcing color. {-# WARNING pTraceStackForceColor "'pTraceStackForceColor' remains in code" #-} pTraceStackForceColor :: String -> a -> a pTraceStackForceColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEvent', but forcing color. {-# WARNING pTraceEventForceColor "'pTraceEventForceColor' remains in code" #-} pTraceEventForceColor :: String -> a -> a pTraceEventForceColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEventIO', but forcing color. {-# WARNING pTraceEventIOForceColor "'pTraceEventIOForceColor' remains in code" #-} pTraceEventIOForceColor :: String -> IO () pTraceEventIOForceColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarker', but forcing color. {-# WARNING pTraceMarkerForceColor "'pTraceMarkerForceColor' remains in code" #-} pTraceMarkerForceColor :: String -> a -> a pTraceMarkerForceColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarkerIO', but forcing color. {-# WARNING pTraceMarkerIOForceColor "'pTraceMarkerIOForceColor' remains in code" #-} pTraceMarkerIOForceColor :: String -> IO () pTraceMarkerIOForceColor = pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceIO', but forcing color. {-# WARNING pTraceIOForceColor "'pTraceIOForceColor' remains in code" #-} pTraceIOForceColor :: String -> IO () pTraceIOForceColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsDarkBg ------------------------------------------ -- Traces without color ------------------------------------------ -- | Similar to 'pTrace', but without color. -- -- >>> pTraceNoColor "wow" () -- wow -- () -- -- @since 2.0.2.0 {-# WARNING pTraceNoColor "'pTraceNoColor' remains in code" #-} pTraceNoColor :: String -> a -> a pTraceNoColor = pTraceOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceId', but without color. -- -- >>> pTraceIdNoColor "(1, 2, 3)" `seq` () -- ( 1 -- , 2 -- , 3 -- ) -- () -- -- @since 2.0.2.0 {-# WARNING pTraceIdNoColor "'pTraceIdNoColor' remains in code" #-} pTraceIdNoColor :: String -> String pTraceIdNoColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceShow', but without color. -- -- >>> import qualified Data.Map as M -- >>> pTraceShowNoColor (M.fromList [(1, True)]) () -- fromList -- [ -- ( 1 -- , True -- ) -- ] -- () -- -- @since 2.0.2.0 {-# WARNING pTraceShowNoColor "'pTraceShowNoColor' remains in code" #-} pTraceShowNoColor :: (Show a) => a -> b -> b pTraceShowNoColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceShowId', but without color. -- -- >>> import qualified Data.Map as M -- >>> pTraceShowIdNoColor (M.fromList [(1, True)]) `seq` () -- fromList -- [ -- ( 1 -- , True -- ) -- ] -- () -- -- @since 2.0.2.0 {-# WARNING pTraceShowIdNoColor "'pTraceShowIdNoColor' remains in code" #-} pTraceShowIdNoColor :: (Show a) => a -> a pTraceShowIdNoColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceM', but without color. -- -- >>> pTraceMNoColor "wow" -- wow -- -- @since 2.0.2.0 {-# WARNING pTraceMNoColor "'pTraceMNoColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceMNoColor :: (Monad f) => String -> f () #else pTraceMNoColor :: (Applicative f) => String -> f () #endif pTraceMNoColor = pTraceOptM NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceShowM', but without color. -- -- >>> pTraceShowMNoColor [1,2,3] -- [ 1 -- , 2 -- , 3 -- ] -- -- @since 2.0.2.0 {-# WARNING pTraceShowMNoColor "'pTraceShowMNoColor' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowMNoColor :: (Show a, Monad f) => a -> f () #else pTraceShowMNoColor :: (Show a, Applicative f) => a -> f () #endif pTraceShowMNoColor = pTraceShowOptM NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceStack', but without color. -- -- >>> pTraceStackNoColor "wow" () `seq` () -- wow -- () -- -- @since 2.0.2.0 {-# WARNING pTraceStackNoColor "'pTraceStackNoColor' remains in code" #-} pTraceStackNoColor :: String -> a -> a pTraceStackNoColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEvent', but without color. -- -- @since 2.0.2.0 {-# WARNING pTraceEventNoColor "'pTraceEventNoColor' remains in code" #-} pTraceEventNoColor :: String -> a -> a pTraceEventNoColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEventIO', but without color. -- -- @since 2.0.2.0 {-# WARNING pTraceEventIONoColor "'pTraceEventIONoColor' remains in code" #-} pTraceEventIONoColor :: String -> IO () pTraceEventIONoColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceMarker', but without color. -- -- @since 2.0.2.0 {-# WARNING pTraceMarkerNoColor "'pTraceMarkerNoColor' remains in code" #-} pTraceMarkerNoColor :: String -> a -> a pTraceMarkerNoColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceMarkerIO', but without color. -- -- @since 2.0.2.0 {-# WARNING pTraceMarkerIONoColor "'pTraceMarkerIONoColor' remains in code" #-} pTraceMarkerIONoColor :: String -> IO () pTraceMarkerIONoColor = pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceIO', but without color. -- -- >>> pTraceIONoColor "(1, 2, 3)" -- ( 1 -- , 2 -- , 3 -- ) -- -- @since 2.0.2.0 {-# WARNING pTraceIONoColor "'pTraceIONoColor' remains in code" #-} pTraceIONoColor :: String -> IO () pTraceIONoColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsNoColor ------------------------------------------ -- Traces that take options ------------------------------------------ {-| Like 'pTrace' but takes OutputOptions. -} {-# WARNING pTraceOpt "'pTraceOpt' remains in code" #-} pTraceOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceOpt checkColorTty outputOptions = trace . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceId' but takes OutputOptions. -} {-# WARNING pTraceIdOpt "'pTraceIdOpt' remains in code" #-} pTraceIdOpt :: CheckColorTty -> OutputOptions -> String -> String pTraceIdOpt checkColorTty outputOptions a = pTraceOpt checkColorTty outputOptions a a {-| Like 'pTraceShow' but takes OutputOptions. -} {-# WARNING pTraceShowOpt "'pTraceShowOpt' remains in code" #-} pTraceShowOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> b -> b pTraceShowOpt checkColorTty outputOptions = trace . unpack . pShowTTYOpt checkColorTty outputOptions {-| Like 'pTraceShowId' but takes OutputOptions. -} {-# WARNING pTraceShowIdOpt "'pTraceShowIdOpt' remains in code" #-} pTraceShowIdOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> a pTraceShowIdOpt checkColorTty outputOptions a = trace (unpack $ pShowTTYOpt checkColorTty outputOptions a) a {-| Like 'pTraceIO' but takes OutputOptions. -} {-# WARNING pTraceOptIO "'pTraceOptIO' remains in code" #-} pTraceOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceOptIO checkColorTty outputOptions = traceIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions {-| Like 'pTraceM' but takes OutputOptions. -} {-# WARNING pTraceOptM "'pTraceOptM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceOptM :: (Monad f) => CheckColorTty -> OutputOptions -> String -> f () #else pTraceOptM :: (Applicative f) => CheckColorTty -> OutputOptions -> String -> f () #endif pTraceOptM checkColorTty outputOptions string = trace (unpack $ pStringTTYOpt checkColorTty outputOptions string) $ pure () {-| Like 'pTraceShowM' but takes OutputOptions. -} {-# WARNING pTraceShowOptM "'pTraceShowOptM' remains in code" #-} #if __GLASGOW_HASKELL__ < 800 pTraceShowOptM :: (Show a, Monad f) => CheckColorTty -> OutputOptions -> a -> f () #else pTraceShowOptM :: (Show a, Applicative f) => CheckColorTty -> OutputOptions -> a -> f () #endif pTraceShowOptM checkColorTty outputOptions = traceM . unpack . pShowTTYOpt checkColorTty outputOptions {-| Like 'pTraceStack' but takes OutputOptions. -} {-# WARNING pTraceStackOpt "'pTraceStackOpt' remains in code" #-} pTraceStackOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceStackOpt checkColorTty outputOptions = traceStack . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceEvent' but takes OutputOptions. -} {-# WARNING pTraceEventOpt "'pTraceEventOpt' remains in code" #-} pTraceEventOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceEventOpt checkColorTty outputOptions = traceEvent . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceEventIO' but takes OutputOptions. -} {-# WARNING pTraceEventOptIO "'pTraceEventOptIO' remains in code" #-} pTraceEventOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceEventOptIO checkColorTty outputOptions = traceEventIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions {-| Like 'pTraceMarker' but takes OutputOptions. -} {-# WARNING pTraceMarkerOpt "'pTraceMarkerOpt' remains in code" #-} pTraceMarkerOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceMarkerOpt checkColorTty outputOptions = traceMarker . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceMarkerIO' but takes OutputOptions. -} {-# WARNING pTraceMarkerOptIO "'pTraceMarkerOptIO' remains in code" #-} pTraceMarkerOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceMarkerOptIO checkColorTty outputOptions = traceMarkerIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions pretty-simple-4.1.2.0/src/Text/Pretty/Simple.hs0000644000000000000000000005336014322623346017463 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Text.Pretty.Simple Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX This module contains the functions 'pPrint', 'pShow', and 'pString' for pretty-printing any Haskell data type with a 'Show' instance. 'pPrint' is the main go-to function when debugging Haskell code. 'pShow' and 'pString' are slight variations on 'pPrint'. 'pPrint', 'pShow', and 'pString' will pretty-print in color using ANSI escape codes. They look good on a console with a dark (black) background. The variations 'pPrintLightBg', 'pShowLightBg', and 'pStringLightBg' are for printing in color to a console with a light (white) background. The variations 'pPrintNoColor', 'pShowNoColor', and 'pStringNoColor' are for pretty-printing without using color. 'pPrint' and 'pPrintLightBg' will intelligently decide whether or not to use ANSI escape codes for coloring depending on whether or not the output is a TTY. This works in most cases. If you want to force color output, you can use the 'pPrintForceColor' or 'pPrintForceColorLightBg' functions. The variations 'pPrintOpt', 'pShowOpt', and 'pStringOpt' are used when specifying the 'OutputOptions'. Most users can ignore these. There are a few other functions available that are similar to 'pPrint'. See the Examples section at the end of this module for examples of acutally using 'pPrint'. See the for examples of printing in color. -} module Text.Pretty.Simple ( -- * Output with color on dark background pPrint , pHPrint , pPrintString , pHPrintString , pPrintForceColor , pHPrintForceColor , pPrintStringForceColor , pHPrintStringForceColor , pShow , pString -- * Aliases for output with color on dark background , pPrintDarkBg , pHPrintDarkBg , pPrintStringDarkBg , pHPrintStringDarkBg , pPrintForceColorDarkBg , pHPrintForceColorDarkBg , pPrintStringForceColorDarkBg , pHPrintStringForceColorDarkBg , pShowDarkBg , pStringDarkBg -- * Output with color on light background , pPrintLightBg , pHPrintLightBg , pPrintStringLightBg , pHPrintStringLightBg , pPrintForceColorLightBg , pHPrintForceColorLightBg , pPrintStringForceColorLightBg , pHPrintStringForceColorLightBg , pShowLightBg , pStringLightBg -- * Output with NO color , pPrintNoColor , pHPrintNoColor , pPrintStringNoColor , pHPrintStringNoColor , pShowNoColor , pStringNoColor -- * Output With 'OutputOptions' , pPrintOpt , pHPrintOpt , pPrintStringOpt , pHPrintStringOpt , pShowOpt , pStringOpt -- * 'OutputOptions' , OutputOptions(..) , StringOutputStyle(..) , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg , defaultOutputOptionsNoColor , CheckColorTty(..) -- * 'ColorOptions' , defaultColorOptionsDarkBg , defaultColorOptionsLightBg , ColorOptions(..) , Style(..) , Color(..) , Intensity(..) , colorNull -- * Examples -- $examples ) where #if __GLASGOW_HASKELL__ < 710 -- We don't need this import for GHC 7.10 as it exports all required functions -- from Prelude import Control.Applicative #endif import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text.Lazy (Text) import Prettyprinter (SimpleDocStream) import Prettyprinter.Render.Terminal (Color (..), Intensity(Vivid,Dull), AnsiStyle, renderLazy, renderIO) import System.IO (Handle, stdout, hPutStrLn) import Text.Pretty.Simple.Internal (ColorOptions(..), Style(..), CheckColorTty(..), OutputOptions(..), StringOutputStyle(..), convertStyle, colorNull, defaultColorOptionsDarkBg, defaultColorOptionsLightBg, defaultOutputOptionsDarkBg, defaultOutputOptionsLightBg, defaultOutputOptionsNoColor, hCheckTTY, layoutString) -- $setup -- >>> import Data.Text.Lazy (unpack) ---------------------------------------------------------- -- functions for printing in color to a dark background -- ---------------------------------------------------------- -- | Pretty-print any data type that has a 'Show' instance. -- -- If you've never seen 'MonadIO' before, you can think of this function as -- having the following type signature: -- -- @ -- pPrint :: Show a => a -> IO () -- @ -- -- 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 [Just (1, "hello")] -- [ Just -- ( 1 -- , "hello" -- ) -- ] pPrint :: (MonadIO m, Show a) => a -> m () pPrint = pPrintOpt CheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pPrint', but take a 'Handle' to print to. -- -- >>> pHPrint stdout [Just (1, "hello")] -- [ Just -- ( 1 -- , "hello" -- ) -- ] pHPrint :: (MonadIO m, Show a) => Handle -> a -> m () pHPrint = pHPrintOpt CheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pPrint', but the first argument is a 'String' representing a -- data type that has already been 'show'ed. -- -- >>> pPrintString $ show [ Just (1, "hello"), Nothing ] -- [ Just -- ( 1 -- , "hello" -- ) -- , Nothing -- ] pPrintString :: MonadIO m => String -> m () pPrintString = pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pHPrintString', but take a 'Handle' to print to. -- -- >>> pHPrintString stdout $ show [ Just (1, "hello"), Nothing ] -- [ Just -- ( 1 -- , "hello" -- ) -- , Nothing -- ] pHPrintString :: MonadIO m => Handle -> String -> m () pHPrintString = pHPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pPrint', but print in color regardless of whether the output -- goes to a TTY or not. -- -- See 'pPrint' for an example of how to use this function. pPrintForceColor :: (MonadIO m, Show a) => a -> m () pPrintForceColor = pPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pPrintForceColor', but take a 'Handle' to print to. -- -- See 'pHPrint' for an example of how to use this function. pHPrintForceColor :: (MonadIO m, Show a) => Handle -> a -> m () pHPrintForceColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pPrintString', but print in color regardless of whether the -- output goes to a TTY or not. -- -- See 'pPrintString' for an example of how to use this function. pPrintStringForceColor :: MonadIO m => String -> m () pPrintStringForceColor = pPrintStringOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pHPrintString', but print in color regardless of whether the -- output goes to a TTY or not. -- -- See 'pHPrintString' for an example of how to use this function. pHPrintStringForceColor :: MonadIO m => Handle -> String -> m () pHPrintStringForceColor = pHPrintStringOpt 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. -- -- See 'pShowNoColor' for an example of how to use this function. pShow :: Show a => a -> Text pShow = pShowOpt defaultOutputOptionsDarkBg -- | Similar to 'pShow', but the first argument is a 'String' representing a -- data type that has already been 'show'ed. -- -- This will work on any 'String' that is similar to a Haskell data type. The -- only requirement is that the strings are quoted, and braces, parentheses, and -- brackets are correctly used to represent indentation. For example, -- 'pString' will correctly pretty-print JSON. -- -- This function is for printing to a dark background. -- -- See 'pStringNoColor' for an example of how to use this function. pString :: String -> Text pString = pStringOpt defaultOutputOptionsDarkBg -------------------------------------------------------- -- aliases for printing in color to a dark background -- -------------------------------------------------------- -- | Alias for 'pPrint'. pPrintDarkBg :: (MonadIO m, Show a) => a -> m () pPrintDarkBg = pPrint -- | Alias for 'pHPrint'. pHPrintDarkBg :: (MonadIO m, Show a) => Handle -> a -> m () pHPrintDarkBg = pHPrint -- | Alias for 'pPrintString'. pPrintStringDarkBg :: MonadIO m => String -> m () pPrintStringDarkBg = pPrintString -- | Alias for 'pHPrintString'. pHPrintStringDarkBg :: MonadIO m => Handle -> String -> m () pHPrintStringDarkBg = pHPrintString -- | 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 'pPrintStringForceColor'. pPrintStringForceColorDarkBg :: MonadIO m => String -> m () pPrintStringForceColorDarkBg = pPrintStringForceColor -- | Alias for 'pHPrintStringForceColor'. pHPrintStringForceColorDarkBg :: MonadIO m => Handle -> String -> m () pHPrintStringForceColorDarkBg = pHPrintStringForceColor -- | Alias for 'pShow'. pShowDarkBg :: Show a => a -> Text pShowDarkBg = pShow -- | Alias for 'pString'. pStringDarkBg :: String -> Text pStringDarkBg = pString ----------------------------------------------------------- -- functions for printing in color to a light background -- ----------------------------------------------------------- -- | Just like 'pPrintDarkBg', but for printing to a light background. pPrintLightBg :: (MonadIO m, Show a) => a -> m () 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 'pPrintStringDarkBg', but for printing to a light background. pPrintStringLightBg :: MonadIO m => String -> m () pPrintStringLightBg = pPrintStringOpt CheckColorTty defaultOutputOptionsLightBg -- | Just like 'pHPrintStringDarkBg', but for printing to a light background. pHPrintStringLightBg :: MonadIO m => Handle -> String -> m () pHPrintStringLightBg = pHPrintStringOpt 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 'pPrintStringForceColorDarkBg', but for printing to a light -- background. pPrintStringForceColorLightBg :: MonadIO m => String -> m () pPrintStringForceColorLightBg = pPrintStringOpt NoCheckColorTty defaultOutputOptionsLightBg -- | Just like 'pHPrintStringForceColorDarkBg', but for printing to a light -- background. pHPrintStringForceColorLightBg :: MonadIO m => Handle -> String -> m () pHPrintStringForceColorLightBg = pHPrintStringOpt NoCheckColorTty defaultOutputOptionsLightBg -- | Just like 'pShowDarkBg', but for printing to a light background. pShowLightBg :: Show a => a -> Text pShowLightBg = pShowOpt defaultOutputOptionsLightBg -- | Just like 'pStringDarkBg', but for printing to a light background. pStringLightBg :: String -> Text pStringLightBg = pStringOpt defaultOutputOptionsLightBg ------------------------------------------ -- functions for printing without color -- ------------------------------------------ -- | Similar to 'pPrint', but doesn't print in color. However, data types -- will still be indented nicely. -- -- >>> pPrintNoColor $ Just ["hello", "bye"] -- Just -- [ "hello" -- , "bye" -- ] pPrintNoColor :: (MonadIO m, Show a) => a -> m () pPrintNoColor = pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Like 'pPrintNoColor', but take a 'Handle' to determine where to print to. -- -- >>> pHPrintNoColor stdout $ Just ["hello", "bye"] -- Just -- [ "hello" -- , "bye" -- ] pHPrintNoColor :: (MonadIO m, Show a) => Handle -> a -> m () pHPrintNoColor = pHPrintOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pPrintString', but doesn't print in color. However, data types -- will still be indented nicely. -- -- >>> pPrintStringNoColor $ show $ Just ["hello", "bye"] -- Just -- [ "hello" -- , "bye" -- ] pPrintStringNoColor :: MonadIO m => String -> m () pPrintStringNoColor = pPrintStringOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Like 'pPrintStringNoColor', but take a 'Handle' to determine where to print to. -- -- >>> pHPrintStringNoColor stdout $ show $ Just ["hello", "bye"] -- Just -- [ "hello" -- , "bye" -- ] pHPrintStringNoColor :: MonadIO m => Handle -> String -> m () pHPrintStringNoColor = pHPrintStringOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Like 'pShow', but without color. -- -- >>> pShowNoColor [ Nothing, Just (1, "hello") ] -- "[ Nothing\n, Just\n ( 1\n , \"hello\"\n )\n]" pShowNoColor :: Show a => a -> Text pShowNoColor = pShowOpt defaultOutputOptionsNoColor -- | LIke 'pString', but without color. -- -- >>> pStringNoColor $ show [1, 2, 3] -- "[ 1\n, 2\n, 3\n]" pStringNoColor :: String -> Text pStringNoColor = pStringOpt defaultOutputOptionsNoColor --------------------------------- -- functions that take options -- --------------------------------- -- | Similar to 'pPrint' but takes 'OutputOptions' to change how the -- pretty-printing is done. -- -- For example, 'pPrintOpt' can be used to make the indentation much smaller -- than normal. -- -- This is what the normal indentation looks like: -- -- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor $ Just ("hello", "bye") -- Just -- ( "hello" -- , "bye" -- ) -- -- This is what smaller indentation looks like: -- -- >>> let smallIndent = defaultOutputOptionsNoColor {outputOptionsIndentAmount = 1} -- >>> pPrintOpt CheckColorTty smallIndent $ Just ("hello", "bye") -- Just -- ( "hello" -- , "bye" -- ) -- -- Lines in strings get indented -- -- >>> pPrintOpt NoCheckColorTty defaultOutputOptionsNoColor (1, (2, "foo\nbar\nbaz", 3)) -- ( 1 -- , -- ( 2 -- , "foo -- bar -- baz" -- , 3 -- ) -- ) -- -- Lines get indented even in custom show instances -- -- >>> data Foo = Foo -- >>> instance Show Foo where show _ = "foo\nbar\nbaz" -- >>> pPrintOpt CheckColorTty defaultOutputOptionsNoColor (1, (2, Foo, 3)) -- ( 1 -- , -- ( 2 -- , foo -- bar -- baz -- , 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 -- | 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 = pHPrintStringOpt checkColorTty outputOptions handle $ show a -- | Similar to 'pPrintOpt', but the last argument is a string representing a -- data structure that has already been 'show'ed. -- -- >>> let foo = show (1, (2, "hello", 3)) -- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsNoColor foo -- ( 1 -- , -- ( 2 -- , "hello" -- , 3 -- ) -- ) pPrintStringOpt :: MonadIO m => CheckColorTty -> OutputOptions -> String -> m () pPrintStringOpt checkColorTty outputOptions = pHPrintStringOpt checkColorTty outputOptions stdout -- | Similar to 'pPrintStringOpt', but take a 'Handle' to determine where to -- print to. -- -- >>> let foo = show (1, (2, "hello", 3)) -- >>> pHPrintStringOpt CheckColorTty defaultOutputOptionsNoColor stdout foo -- ( 1 -- , -- ( 2 -- , "hello" -- , 3 -- ) -- ) pHPrintStringOpt :: MonadIO m => CheckColorTty -> OutputOptions -> Handle -> String -> m () pHPrintStringOpt checkColorTty outputOptions handle str = do realOutputOpts <- case checkColorTty of CheckColorTty -> hCheckTTY handle outputOptions NoCheckColorTty -> pure outputOptions liftIO $ do renderIO handle $ layoutStringAnsi realOutputOpts str hPutStrLn handle "" -- | Like 'pShow' but takes 'OutputOptions' to change how the -- pretty-printing is done. pShowOpt :: Show a => OutputOptions -> a -> Text pShowOpt outputOptions = pStringOpt outputOptions . show -- | Like 'pString' but takes 'OutputOptions' to change how the -- pretty-printing is done. pStringOpt :: OutputOptions -> String -> Text pStringOpt outputOptions = renderLazy . layoutStringAnsi outputOptions layoutStringAnsi :: OutputOptions -> String -> SimpleDocStream AnsiStyle layoutStringAnsi opts = fmap convertStyle . layoutString opts -- $examples -- -- 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. -- -- __Simple Haskell data type__ -- -- >>> data Foo a = Foo a String Char deriving Show -- -- >>> pPrint $ Foo 3 "hello" 'a' -- Foo 3 "hello" 'a' -- -- __List__ -- -- >>> pPrint $ [1,2,3] -- [ 1 -- , 2 -- , 3 -- ] -- -- __Slightly more complicated list__ -- -- >>> pPrint $ [ Foo [ (), () ] "hello" 'b' ] -- [ Foo -- [ () -- , () -- ] "hello" 'b' -- ] -- -- >>> pPrint $ [ Foo [ "bar", "baz" ] "hello" 'a', Foo [] "bye" 'b' ] -- [ Foo -- [ "bar" -- , "baz" -- ] "hello" 'a' -- , Foo [] "bye" 'b' -- ] -- -- __Record__ -- -- >>> :{ -- data Bar b = Bar -- { barInt :: Int -- , barA :: b -- , barList :: [Foo Double] -- } deriving Show -- :} -- -- >>> pPrint $ Bar 1 [10, 11] [Foo 1.1 "" 'a', Foo 2.2 "hello" 'b'] -- Bar -- { barInt = 1 -- , barA = -- [ 10 -- , 11 -- ] -- , barList = -- [ Foo 1.1 "" 'a' -- , Foo 2.2 "hello" 'b' -- ] -- } -- -- __Newtype__ -- -- >>> newtype Baz = Baz { unBaz :: [String] } deriving Show -- -- >>> pPrint $ Baz ["hello", "bye"] -- Baz -- { unBaz = -- [ "hello" -- , "bye" -- ] -- } -- -- __Newline Rules__ -- -- >>> data Foo = A | B Foo | C [Foo] [Foo] deriving Show -- -- >>> pPrint $ B ( B A ) -- B ( B A ) -- -- >>> pPrint $ B ( B ( B A ) ) -- B -- ( B ( B A ) ) -- -- >>> pPrint $ B ( B ( B ( B A ) ) ) -- B -- ( B -- ( B ( B A ) ) -- ) -- -- >>> pPrint $ B ( C [A, A] [B A, B (B (B A))] ) -- B -- ( C -- [ A -- , A -- ] -- [ B A -- , B -- ( B ( B A ) ) -- ] -- ) -- -- __Laziness__ -- -- >>> take 100 . unpack . pShowNoColor $ [1..] -- "[ 1\n, 2\n, 3\n, 4\n, 5\n, 6\n, 7\n, 8\n, 9\n, 10\n, 11\n, 12\n, 13\n, 14\n, 15\n, 16\n, 17\n, 18\n, 19\n, 20\n, 21\n, 22" -- -- __Unicode__ -- -- >>> pPrint $ Baz ["猫", "犬", "ヤギ"] -- Baz -- { unBaz = -- [ "猫" -- , "犬" -- , "ヤギ" -- ] -- } -- -- __Compactness options__ -- -- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompact = True} "AST [] [Def ((3,1),(5,30)) (Id \"fact'\" \"fact'\") [] (Forall ((3,9),(3,26)) [((Id \"n\" \"n_0\"),KPromote (TyCon (Id \"Nat\" \"Nat\")))])]" -- AST [] -- [ Def -- ( ( 3, 1 ), ( 5, 30 ) ) -- ( Id "fact'" "fact'" ) [] -- ( Forall -- ( ( 3, 9 ), ( 3, 26 ) ) -- [ ( ( Id "n" "n_0" ), KPromote ( TyCon ( Id "Nat" "Nat" ) ) ) ] -- ) -- ] -- -- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompactParens = True} $ B ( C [A, A] [B A, B (B (B A))] ) -- B -- ( C -- [ A -- , A ] -- [ B A -- , B -- ( B ( B A ) ) ] ) -- -- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsCompact = True} $ [("id", 123), ("state", 1), ("pass", 1), ("tested", 100), ("time", 12345)] -- [ -- ( "id", 123 ), -- ( "state", 1 ), -- ( "pass", 1 ), -- ( "tested", 100 ), -- ( "time", 12345 ) -- ] -- -- __Initial indent__ -- -- >>> pPrintOpt CheckColorTty defaultOutputOptionsDarkBg {outputOptionsInitialIndent = 3} $ B ( B ( B ( B A ) ) ) -- B -- ( B -- ( B ( B A ) ) -- ) -- -- __Weird/illegal show instances__ -- -- >>> pPrintString "2019-02-18 20:56:24.265489 UTC" -- 2019-02-18 20:56:24.265489 UTC -- -- >>> pPrintString "a7ed86f7-7f2c-4be5-a760-46a3950c2abf" -- a7ed86f7-7f2c-4be5-a760-46a3950c2abf -- -- >>> pPrintString "192.168.0.1:8000" -- 192.168.0.1:8000 -- -- >>> pPrintString "A @\"type\" 1" -- A @"type" 1 -- -- >>> pPrintString "2+2" -- 2+2 -- -- >>> pPrintString "1.0e-2" -- 1.0e-2 -- -- >>> pPrintString "0x1b" -- 0x1b -- -- __Other__ -- -- Making sure the spacing after a string is correct. -- -- >>> data Foo = Foo String Int deriving Show -- -- >>> 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" -- -- If you don't want non-printable characters to be escaped, take a look at -- 'outputOptionsStringStyle' and 'StringOutputStyle'. pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal.hs0000644000000000000000000000072214314136566021235 0ustar0000000000000000{-| Module : Text.Pretty.Simple.Internal Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -} module Text.Pretty.Simple.Internal ( module X ) where import Text.Pretty.Simple.Internal.Color as X import Text.Pretty.Simple.Internal.ExprParser as X import Text.Pretty.Simple.Internal.Expr as X import Text.Pretty.Simple.Internal.Printer as X pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal/Color.hs0000644000000000000000000000727714314136566022327 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Text.Pretty.Simple.Internal.Color Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -} module Text.Pretty.Simple.Internal.Color where #if __GLASGOW_HASKELL__ < 710 -- We don't need this import for GHC 7.10 as it exports all required functions -- from Prelude import Control.Applicative #endif import Data.Typeable (Typeable) import GHC.Generics (Generic) import Prettyprinter.Render.Terminal (AnsiStyle, Intensity(Dull,Vivid), Color(..)) import qualified Prettyprinter.Render.Terminal as Ansi -- | These options are for colorizing the output of functions like 'pPrint'. -- -- If you don't want to use a color for one of the options, use 'colorNull'. data ColorOptions = ColorOptions { colorQuote :: Style -- ^ Color to use for quote characters (@\"@) around strings. , colorString :: Style -- ^ Color to use for strings. , colorError :: Style -- ^ Color for errors, e.g. unmatched brackets. , colorNum :: Style -- ^ Color to use for numbers. , colorRainbowParens :: [Style] -- ^ A list of colors to use for rainbow parenthesis output. Use -- '[]' if you don't want rainbow parenthesis. Use just a single item if you -- want all the rainbow parenthesis to be colored the same. } deriving (Eq, Generic, Show, Typeable) -- | Default color options for use on a dark background. defaultColorOptionsDarkBg :: ColorOptions defaultColorOptionsDarkBg = ColorOptions { colorQuote = colorBold Vivid White , colorString = colorBold Vivid Blue , colorError = colorBold Vivid Red , colorNum = colorBold Vivid Green , colorRainbowParens = [ colorBold Vivid Magenta , colorBold Vivid Cyan , colorBold Vivid Yellow , color Dull Magenta , color Dull Cyan , color Dull Yellow , colorBold Dull Magenta , colorBold Dull Cyan , colorBold Dull Yellow , color Vivid Magenta , color Vivid Cyan , color Vivid Yellow ] } -- | Default color options for use on a light background. defaultColorOptionsLightBg :: ColorOptions defaultColorOptionsLightBg = ColorOptions { colorQuote = colorBold Vivid Black , colorString = colorBold Vivid Blue , colorError = colorBold Vivid Red , colorNum = colorBold Vivid Green , colorRainbowParens = [ colorBold Vivid Magenta , colorBold Vivid Cyan , color Dull Magenta , color Dull Cyan , colorBold Dull Magenta , colorBold Dull Cyan , color Vivid Magenta , color Vivid Cyan ] } -- | No styling. colorNull :: Style colorNull = Style { styleColor = Nothing , styleBold = False , styleItalic = False , styleUnderlined = False } -- | Ways to style terminal output. data Style = Style { styleColor :: Maybe (Color, Intensity) , styleBold :: Bool , styleItalic :: Bool , styleUnderlined :: Bool } deriving (Eq, Generic, Show, Typeable) color :: Intensity -> Color -> Style color i c = colorNull {styleColor = Just (c, i)} colorBold :: Intensity -> Color -> Style colorBold i c = (color i c) {styleBold = True} convertStyle :: Style -> AnsiStyle convertStyle Style {..} = mconcat [ maybe mempty (uncurry $ flip col) styleColor , if styleBold then Ansi.bold else mempty , if styleItalic then Ansi.italicized else mempty , if styleUnderlined then Ansi.underlined else mempty ] where col = \case Vivid -> Ansi.color Dull -> Ansi.colorDull pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal/Expr.hs0000644000000000000000000000256614314136566022163 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Text.Pretty.Simple.Internal.Expr Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -} module Text.Pretty.Simple.Internal.Expr where #if __GLASGOW_HASKELL__ < 710 -- We don't need this import for GHC 7.10 as it exports all required functions -- from Prelude import Control.Applicative #endif import Data.Data (Data) import Data.Typeable (Typeable) import GHC.Generics (Generic) newtype CommaSeparated a = CommaSeparated { unCommaSeparated :: [a] } deriving (Data, Eq, Generic, Show, Typeable) data Expr = Brackets !(CommaSeparated [Expr]) | Braces !(CommaSeparated [Expr]) | Parens !(CommaSeparated [Expr]) | StringLit !String | CharLit !String | NumberLit !String -- ^ We could store this as a 'Rational', say, instead of a 'String'. -- However, we will never need to use its value for anything. Indeed, the -- only thing we will be doing with it is turning it /back/ into a string -- at some stage, so we might as well cut out the middle man and store it -- directly like this. | Other !String deriving (Data, Eq, Generic, Show, Typeable) pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal/ExprParser.hs0000644000000000000000000001455214314136566023336 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Text.Pretty.Simple.Internal.ExprParser Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -} module Text.Pretty.Simple.Internal.ExprParser where import Text.Pretty.Simple.Internal.Expr (CommaSeparated(..), Expr(..)) import Control.Arrow (first) import Data.Char (isAlpha, isDigit) -- | 'testString1' and 'testString2' are convenient to use in GHCi when playing -- around with how parsing works. testString1 :: String testString1 = "Just [TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}, TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}]" -- | See 'testString1'. testString2 :: String testString2 = "some stuff (hello [\"dia\\x40iahello\", why wh, bye] ) (bye)" expressionParse :: String -> [Expr] expressionParse = fst . parseExprs parseExpr :: String -> (Expr, String) parseExpr ('(':rest) = first (Parens . CommaSeparated) $ parseCSep ')' rest parseExpr ('[':rest) = first (Brackets . CommaSeparated) $ parseCSep ']' rest parseExpr ('{':rest) = first (Braces . CommaSeparated) $ parseCSep '}' rest parseExpr ('"':rest) = first StringLit $ parseStringLit rest parseExpr ('\'':rest) = first CharLit $ parseCharLit rest parseExpr (c:rest) | isDigit c = first NumberLit $ parseNumberLit c rest parseExpr other = first Other $ parseOther other -- | Parse multiple expressions. -- -- >>> parseExprs "Just 'a'" -- ([Other "Just ",CharLit "a"],"") -- -- Handle escaped characters correctly -- -- >>> parseExprs $ "Foo \"hello \\\"world!\"" -- ([Other "Foo ",StringLit "hello \\\"world!"],"") -- >>> parseExprs $ "'\\''" -- ([CharLit "\\'"],"") parseExprs :: String -> ([Expr], String) parseExprs [] = ([], "") parseExprs s@(c:_) | c `elem` (")]}," :: String) = ([], s) | otherwise = let (parsed, rest') = parseExpr s (toParse, rest) = parseExprs rest' in (parsed : toParse, rest) parseCSep :: Char -> String -> ([[Expr]], String) parseCSep _ [] = ([], "") parseCSep end s@(c:cs) | c == end = ([], cs) -- Mismatch condition; if the end does not match, there is a mistake -- Perhaps there should be a Missing constructor for Expr | c `elem` (")]}" :: String) = ([], s) | c == ',' = parseCSep end cs | otherwise = let (parsed, rest') = parseExprs s (toParse, rest) = parseCSep end rest' in (parsed : toParse, rest) -- | Parse string literals until a trailing double quote. -- -- >>> parseStringLit "foobar\" baz" -- ("foobar"," baz") -- -- Keep literal back slashes: -- -- >>> parseStringLit "foobar\\\" baz\" after" -- ("foobar\\\" baz"," after") parseStringLit :: String -> (String, String) parseStringLit [] = ("", "") parseStringLit ('"':rest) = ("", rest) parseStringLit ('\\':c:cs) = ('\\':c:cs', rest) where (cs', rest) = parseStringLit cs parseStringLit (c:cs) = (c:cs', rest) where (cs', rest) = parseStringLit cs -- | Parse character literals until a trailing single quote. -- -- >>> parseCharLit "a' foobar" -- ("a"," foobar") -- -- Keep literal back slashes: -- -- >>> parseCharLit "\\'' hello" -- ("\\'"," hello") parseCharLit :: String -> (String, String) parseCharLit [] = ("", "") parseCharLit ('\'':rest) = ("", rest) parseCharLit ('\\':c:cs) = ('\\':c:cs', rest) where (cs', rest) = parseCharLit cs parseCharLit (c:cs) = (c:cs', rest) where (cs', rest) = parseCharLit cs -- | Parses integers and reals, like @123@ and @45.67@. -- -- To be more precise, any numbers matching the regex @\\d+(\\.\\d+)?@ should -- get parsed by this function. -- -- >>> parseNumberLit '3' "456hello world []" -- ("3456","hello world []") -- >>> parseNumberLit '0' ".12399880 foobar" -- ("0.12399880"," foobar") parseNumberLit :: Char -> String -> (String, String) parseNumberLit firstDigit rest1 = case rest2 of [] -> (firstDigit:remainingDigits, "") '.':rest3 -> let (digitsAfterDot, rest4) = span isDigit rest3 in ((firstDigit : remainingDigits) ++ ('.' : digitsAfterDot), rest4) _ -> (firstDigit:remainingDigits, rest2) where remainingDigits :: String rest2 :: String (remainingDigits, rest2) = span isDigit rest1 -- | This function consumes input, stopping only when it hits a special -- character or a digit. However, if the digit is in the middle of a -- Haskell-style identifier (e.g. @foo123@), then keep going -- anyway. -- -- This is almost the same as the function -- -- > parseOtherSimple = span $ \c -> -- > notElem c ("{[()]}\"," :: String) && not (isDigit c) && (c /= '\'') -- -- except 'parseOther' ignores digits and single quotes that appear in -- Haskell-like identifiers. -- -- >>> parseOther "hello world []" -- ("hello world ","[]") -- >>> parseOther "hello234 world" -- ("hello234 world","") -- >>> parseOther "hello 234 world" -- ("hello ","234 world") -- >>> parseOther "hello{[ 234 world" -- ("hello","{[ 234 world") -- >>> parseOther "H3110 World" -- ("H3110 World","") -- >>> parseOther "Node' (Leaf' 1) (Leaf' 2)" -- ("Node' ","(Leaf' 1) (Leaf' 2)") -- >>> parseOther "I'm One" -- ("I'm One","") -- >>> parseOther "I'm 2" -- ("I'm ","2") parseOther :: String -> (String, String) parseOther = go False where go :: Bool -- ^ in an identifier? -> String -> (String, String) go _ [] = ("", "") go insideIdent cs@(c:cs') | c `elem` ("{[()]}\"," :: String) = ("", cs) | ignoreInIdent c && not insideIdent = ("", cs) | insideIdent = first (c :) (go (isIdentRest c) cs') | otherwise = first (c :) (go (isIdentBegin c) cs') isIdentBegin :: Char -> Bool isIdentBegin '_' = True isIdentBegin c = isAlpha c isIdentRest :: Char -> Bool isIdentRest '_' = True isIdentRest '\'' = True isIdentRest c = isAlpha c || ignoreInIdent c ignoreInIdent :: Char -> Bool ignoreInIdent x = isDigit x || x == '\'' pretty-simple-4.1.2.0/src/Text/Pretty/Simple/Internal/Printer.hs0000644000000000000000000003216014322623346022655 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-| Module : Text.Pretty.Simple.Internal.Printer Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -} module Text.Pretty.Simple.Internal.Printer where -- We don't need these imports for later GHCs as all required functions -- are exported from Prelude #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif #if __GLASGOW_HASKELL__ < 804 import Data.Monoid ((<>)) #endif import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad (join) import Control.Monad.State (MonadState, evalState, modify, gets) import Data.Char (isPrint, ord) import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.Maybe (fromMaybe) import Prettyprinter (indent, line', PageWidth(AvailablePerLine), layoutPageWidth, nest, concatWith, space, Doc, SimpleDocStream, annotate, defaultLayoutOptions, enclose, hcat, layoutSmart, line, unAnnotateS, pretty, group, removeTrailingWhitespace) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Numeric (showHex) import System.IO (Handle, hIsTerminalDevice) import Text.Read (readMaybe) import Text.Pretty.Simple.Internal.Expr (Expr(..), CommaSeparated(CommaSeparated)) import Text.Pretty.Simple.Internal.ExprParser (expressionParse) import Text.Pretty.Simple.Internal.Color (colorNull, Style, ColorOptions(..), defaultColorOptionsDarkBg, defaultColorOptionsLightBg) -- $setup -- >>> import Text.Pretty.Simple (pPrintString, pPrintStringOpt) -- | 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) -- | Control how escaped and non-printable are output for strings. -- -- See 'outputOptionsStringStyle' for what the output looks like with each of -- these options. data StringOutputStyle = Literal -- ^ Output string literals by printing the source characters exactly. -- -- For examples: without this option the printer will insert a newline in -- place of @"\n"@, with this options the printer will output @'\'@ and -- @'n'@. Similarly the exact escape codes used in the input string will be -- replicated, so @"\65"@ will be printed as @"\65"@ and not @"A"@. | EscapeNonPrintable -- ^ Replace non-printable characters with hexadecimal escape sequences. | DoNotEscapeNonPrintable -- ^ Output non-printable characters without modification. deriving (Eq, Generic, Show, Typeable) -- | Data-type wrapping up all the options available when rendering the list -- of 'Output's. data OutputOptions = OutputOptions { outputOptionsIndentAmount :: Int -- ^ Number of spaces to use when indenting. It should probably be either 2 -- or 4. , outputOptionsPageWidth :: Int -- ^ The maximum number of characters to fit on to one line. , outputOptionsCompact :: Bool -- ^ Use less vertical (and more horizontal) space. , outputOptionsCompactParens :: Bool -- ^ Group closing parentheses on to a single line. , outputOptionsInitialIndent :: Int -- ^ Indent the whole output by this amount. , 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. -- , outputOptionsStringStyle :: StringOutputStyle -- ^ Controls how string literals are output. -- -- By default, the pPrint functions escape non-printable characters, but -- print all printable characters: -- -- >>> pPrintString "\"A \\x42 Ä \\xC4 \\x1 \\n\"" -- "A B Ä Ä \x1 -- " -- -- Here, you can see that the character @A@ has been printed as-is. @\x42@ -- has been printed in the non-escaped version, @B@. The non-printable -- character @\x1@ has been printed as @\x1@. Newlines will be removed to -- make the output easier to read. -- -- This corresponds to the 'StringOutputStyle' called 'EscapeNonPrintable'. -- -- (Note that in the above and following examples, the characters have to be -- double-escaped, which makes it somewhat confusing...) -- -- Another output style is 'DoNotEscapeNonPrintable'. This is similar -- to 'EscapeNonPrintable', except that non-printable characters get printed -- out literally to the screen. -- -- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = DoNotEscapeNonPrintable } "\"A \\x42 Ä \\xC4 \\n\"" -- "A B Ä Ä -- " -- -- If you change the above example to contain @\x1@, you can see that it is -- output as a literal, non-escaped character. Newlines are still removed -- for readability. -- -- Another output style is 'Literal'. This just outputs all escape characters. -- -- >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = Literal } "\"A \\x42 Ä \\xC4 \\x1 \\n\"" -- "A \x42 Ä \xC4 \x1 \n" -- -- You can see that all the escape characters get output literally, including -- newline. } deriving (Eq, Generic, Show, Typeable) -- | Default values for 'OutputOptions' when printing to a console with a dark -- background. 'outputOptionsIndentAmount' is 4, and -- 'outputOptionsColorOptions' is 'defaultColorOptionsDarkBg'. defaultOutputOptionsDarkBg :: OutputOptions defaultOutputOptionsDarkBg = defaultOutputOptionsNoColor { outputOptionsColorOptions = Just defaultColorOptionsDarkBg } -- | Default values for 'OutputOptions' when printing to a console with a light -- background. 'outputOptionsIndentAmount' is 4, and -- 'outputOptionsColorOptions' is 'defaultColorOptionsLightBg'. defaultOutputOptionsLightBg :: OutputOptions defaultOutputOptionsLightBg = defaultOutputOptionsNoColor { outputOptionsColorOptions = Just defaultColorOptionsLightBg } -- | Default values for 'OutputOptions' when printing using using ANSI escape -- sequences for color. 'outputOptionsIndentAmount' is 4, and -- 'outputOptionsColorOptions' is 'Nothing'. defaultOutputOptionsNoColor :: OutputOptions defaultOutputOptionsNoColor = OutputOptions { outputOptionsIndentAmount = 4 , outputOptionsPageWidth = 80 , outputOptionsCompact = False , outputOptionsCompactParens = False , outputOptionsInitialIndent = 0 , outputOptionsColorOptions = Nothing , outputOptionsStringStyle = EscapeNonPrintable } -- | 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 -- | Parse a string, and generate an intermediate representation, -- suitable for passing to any /prettyprinter/ backend. -- Used by 'Simple.pString' etc. layoutString :: OutputOptions -> String -> SimpleDocStream Style layoutString opts = annotateStyle opts . layoutStringAbstract opts layoutStringAbstract :: OutputOptions -> String -> SimpleDocStream Annotation layoutStringAbstract opts = removeTrailingWhitespace . layoutSmart defaultLayoutOptions {layoutPageWidth = AvailablePerLine (outputOptionsPageWidth opts) 1} . indent (outputOptionsInitialIndent opts) . prettyExprs' opts . expressionParse -- | Slight adjustment of 'prettyExprs' for the outermost level, -- to avoid indenting everything. prettyExprs' :: OutputOptions -> [Expr] -> Doc Annotation prettyExprs' opts = \case [] -> mempty x : xs -> prettyExpr opts x <> prettyExprs opts xs -- | Construct a 'Doc' from multiple 'Expr's. prettyExprs :: OutputOptions -> [Expr] -> Doc Annotation prettyExprs opts = hcat . map subExpr where subExpr x = let doc = prettyExpr opts x in if isSimple x then -- keep the expression on the current line nest 2 doc else -- put the expression on a new line, indented (unless grouped) nest (outputOptionsIndentAmount opts) $ line' <> doc -- | Construct a 'Doc' from a single 'Expr'. prettyExpr :: OutputOptions -> Expr -> Doc Annotation prettyExpr opts = (if outputOptionsCompact opts then group else id) . \case Brackets xss -> list "[" "]" xss Braces xss -> list "{" "}" xss Parens xss -> list "(" ")" xss StringLit s -> join enclose (annotate Quote "\"") $ annotate String $ pretty $ case outputOptionsStringStyle opts of Literal -> s EscapeNonPrintable -> escapeNonPrintable $ readStr s DoNotEscapeNonPrintable -> readStr s CharLit s -> join enclose (annotate Quote "'") $ annotate String $ pretty s Other s -> pretty s NumberLit n -> annotate Num $ pretty n where readStr :: String -> String readStr s = fromMaybe s . readMaybe $ '"' : s ++ "\"" list :: Doc Annotation -> Doc Annotation -> CommaSeparated [Expr] -> Doc Annotation list open close (CommaSeparated xss) = enclose (annotate Open open) (annotate Close close) $ case xss of [] -> mempty [xs] | all isSimple xs -> space <> hcat (map (prettyExpr opts) xs) <> space _ -> concatWith lineAndCommaSep (map (\xs -> spaceIfNeeded xs <> prettyExprs opts xs) xss) <> if outputOptionsCompactParens opts then space else line where spaceIfNeeded = \case Other (' ' : _) : _ -> mempty _ -> space lineAndCommaSep x y = x <> munless (outputOptionsCompact opts) line' <> annotate Comma "," <> y munless b x = if b then mempty else x -- | Determine whether this expression should be displayed on a single line. isSimple :: Expr -> Bool isSimple = \case Brackets (CommaSeparated xs) -> isListSimple xs Braces (CommaSeparated xs) -> isListSimple xs Parens (CommaSeparated xs) -> isListSimple xs _ -> True where isListSimple = \case [[e]] -> isSimple e _:_ -> False [] -> True -- | Traverse the stream, using a 'Tape' to keep track of the current style. annotateStyle :: OutputOptions -> SimpleDocStream Annotation -> SimpleDocStream Style annotateStyle opts ds = case outputOptionsColorOptions opts of Nothing -> unAnnotateS ds Just ColorOptions {..} -> evalState (traverse style ds) initialTape where style :: MonadState (Tape Style) m => Annotation -> m Style style = \case Open -> modify moveR *> gets tapeHead Close -> gets tapeHead <* modify moveL Comma -> gets tapeHead Quote -> pure colorQuote String -> pure colorString Num -> pure colorNum initialTape = Tape { tapeLeft = streamRepeat colorError , tapeHead = colorError , tapeRight = streamCycle $ fromMaybe (pure colorNull) $ nonEmpty colorRainbowParens } -- | An abstract annotation type, representing the various elements -- we may want to highlight. data Annotation = Open | Close | Comma | Quote | String | Num deriving (Eq, Show) -- | 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 = foldr escape "" -- | 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) -- | A bidirectional Turing-machine tape: -- infinite in both directions, with a head pointing to one element. data Tape a = Tape { tapeLeft :: Stream a -- ^ the side of the 'Tape' left of 'tapeHead' , tapeHead :: a -- ^ the focused element , tapeRight :: Stream a -- ^ the side of the 'Tape' right of 'tapeHead' } deriving Show -- | Move the head left moveL :: Tape a -> Tape a moveL (Tape (l :.. ls) c rs) = Tape ls l (c :.. rs) -- | Move the head right moveR :: Tape a -> Tape a moveR (Tape ls c (r :.. rs)) = Tape (c :.. ls) r rs -- | An infinite list data Stream a = a :.. Stream a deriving Show -- | Analogous to 'repeat' streamRepeat :: t -> Stream t streamRepeat x = x :.. streamRepeat x -- | Analogous to 'cycle' -- While the inferred signature here is more general, -- it would diverge on an empty structure streamCycle :: NonEmpty a -> Stream a streamCycle xs = foldr (:..) (streamCycle xs) xs pretty-simple-4.1.2.0/example/ExampleJSON.hs0000644000000000000000000000352514314136566016752 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- | Copyright : Dennis Gosnell 2017 License : BSD3 Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) Stability : experimental Portability : unknown This is an short example of using 'pString' from "Text.Pretty.Simple" to pretty-print JSON. -} module Main where import Data.Aeson (encode) import Data.Aeson.TH (defaultOptions, deriveJSON) import qualified Data.ByteString.Lazy as LByteString (ByteString, toStrict) import Data.Text as Text (Text, unpack) import Data.Text.Encoding (decodeUtf8) import qualified Data.Text.IO as TextIO (putStrLn) import qualified Data.Text.Lazy as LText (Text) import qualified Data.Text.Lazy.IO as LTextIO (putStrLn) import Text.Pretty.Simple (pString) import Example.Data (Foo, Bar, bar) $(deriveJSON defaultOptions ''Foo) $(deriveJSON defaultOptions ''Bar) main :: IO () main = do putStrLn "\nThe following normal \"Data.Aeson.encode\" output:\n" putLazyByteStringLn $ encode bar putStrLn "\ngets turned into this (using \"Text.Pretty.Simple.pString\"):\n" LTextIO.putStrLn . pString . lazyByteStringToString $ encode bar -- | Convert a 'LByteString.ByteString' to a 'Text.Text' by utf8-encoding it. lazyByteStringToText :: LByteString.ByteString -> Text.Text lazyByteStringToText = decodeUtf8 . LByteString.toStrict -- | Convert a 'LByteString.ByteString' to a 'String' by utf8-encoding it. lazyByteStringToString :: LByteString.ByteString -> String lazyByteStringToString = unpack . lazyByteStringToText -- | Print a 'LByteString.ByteString' to the screen. Similar to 'putStrLn'. putLazyByteStringLn :: LByteString.ByteString -> IO () putLazyByteStringLn = TextIO.putStrLn . lazyByteStringToText -- | Print a 'LText.Text' to the screen. Similar to 'putStrLn'. putLazyTextLn :: LText.Text -> IO () putLazyTextLn = LTextIO.putStrLn pretty-simple-4.1.2.0/example/Example/Data.hs0000644000000000000000000000244314314136566017127 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {- | Module : Example.Data Copyright : Dennis Gosnell 2017 License : BSD3 Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) Stability : experimental Portability : unknown This module contains some data types and values that users can use to play around with pretty-simple. These data types are also use in the two example programs, as well as the benchmark for pretty-simple. Most users should use 'foo' or 'bar'. 'baz' is an extremely large data type, only used in the benchmark. -} module Example.Data where import Data.Data (Data) import Data.Typeable (Typeable) data Foo = Foo { foo1 :: Integer , foo2 :: [String] , foo3 :: Double } deriving (Data, Eq, Read, Show, Typeable) data Bar = Bar { bar1 :: Integer , bar2 :: [Foo] , bar3 :: Double } deriving (Data, Eq, Read, Show, Typeable) data Baz = Baz { baz1 :: Bar , baz2 :: [Baz] } deriving (Data, Eq, Read, Show, Typeable) foo :: Foo foo = Foo 3 fooList 3.3 bar :: Bar bar = Bar 10 (replicate 1 foo) 10.55 bazLevel1 :: Baz bazLevel1 = Baz bar [] bazLevel2 :: Baz bazLevel2 = Baz bar $ replicate 50 bazLevel1 baz :: Baz baz = Baz bar $ replicate 30 bazLevel2 fooList :: [String] fooList = [ "hello" , "goodbye" , "dog" , "cat" , "fox" , "beaver" ] pretty-simple-4.1.2.0/example/Example.hs0000644000000000000000000000103714314136566016254 0ustar0000000000000000 {- | Copyright : Dennis Gosnell 2017 License : BSD3 Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) Stability : experimental Portability : unknown This is an short example of using 'pPrint' from "Text.Pretty.Simple" to pretty-print a Haskell data type. -} module Main where import Text.Pretty.Simple (pPrint) import Example.Data (bar) main :: IO () main = do putStrLn "\nThe following normal \"print\" output:\n" print bar putStrLn "\ngets turned into this (using \"Text.Pretty.Simple.pPrint\"):\n" pPrint bar pretty-simple-4.1.2.0/app/Main.hs0000644000000000000000000000523714314136566014700 0ustar0000000000000000module Main where -- This is a small executable that will pretty-print anything from stdin. -- It can be installed to `~/.local/bin` if you enable the flag `buildexe` like so: -- -- @ -- $ stack install pretty-simple-2.0.1.1 --flag pretty-simple:buildexe -- @ -- -- When you run it, you can paste something you want formatted on stdin, then -- press @Ctrl-D@. It will print the formatted version on stdout: -- -- @ -- $ pretty-simple -- [(Just 3, Just 4)] -- -- ^D -- -- [ -- ( Just 3 -- , Just 4 -- ) -- ] -- @ import Data.Monoid ((<>)) import Data.Text (unpack) import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as LT import Data.Version (showVersion) import Options.Applicative ( Parser, ReadM, execParser, fullDesc, help, helper, info, infoOption , long, option, progDesc, readerError, short, showDefaultWith, str , switch, value) import Paths_pretty_simple (version) import Text.Pretty.Simple ( pStringOpt, OutputOptions , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg , defaultOutputOptionsNoColor , outputOptionsCompact ) data Color = DarkBg | LightBg | NoColor data Args = Args { color :: Color , compact :: Bool } colorReader :: ReadM Color colorReader = do string <- str case string of "dark-bg" -> pure DarkBg "light-bg" -> pure LightBg "no-color" -> pure NoColor x -> readerError $ "Could not parse " <> x <> " as a color." args :: Parser Args args = Args <$> option colorReader ( long "color" <> short 'c' <> help "Select printing color. Available options: dark-bg (default), light-bg, no-color." <> showDefaultWith (const "dark-bg") <> value DarkBg ) <*> switch ( long "compact" <> short 'C' <> help "Compact output" ) versionOption :: Parser (a -> a) versionOption = infoOption (showVersion version) ( long "version" <> short 'V' <> help "Show version" ) main :: IO () main = do args' <- execParser opts input <- T.getContents let output = pStringOpt (getPrintOpt args') $ unpack input LT.putStrLn output where opts = info (helper <*> versionOption <*> args) ( fullDesc <> progDesc "Format Haskell data types with indentation and highlighting" ) getPrintOpt :: Args -> OutputOptions getPrintOpt as = (getColorOpt (color as)) {outputOptionsCompact = compact as} getColorOpt :: Color -> OutputOptions getColorOpt DarkBg = defaultOutputOptionsDarkBg getColorOpt LightBg = defaultOutputOptionsLightBg getColorOpt NoColor = defaultOutputOptionsNoColor pretty-simple-4.1.2.0/test/DocTest.hs0000644000000000000000000000040114314136566015544 0ustar0000000000000000module Main where import Build_doctests (flags, pkgs, module_sources) -- import Data.Foldable (traverse_) import Test.DocTest (doctest) main :: IO () main = do -- traverse_ putStrLn args doctest args where args = flags ++ pkgs ++ module_sources pretty-simple-4.1.2.0/bench/Bench.hs0000644000000000000000000000210514314136566015321 0ustar0000000000000000 module Main where import Data.Monoid ((<>)) import Data.Text.Lazy (Text) import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) import Text.Pretty.Simple (pShow) import Example.Data (foo, bar, baz) main :: IO () main = defaultMain [ bgroup "pShow" [ bench "Foo" $ nf pShow foo , bench "Bar" $ nf pShow bar , bench "Baz" $ nf pShow baz ] , bgroup "recursive deeply-nested data structure" (fmap nestTest [22..25]) ] data ExampleExpr = A | B ExampleExpr | C [ExampleExpr] deriving (Show) nest :: ExampleExpr -> Int -> ExampleExpr nest expr 0 = expr nest expr n = nest (B expr) (n - 1) -- | There was a bug in the pretty-simple code that caused deeply nested data -- structures to have an exponential runtime. Effectively, the runtime doubled -- at level. The following benchmark is to make sure that we don't -- accidentally introduce this exponential runtime again. nestTest :: Int -> Benchmark nestTest n = bench ("level " <> show n) $ nf test n where test :: Int -> Text test = pShow . nest (C [A,A]) pretty-simple-4.1.2.0/CHANGELOG.md0000644000000000000000000001710714322625142014500 0ustar0000000000000000 ## 4.1.2.0 * Fix a problem with the `pHPrint` function incorrectly outputting a trailing newline to stdout, instead of the handle you pass it. [#118](https://github.com/cdepillabout/pretty-simple/pull/118) * Add a [web app](https://cdepillabout.github.io/pretty-simple/) where you can play around with `pretty-simple` in your browser. [#116](https://github.com/cdepillabout/pretty-simple/pull/116). This took a lot of hard work by [@georgefst](https://github.com/georgefst)! ## 4.1.1.0 * Make the pretty-printed output with `outputOptionsCompact` enabled a little more compact. [#110](https://github.com/cdepillabout/pretty-simple/pull/110). Thanks [@juhp](https://github.com/juhp)! * Add a `--compact` / `-C` flag to the `pretty-simple` executable that enables `outputOptionsCompact`. [#111](https://github.com/cdepillabout/pretty-simple/pull/111). Thanks again @juhp! * Add `pTraceWith` and `pTraceShowWith` to `Debug.Pretty.Simple`. [#104](https://github.com/cdepillabout/pretty-simple/pull/104). Thanks [@LeviButcher](https://github.com/LeviButcher)! ## 4.1.0.0 * Fix a regression which arose in 4.0, whereby excess spaces would be inserted for unusual strings like dates and IP addresses. [#105](https://github.com/cdepillabout/pretty-simple/pull/105) * Attach warnings to debugging functions, so that they're easy to find and remove. [#103](https://github.com/cdepillabout/pretty-simple/pull/103) * Some minor improvements to the CLI tool: * Add a `--version`/`-v` flag. [#83](https://github.com/cdepillabout/pretty-simple/pull/83) * Add a trailing newline. [#87](https://github.com/cdepillabout/pretty-simple/pull/87) * Install by default, without requiring a flag. [#94](https://github.com/cdepillabout/pretty-simple/pull/94) ## 4.0.0.0 * Expand `OutputOptions`: * Compactness, including grouping of parentheses. [#72](https://github.com/cdepillabout/pretty-simple/pull/72) * Page width, affecting when lines are grouped if compact output is enabled. [#72](https://github.com/cdepillabout/pretty-simple/pull/72) * Indent whole expression. Useful when using `pretty-simple` for one part of a larger output. [#71](https://github.com/cdepillabout/pretty-simple/pull/71) * Use `Style` type for easier configuration of colour, boldness etc. [#73](https://github.com/cdepillabout/pretty-simple/pull/73) * Significant internal rewrite of printing code, to make use of the [prettyprinter](https://hackage.haskell.org/package/prettyprinter) library. The internal function `layoutString` can be used to integrate with other `prettyprinter` backends, such as [prettyprinter-lucid](https://hackage.haskell.org/package/prettyprinter-lucid) for HTML output. [#67](https://github.com/cdepillabout/pretty-simple/pull/67) ## 3.3.0.0 * Add an output option to print escaped and non-printable characters literally when outputting strings. [#68](https://github.com/cdepillabout/pretty-simple/pull/68) and [#69](https://github.com/cdepillabout/pretty-simple/pull/69) Thanks Joe Hermaszewski ([@expipiplus1](https://github.com/expipiplus1))! ## 3.2.3.0 * Fix a bug that messes up printing identifiers with `'` in the name. Now identifiers like `data Don't = Don't` show up properly. [#65](https://github.com/cdepillabout/pretty-simple/pull/65) Thanks George Thomas ([@georgefst](https://github.com/georgefst))! ## 3.2.2.0 * Remove whitespace from the ends of lines. [#62](https://github.com/cdepillabout/pretty-simple/pull/62) Thanks Gaith Hallak ([@ghallak](https://github.com/ghallak))! ## 3.2.1.0 * Added `pTraceOpt` functions to `Debug.Pretty.Simple`. [#58](https://github.com/cdepillabout/pretty-simple/pull/58) Thanks again [sureyeaah](https://github.com/sureyeaah)! ## 3.2.0.0 * Add support for pretty-printing Haskell character literals. [#57](https://github.com/cdepillabout/pretty-simple/pull/57) Thanks again [sjakobi](https://github.com/sjakobi)! ## 3.1.1.0 * Added a `pPrintString` function for pretty-printing a `String` that is the output of `show`. Implemented in [#54](https://github.com/cdepillabout/pretty-simple/pull/54). Thanks [sureyeaah](https://github.com/sureyeaah)! * Fix build on GHC-7.10.3. [#55](https://github.com/cdepillabout/pretty-simple/pull/55). Thanks [sjakobi](https://github.com/sjakobi). ## 3.1.0.0 * Numbers are now highlighted in green by default. Implemented in [#51](https://github.com/cdepillabout/pretty-simple/pull/51). Thanks [lawrencebell](https://github.com/lawrencebell)! ## 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. Thanks [Andreas](https://github.com/anka-213)! ## 2.2.0.0 * Fixed a [bug](https://github.com/cdepillabout/pretty-simple/pull/33) with a missing space after strings. Thanks again [Andrew](https://github.com/andrew-lei)! * Add a command line flag `--color` to be able to set whether to use colors for a dark background (`--color dark-bg`), a light background (`--color light-bg`), or no color (`--color no-color`). This is from [great work](https://github.com/cdepillabout/pretty-simple/pull/35) by [Andrew](https://github.com/andrew-lei)! * Made parsing/printing lazy - pretty-printing will now output strings continuously as they're read, handling potentially infinite input. ## 2.1.0.1 * Fix a [bug](https://github.com/cdepillabout/pretty-simple/pull/32) where printing deeply nested data structures would take exponential time. Thanks [Andrew](https://github.com/andrew-lei)! ## 2.1.0.0 * Make strings have indentation by default when pretty-printed. See [#26](https://github.com/cdepillabout/pretty-simple/pull/26). Thanks [Milan](https://github.com/Wizek)! ## 2.0.2.1 * Add a small command-line program that will pretty print anything from stdin called `pretty-print`. It can be installed to `~/.local/bin` if you enable the flag `buildexe` like so: ```sh $ stack install pretty-simple-2.0.2.1 --flag pretty-simple:buildexe ``` When you run it, you can paste something you want formatted on stdin, then press Ctrl-D. It will print the formatted version on stdout: ```sh $ pretty-simple [(Just 3, Just 4)] ^D [ ( Just 3 , Just 4 ) ] ``` ## 2.0.2.0 * Fix a [problem](https://github.com/cdepillabout/pretty-simple/pull/20) with the pTraceShow functions not working correctly. ## 2.0.1.0 * Added the `Debug.Pretty.Simple` that exports functions that work like `Debug.Trace`. pretty-simple-4.1.2.0/README.md0000644000000000000000000001602114322624455014146 0ustar0000000000000000 Text.Pretty.Simple ================== [![Build Status](https://github.com/cdepillabout/pretty-simple/workflows/CI/badge.svg)](https://github.com/cdepillabout/pretty-simple/actions) [![Hackage](https://img.shields.io/hackage/v/pretty-simple.svg)](https://hackage.haskell.org/package/pretty-simple) [![Stackage LTS](http://stackage.org/package/pretty-simple/badge/lts)](http://stackage.org/lts/package/pretty-simple) [![Stackage Nightly](http://stackage.org/package/pretty-simple/badge/nightly)](http://stackage.org/nightly/package/pretty-simple) ![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg) `pretty-simple` is a pretty printer for Haskell data types that have a `Show` instance. For example, imagine the following Haskell data types and values: ```haskell data Foo = Foo { foo1 :: Integer , foo2 :: [String] } deriving Show foo :: Foo foo = Foo 3 ["hello", "goodbye"] data Bar = Bar { bar1 :: Double , bar2 :: [Foo] } deriving Show bar :: Bar bar = Bar 10.55 [foo, foo] ``` If you run this in `ghci` and type `print bar`, you'll get output like this: ```haskell > print bar Bar {bar1 = 10.55, bar2 = [Foo {foo1 = 3, foo2 = ["hello","goodbye"]},Foo {foo1 = 3, foo2 = ["hello","goodbye"]}]} ``` This is pretty hard to read. Imagine if there were more fields or it were even more deeply nested. It would be even more difficult to read. `pretty-simple` can be used to print `bar` in an easy-to-read format: ![example screenshot](https://raw.githubusercontent.com/cdepillabout/pretty-simple/master/img/pretty-simple-example-screenshot.png) There's a [web app](https://cdepillabout.github.io/pretty-simple) compiled with GHCJS where you can play around with `pretty-simple` running in your browser. ## Usage `pretty-simple` can be easily used from `ghci` when debugging. When using `stack` to run `ghci`, just append the `--package` flag to the command line to load `pretty-simple`: ```sh $ stack ghci --package pretty-simple ``` Or, with cabal: ```sh $ cabal repl --build-depends pretty-simple ``` Once you get a prompt in `ghci`, you can use `import` to get `pretty-simple`'s [`pPrint`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pPrint) function in scope. ```haskell > import Text.Pretty.Simple (pPrint) ``` You can test out `pPrint` with simple data types like `Maybe` or tuples. ```haskell > pPrint $ Just ("hello", "goodbye") Just ( "hello" , "goodbye" ) ``` ## Features - Easy-to-read - Complex data types are simple to understand. - Color - Prints in color using ANSI escape codes. - It is possible to print without color by using the [`pPrintNoColor`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pPrintNoColor) function. - Rainbow Parentheses - Easy to understand deeply nested data types. - Configurable - Indentation, compactness, colors and more are configurable with the [`pPrintOpt`](https://hackage.haskell.org/package/pretty-simple-1.0.0.6/docs/Text-Pretty-Simple.html#v:pPrintOpt) function. - Fast - No problem pretty-printing data types thousands of lines long. - Works with any data type with a `Show` instance - Some common Haskell data types have a `Show` instance that produces non-valid Haskell code. `pretty-simple` will pretty-print even these data types. ## Why not `(some other package)`? Other pretty-printing packages have some combination of these defects: - No options for printing in color. - No options for changing the amount of indentation - Requires every data type to be an instance of some special typeclass (instead of just `Show`). - Requires all `Show` instances to output valid Haskell code. ## Other Uses ### Pretty-print all GHCi output The `pPrint` function can be used as the default output function in GHCi. All you need to do is run GHCi with a command like one of these: ```sh $ stack ghci --ghci-options "-interactive-print=Text.Pretty.Simple.pPrint" --package pretty-simple ``` ```sh $ cabal repl --repl-options "-interactive-print=Text.Pretty.Simple.pPrint" --build-depends pretty-simple ``` Now, whenever you make GHCi evaluate an expression, GHCi will pretty-print the result using `pPrint`! See [here](https://downloads.haskell.org/%7Eghc/latest/docs/html/users_guide/ghci.html#using-a-custom-interactive-printing-function) for more info on this neat feature in GHCi. ### Pretty-printing JSON `pretty-simple` can be used to pretty-print any `String` that is similar to Haskell data types. The only requirement is that the `String` must correctly use brackets, parenthese, and braces to indicate nesting. For example, the [`pString`](https://hackage.haskell.org/package/pretty-simple/docs/Text-Pretty-Simple.html#v:pString) function can be used to pretty-print JSON. Recall our example from before. ```haskell data Foo = Foo { foo1 :: Integer , foo2 :: [String] } deriving Show foo :: Foo foo = Foo 3 ["hello", "goodbye"] data Bar = Bar { bar1 :: Double , bar2 :: [Foo] } deriving Show bar :: Bar bar = Bar 10.55 [foo, foo] ``` You can use [`aeson`](https://hackage.haskell.org/package/aeson) to turn these data types into JSON. First, you must derive [`ToJSON`](https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:ToJSON) instances for the data types. It is easiest to do this with Template Haskell: ```haskell {-# LANGUAGE TemplateHaskell #-} $(deriveJSON defaultOptions ''Foo) $(deriveJSON defaultOptions ''Bar) ``` If you run this in `ghci` and type `encode bar`, you'll get output like this: ```haskell > import Data.Aeson (encode) > putLazyByteStringLn $ encode bar {"bar1":10.55,"bar2":[{"foo1":3,"foo2":["hello","goodbye"]},{"foo1":3,"foo2":["hello","goodbye"]}]} ``` Just like Haskell's normal `print` output, this is pretty hard to read. `pretty-simple` can be used to pretty-print the JSON-encoded `bar` in an easy-to-read format: ![json example screenshot](https://raw.githubusercontent.com/cdepillabout/pretty-simple/master/img/pretty-simple-json-example-screenshot.png) (You can find the `lazyByteStringToString`, `putLazyByteStringLn`, and `putLazyTextLn` in the [`ExampleJSON.hs`](example/ExampleJSON.hs) file.) ### Pretty-printing from the command line `pretty-simple` includes a command line executable that can be used to pretty-print anything passed in on stdin. It can be installed to `~/.local/bin/` with the following command. ```sh $ stack install pretty-simple ``` When run on the command line, you can paste in the Haskell datatype you want to be formatted, then hit Ctrl-D: ![cli example screenshot](https://raw.githubusercontent.com/cdepillabout/pretty-simple/master/img/pretty-simple-cli-screenshot.png) This is very useful if you accidentally print out a Haskell data type with `print` instead of `pPrint`. ## Contributions Feel free to open an [issue](https://github.com/cdepillabout/pretty-simple/issues) or [PR](https://github.com/cdepillabout/pretty-simple/pulls) for any bugs/problems/suggestions/improvements. ## Maintainers - [@cdepillabout](https://github.com/cdepillabout) - [@georgefst](https://github.com/georgefst) pretty-simple-4.1.2.0/img/pretty-simple-example-screenshot.png0000644000000000000000000003572714314136566022613 0ustar0000000000000000PNG  IHDRR-RrbKGD pHYs  tIME IDATxwx&l@ҤwTG}ņ Ղ`9*xP,@Q*"R @ @@ FzydBP6s]{}2;p癲3""Rb.TDDA*" TDDA*" TDDA*" -[$&6%j3~XȄI(ٺ7͟[imxbb8yfi{ӲUK&NyZ>+1Q~Mm}"D֯K^y `O]HَH/m݊gȰqwwT&55eKWGw{ED*]gФic^yu:k7DOѶLcF1nX+eo|c2 8Ly4bbo>,\%m Ѯ]݋/=p|HCC[ŽO"<-} [K:|C_'&6;ЧooxKeɲEl }Ai6 Ͽ,?X̶ٰgf&wRs>|ݍF!LBC[W؊ moΤi?jC/.믥IƘf|ӷ7s>zzweg"ՍQ1d`f;vn5b0^F9=:1QFLl1 F݀F@@1FLlm[jio[cW WWW >^}zb2Xo~WP8Θ mE_[\!VTbb"yyyxyyU؊ܱ#i1;ةA ;@Oϻ\jժ>Aj2Թ#F 媫wϬb?\KZpt 8߈233=^beer즠mw܊_}}NB1rs 3 HzZ:˗`wYf vL ]pR?//"-fsη}s,]-l!بQ|+/M{GxD[9qd3juü[D$''C˘t+n&"څsaWZNxD[bw9\gkObg_`w tԁG!cpQ, :uO=b ҽcqPkW=0~=#';Cb̗u҉(W Z]_7ld0ec+rfZ;{Ə9 G,gC1塿+bz "%T)kkn} ēKX<ҴWXd)+?#>Ã?ªmvlf,N:ͼ?Ͼ "Ti*t܄6M=2ݏTD:ڋ(HEDjS>hD*" QD%iɝwGZ|zVDbցvm:ҿ y=L&OW=+" RgӉ;}NH6ŊTi!773!jʕ" =/ d2K;3٧h\9TUj''H~kIV1::wFDX":UJq9\r ʕ"1LЫwg4+Wz{{Sǻ}ʕ"g ߷TRD4"`YYY~hrm\)"՝/"RYF"" RQ(HED"" RQTZ5SШxzBt4sӳiކ/.]Gt@ulf=eJ.;h޼9i\3כ߸~yiѢ<L#4c={{M7sOvwƛnmx[nNrssXCCttX]YDZÀA֩S)݇a4mF!Wh6\-_~ucK3eV՟W! cS{YmOx{{r*X%`!sO?ϧ̰CK"elr)򑳳leɲEl }Aiji׾];cۣvhUlF#H_Khhk?:45?(+*TCC[pї}wapC:9u:wKJ\I[Yn%~$$c|އdddhDZիg77ֲLJsѯ Ȼd2#Sp);cv1gJ. L{sߤ0 [nyVS6uwΘ]~Uծm󕞖N^=/5[3glgԩ]_x l6ӤIc3O?WgZLN:v@P@j vYn: P]디T!,_'N>_pt(Hk+O#T|9 U6QT+1ݴYSvuxi&X,N?Qfa [mHW>}`XHN-Gl .. 0(ZM!ZXMj#;LC{ؽ+֡2miid"11LۊFGn.@d$x#4mZfn>{ĂϾ0 ةGA۱آT~ :u䉧tT+1!=-+ͷw}O{6 qɲbyHH8UO=FRR?]Ǒ񸻻ѱSG}ܶ v%j+ Қ#5R28sfZ;{Ə)Ko01 ˳0iôw?׈q_f\򦧥37̓<<6{vw%z sm#|s^۵s7>DmEAZ3ܳyK;%rj{j'E椧gKysT[y|B3}4kޔt֬^ˬ*_>#Ճ 0qaV,_8VjpPӪuwz8tARͻ ̙ji+HҲ%|ޏTDfH>o߾2ihD*""(HED"" RqJ6F1q \u|YmѿxtL (Qwv7no>z(Q"dfd%3Asy3'NҼE3nu:ID#R'_pδnⵙoi oNшjlUD %9E+GD#ʯ2VV/|S/iMV*;Xt7$R =Jhƈ2|9>##&6hѢ}Z͍W^nD]al߹ň?.y>YYY}XUQY[7Q`RbVmٲs?~tc,N.,UDE5Ŭ"zm#  Vq\7$rT.rw/L:M瞽<>|\bcjUDw"++SN3O/j+jfX << 2N ":%<V+̙/" Ru)Nep־h^DD#R(HED""T!V`̒~ɲE4m?A֬^шTDD#R9ˬYIXQvevIff:VD#RHswwc1\=t0AAdffmvf[" RL&oΞp?___K]uhbc8VDRmWbbsoo>ٝӧ8^vɐxxx0KVDA*5F=5 6L'D.wwۊh^;k0m;}zѠA}wFRcL& 93mERc$=@9Lwss#4,|NшTj 0o>xo.GcXHKKڹDmE#Ċk/" J{=ѮF""TDDA*" >&)s75M:r⏤?f5oNxhuiK8r8!W /Gt@ulf=eJӋ#>z8v8+#yݹӥ ;ڿ SLJޙOfLgUo0qF5f4=zඛ}Ru fчfaBye2/2ʪϔ̢o'r 7\Wibjj}={#5%6<ӄÂOІ g$aI(@K;MUd_ mE_:L{Yg#U5(HJiE1*U=-DqOž>'(k;Lwww3n4b{;GpHvWZ7zT QE48$y璖Ƅ{&#uԶ{U>UD5O搕͘IMM-iT YEi|.d aaO;k7atﾐu8^zk7mz'  !4'nnu fFnlUSBT*qi&o,֙ ڶV:'&n奰{dfeߵݻk^~?!XIDATcmK6o=Z՚[i*#`fnnH)))zt-9yC$g*x:ضhj"VRSc堋whsOg2_Ӥ(`L[~T TQ&Kન mmau3˼}l..f7IF# }[ >Bo yy)ʠp鬶^әYY m>>|L2첷O:jh|}ѦͳwB+jD*R̚7^Z!oiVN,mmNXS~juCr煶XIJ`͚lMgqmS%u괤MgOZ[쨴0Dg뇒UH{'AڭQwo_{ ،ɗ6{aXؼf{ 96(hzxnf_yz?2}69%7ݽ>Y_+W9ok ( χ y:3>>xx4 77琚uo[jL.xxR7K'O?ĉumz>Μٍo[f_22}\]=gy 5 GG_g0^^X,i:[ރ՚[f;$#CLO~~nn~><It#>ҏ4"lU"#aԋHݻCHCrrNU.4vBfa-kp%AucRsBj9s*{^F``<{چ(謽d] Nb,[U^mlE/tjj'>>m?ge7ZoJڵH4H˖gCRINƾ}op*Vk.IIuΜ٥ 1RTDJY{.v~Q~ goD#RHEػn*k TDDA*" TDDA*" TDDA*"R]6zR3w=HED.шTDDA*" QT.aAH6h :F"2z2Hk:Dj ]$e&3ī i \7P"8#>+͉kHIdg6,6-QnRTd7ﳏH }z)R鬽)WfD`X0<\=}f7RF"jX }D7v2uMkh$3d_HMRLjTB]})\^:VêNڋ8 ԼT(HEDDA*AZ4HIxнnwtIjlR4:}0%" R'X 9;PHo6(HED""UN60K-i}fZuF""J9ک'HED4"Jݍpɶۙ;goۊT7 )qҵSO\5Ã)_" R1z oa/dffrp>>,|||*34c={߷_x5i71ѫ|{ ʮ[@7{>0 g-5;uLJXW_'++>SrR2Uk0?p]ªYݻԔTڄOښn >BT*3?%e .4U! cS{Y _aZԶlڵo UJebeV~/45 }0wfٟ}TUO]Fz6RT ;L&ޜ=ˡ/{T=ж塸?Y>Lӓv<Kk#-^] e)V)ǚC_y'a_`ӊFUѕW "&6߷mÏ?SemH5"ՃN~p(qqgW2'O|B*ҠA}VU+$"w-7ξ}q5J͙0i )7 ww\M>sʳ0iôw?m>buCVf6cF'55˪cՏFR-gѦ͚;ǒH|s`י]UEe}ҹ뎱:uZUDEA*RbUEF@@@׭<}7hh^xz㏩y"*nZ"ebfU{t䇄m:E4"qFgxzoW! qVz&!]{шTDDA*" QT|`fOjQQQ0uT6lHJJ )))ޮEx7 +ngGpj[ @ߵ>~Jԝ,\hx;v|LڊF""TwnntAACX2Gf|=k7j%%e;͑#_Wrږ BBn˫1K; R):8g4!!?? M˖>Nl촂c_i;^Fsf_߈" F``6mG+U?h^DJ,77 a ݱ!-a&;f+庌m>m JXT߲e,yyg4")'Wwa׮HIN~~&Yȑذj~?k$φ C8vlKڿzm^^*k?g՚G^^ ǎ-cھQsMR#Rs AZhRxh^DD#RHED"" Q(HEjP=[/UEkժ@s<<տ RTD:ݟD.uоLRVZz+#GLжx{&3v=Lsh` KzAǰXhР?} .]mhڵ1d_Ά C,ŭZZfE})m)w^D0HY0,=+ybFRSmG6^a4 %He3kll{\ziaX9q"`9aaOa6Ѫ}Wș bI')鏂n4k6ُ6mzmNԩӒ6mO?ujm϶/JV!Re˟inF޽~~0`3 GhP'_ X%BaaL۠!9Gj Sfa녊^Tlaذsȗl|Cw #fMsl\Ijk 0 ?+mOpрCj }o{5Ç`2HZX,i9a6`22rd$яpJ?ӈTj.VS/"u !! 9Ux UYÕՉJn Q̩{VڄHÆ# FtѢx(6.jRu)8l:ToxBнꪝO\j)i^"i` -[N߿# K%9ycK|Z$%֭8sfTDDOHED"" R*MgfRE})̞HED"a^wuTDD"" RTDD"" RTDD"" RHuITmD4"8TNDD#RTDDA*"" Rx #aXb۠m5|>Q8l2F#yc1tv_H&Ħ2p@uhD*x6'n:D"%i۰LڴDA*R KA* R쏛:D"ڗ>"}2ISHR<\=1aAp` Z?H#\abX0YjY5 ad;y#)7I# R uZsy}X :Ek/ /W/RR \khT"%BH &9tIJmX0>ô›(HE`1,$$:f9C"5$"RJ:F*" QTi:TIhفӾ }шTDDA* ..3xa22-!TDD"" RTDD"" RTDD"" RCѫhD*"R-F"" RTDDJf\4`L $'曐-@D4"uF-_{[ukGm:vӎm}}EDAZ"YY\DDAZO iF>>`6k ĉﯭ@DJݴvmmھ}pDD# b.7t+)5W\a `\HIі " ֬߼<#UDDNiLZ" -OOۿYIj־u?ҢEDA|ۍ _k_Dʄ1n$" Q(HED"" Q(HED"" Q(HEDjNc4hnIENDB`pretty-simple-4.1.2.0/LICENSE0000644000000000000000000000276714314136566013712 0ustar0000000000000000Copyright Dennis Gosnell (c) 2016 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pretty-simple-4.1.2.0/Setup.hs0000644000000000000000000000151614314136566014330 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "pretty-simple-doctest" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow #warning You are configuring this package without cabal-doctest installed. \ The doctests test-suite will not work as a result. \ To fix this, install cabal-doctest before configuring. #endif import Distribution.Simple main :: IO () main = defaultMain #endif pretty-simple-4.1.2.0/pretty-simple.cabal0000644000000000000000000001002114322624116016455 0ustar0000000000000000name: pretty-simple version: 4.1.2.0 synopsis: pretty printer for data types with a 'Show' instance. description: Please see . homepage: https://github.com/cdepillabout/pretty-simple license: BSD3 license-file: LICENSE author: Dennis Gosnell maintainer: cdep.illabout@gmail.com copyright: 2017-2019 Dennis Gosnell category: Text build-type: Custom extra-source-files: CHANGELOG.md , README.md , img/pretty-simple-example-screenshot.png cabal-version: >=1.10 custom-setup setup-depends: base , Cabal >= 1.24 , cabal-doctest >=1.0.2 flag buildexe description: Build an small command line program that pretty-print anything from stdin. default: True flag buildexample description: Build a small example program showing how to use the pPrint function default: False library hs-source-dirs: src exposed-modules: Debug.Pretty.Simple , Text.Pretty.Simple , Text.Pretty.Simple.Internal , Text.Pretty.Simple.Internal.Color , Text.Pretty.Simple.Internal.Expr , Text.Pretty.Simple.Internal.ExprParser , Text.Pretty.Simple.Internal.Printer build-depends: base >= 4.8 && < 5 , containers , mtl >= 2.2 , prettyprinter >= 1.7.0 , prettyprinter-ansi-terminal >= 1.1.2 , text >= 1.2 , transformers >= 0.4 default-language: Haskell2010 ghc-options: -Wall other-extensions: TemplateHaskell executable pretty-simple main-is: Main.hs other-modules: Paths_pretty_simple hs-source-dirs: app build-depends: base , pretty-simple , text , optparse-applicative default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N if flag(buildexe) buildable: True else buildable: False executable pretty-simple-example main-is: Example.hs other-modules: Example.Data hs-source-dirs: example build-depends: base , pretty-simple default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N if flag(buildexample) buildable: True else buildable: False executable pretty-simple-json-example main-is: ExampleJSON.hs other-modules: Example.Data hs-source-dirs: example build-depends: base , aeson , bytestring , pretty-simple , text default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N if flag(buildexample) buildable: True else buildable: False test-suite pretty-simple-doctest type: exitcode-stdio-1.0 main-is: DocTest.hs hs-source-dirs: test build-depends: base , doctest >= 0.13 , Glob , QuickCheck , template-haskell default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N benchmark pretty-simple-bench type: exitcode-stdio-1.0 main-is: Bench.hs other-modules: Example.Data hs-source-dirs: bench , example build-depends: base , criterion , pretty-simple , text default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N source-repository head type: git location: git@github.com:cdepillabout/pretty-simple.git