pretty-simple-3.2.3.0/app/0000755000000000000000000000000013521742153013444 5ustar0000000000000000pretty-simple-3.2.3.0/bench/0000755000000000000000000000000013375121461013743 5ustar0000000000000000pretty-simple-3.2.3.0/example/0000755000000000000000000000000013375121461014317 5ustar0000000000000000pretty-simple-3.2.3.0/example/Example/0000755000000000000000000000000013375121461015712 5ustar0000000000000000pretty-simple-3.2.3.0/img/0000755000000000000000000000000013375121461013440 5ustar0000000000000000pretty-simple-3.2.3.0/src/0000755000000000000000000000000013375121461013453 5ustar0000000000000000pretty-simple-3.2.3.0/src/Debug/0000755000000000000000000000000013375121461014501 5ustar0000000000000000pretty-simple-3.2.3.0/src/Debug/Pretty/0000755000000000000000000000000013606254462015775 5ustar0000000000000000pretty-simple-3.2.3.0/src/Text/0000755000000000000000000000000013375121461014377 5ustar0000000000000000pretty-simple-3.2.3.0/src/Text/Pretty/0000755000000000000000000000000013613216676015676 5ustar0000000000000000pretty-simple-3.2.3.0/src/Text/Pretty/Simple/0000755000000000000000000000000013375121461017117 5ustar0000000000000000pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal/0000755000000000000000000000000013666166531020705 5ustar0000000000000000pretty-simple-3.2.3.0/test/0000755000000000000000000000000013526372524013651 5ustar0000000000000000pretty-simple-3.2.3.0/src/Debug/Pretty/Simple.hs0000644000000000000000000004221713606254462017570 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 -- * 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 -} 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 -} pTrace :: String -> a -> a pTrace = pTraceOpt CheckColorTty defaultOutputOptionsDarkBg {-| Like 'pTrace' but returns the message instead of a third value. @since 2.0.1.0 -} 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 -} 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 -} 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 -} #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 -} #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 -} 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 -} 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 -} 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 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 pTraceMarkerIO :: String -> IO () pTraceMarkerIO = pTraceMarkerOptIO CheckColorTty defaultOutputOptionsDarkBg ------------------------------------------ -- Helpers ------------------------------------------ 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 pStringTTYOpt :: CheckColorTty -> OutputOptions -> String -> Text pStringTTYOpt checkColorTty outputOptions = unsafePerformIO . pStringTTYOptIO checkColorTty outputOptions pShowTTYOptIO :: Show a => CheckColorTty -> OutputOptions -> a -> IO Text pShowTTYOptIO checkColorTty outputOptions = pStringTTYOptIO checkColorTty outputOptions . show pShowTTYOpt :: Show a => CheckColorTty -> OutputOptions -> a -> Text pShowTTYOpt checkColorTty outputOptions = unsafePerformIO . pShowTTYOptIO checkColorTty outputOptions ------------------------------------------ -- Traces forcing color ------------------------------------------ -- | Similar to 'pTrace', but forcing color. pTraceForceColor :: String -> a -> a pTraceForceColor = pTraceOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceId', but forcing color. pTraceIdForceColor :: String -> String pTraceIdForceColor = pTraceIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShow', but forcing color. pTraceShowForceColor :: (Show a) => a -> b -> b pTraceShowForceColor = pTraceShowOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceShowId', but forcing color. pTraceShowIdForceColor :: (Show a) => a -> a pTraceShowIdForceColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceM', but forcing color. #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. #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. pTraceStackForceColor :: String -> a -> a pTraceStackForceColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEvent', but forcing color. pTraceEventForceColor :: String -> a -> a pTraceEventForceColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceEventIO', but forcing color. pTraceEventIOForceColor :: String -> IO () pTraceEventIOForceColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarker', but forcing color. pTraceMarkerForceColor :: String -> a -> a pTraceMarkerForceColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceMarkerIO', but forcing color. pTraceMarkerIOForceColor :: String -> IO () pTraceMarkerIOForceColor = pTraceMarkerOptIO NoCheckColorTty defaultOutputOptionsDarkBg -- | Similar to 'pTraceIO', but forcing color. pTraceIOForceColor :: String -> IO () pTraceIOForceColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsDarkBg ------------------------------------------ -- Traces without color ------------------------------------------ -- | Similar to 'pTrace', but without color. -- -- >>> pTraceNoColor "wow" () -- wow -- () -- -- @since 2.0.2.0 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 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 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 pTraceShowIdNoColor :: (Show a) => a -> a pTraceShowIdNoColor = pTraceShowIdOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceM', but without color. -- -- >>> pTraceMNoColor "wow" -- wow -- -- @since 2.0.2.0 #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 #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 pTraceStackNoColor :: String -> a -> a pTraceStackNoColor = pTraceStackOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEvent', but without color. -- -- @since 2.0.2.0 pTraceEventNoColor :: String -> a -> a pTraceEventNoColor = pTraceEventOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceEventIO', but without color. -- -- @since 2.0.2.0 pTraceEventIONoColor :: String -> IO () pTraceEventIONoColor = pTraceEventOptIO NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceMarker', but without color. -- -- @since 2.0.2.0 pTraceMarkerNoColor :: String -> a -> a pTraceMarkerNoColor = pTraceMarkerOpt NoCheckColorTty defaultOutputOptionsNoColor -- | Similar to 'pTraceMarkerIO', but without color. -- -- @since 2.0.2.0 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 pTraceIONoColor :: String -> IO () pTraceIONoColor = pTraceOptIO NoCheckColorTty defaultOutputOptionsNoColor ------------------------------------------ -- Traces that take options ------------------------------------------ {-| Like 'pTrace' but takes OutputOptions. -} pTraceOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceOpt checkColorTty outputOptions = trace . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceId' but takes OutputOptions. -} pTraceIdOpt :: CheckColorTty -> OutputOptions -> String -> String pTraceIdOpt checkColorTty outputOptions a = pTraceOpt checkColorTty outputOptions a a {-| Like 'pTraceShow' but takes OutputOptions. -} pTraceShowOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> b -> b pTraceShowOpt checkColorTty outputOptions = trace . unpack . pShowTTYOpt checkColorTty outputOptions {-| Like 'pTraceShowId' but takes OutputOptions. -} pTraceShowIdOpt :: (Show a) => CheckColorTty -> OutputOptions -> a -> a pTraceShowIdOpt checkColorTty outputOptions a = trace (unpack $ pShowTTYOpt checkColorTty outputOptions a) a {-| Like 'pTraceIO' but takes OutputOptions. -} pTraceOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceOptIO checkColorTty outputOptions = traceIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions {-| Like 'pTraceM' but takes OutputOptions. -} #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. -} #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. -} pTraceStackOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceStackOpt checkColorTty outputOptions = traceStack . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceEvent' but takes OutputOptions. -} pTraceEventOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceEventOpt checkColorTty outputOptions = traceEvent . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceEventIO' but takes OutputOptions. -} pTraceEventOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceEventOptIO checkColorTty outputOptions = traceEventIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions {-| Like 'pTraceMarker' but takes OutputOptions. -} pTraceMarkerOpt :: CheckColorTty -> OutputOptions -> String -> a -> a pTraceMarkerOpt checkColorTty outputOptions = traceMarker . unpack . pStringTTYOpt checkColorTty outputOptions {-| Like 'pTraceMarkerIO' but takes OutputOptions. -} pTraceMarkerOptIO :: CheckColorTty -> OutputOptions -> String -> IO () pTraceMarkerOptIO checkColorTty outputOptions = traceMarkerIO . unpack <=< pStringTTYOptIO checkColorTty outputOptions pretty-simple-3.2.3.0/src/Text/Pretty/Simple.hs0000644000000000000000000004732413613216676017475 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| 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(..) , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg , defaultOutputOptionsNoColor , CheckColorTty(..) -- * 'ColorOptions' -- $colorOptions , defaultColorOptionsDarkBg , defaultColorOptionsLightBg -- * 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.Foldable (toList) import Data.Text.Lazy (Text) import Data.Text.Lazy.IO as LText import System.IO (Handle, stdout) import Text.Pretty.Simple.Internal (CheckColorTty(..), OutputOptions(..), defaultColorOptionsDarkBg, defaultColorOptionsLightBg, defaultOutputOptionsDarkBg, defaultOutputOptionsLightBg, defaultOutputOptionsNoColor, hCheckTTY, expressionParse, expressionsToOutputs, render) -- $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 $ LText.hPutStrLn handle $ pStringOpt realOutputOpts str -- | 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 = render outputOptions . toList . expressionsToOutputs . expressionParse -- $colorOptions -- -- Additional settings for color options can be found in -- "Text.Pretty.Simple.Internal.Color". -- $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 = -- [ "猫" -- , "犬" -- , "ヤギ" -- ] -- } -- -- __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" pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal.hs0000644000000000000000000000107413375121461021231 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.ExprToOutput as X import Text.Pretty.Simple.Internal.Output as X import Text.Pretty.Simple.Internal.OutputPrinter as X pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal/Color.hs0000644000000000000000000002147013526372524022317 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple.Internal.OutputPrinter 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.Text.Lazy.Builder (Builder, fromString) import Data.Typeable (Typeable) import GHC.Generics (Generic) import System.Console.ANSI (Color(..), ColorIntensity(..), ConsoleIntensity(..), ConsoleLayer(..), SGR(..), setSGRCode) -- | These options are for colorizing the output of functions like 'pPrint'. -- -- For example, if you set 'colorQuote' to something like 'colorVividBlueBold', -- then the quote character (@\"@) will be output as bright blue in bold. -- -- If you don't want to use a color for one of the options, use 'colorNull'. data ColorOptions = ColorOptions { colorQuote :: Builder -- ^ Color to use for quote characters (@\"@) around strings. , colorString :: Builder -- ^ Color to use for strings. , colorError :: Builder -- ^ (currently not used) , colorNum :: Builder -- ^ Color to use for numbers. , colorRainbowParens :: [Builder] -- ^ A list of 'Builder' 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) ------------------------------------ -- Dark background default colors -- ------------------------------------ -- | Default color options for use on a dark background. -- -- 'colorQuote' is 'defaultColorQuoteDarkBg'. 'colorString' is -- 'defaultColorStringDarkBg'. 'colorError' is 'defaultColorErrorDarkBg'. -- 'colorNum' is 'defaultColorNumDarkBg'. 'colorRainbowParens' is -- 'defaultColorRainboxParensDarkBg'. defaultColorOptionsDarkBg :: ColorOptions defaultColorOptionsDarkBg = ColorOptions { colorQuote = defaultColorQuoteDarkBg , colorString = defaultColorStringDarkBg , colorError = defaultColorErrorDarkBg , colorNum = defaultColorNumDarkBg , colorRainbowParens = defaultColorRainbowParensDarkBg } -- | Default color for 'colorQuote' for dark backgrounds. This is -- 'colorVividWhiteBold'. defaultColorQuoteDarkBg :: Builder defaultColorQuoteDarkBg = colorVividWhiteBold -- | Default color for 'colorString' for dark backgrounds. This is -- 'colorVividBlueBold'. defaultColorStringDarkBg :: Builder defaultColorStringDarkBg = colorVividBlueBold -- | Default color for 'colorError' for dark backgrounds. This is -- 'colorVividRedBold'. defaultColorErrorDarkBg :: Builder defaultColorErrorDarkBg = colorVividRedBold -- | Default color for 'colorNum' for dark backgrounds. This is -- 'colorVividGreenBold'. defaultColorNumDarkBg :: Builder defaultColorNumDarkBg = colorVividGreenBold -- | Default colors for 'colorRainbowParens' for dark backgrounds. defaultColorRainbowParensDarkBg :: [Builder] defaultColorRainbowParensDarkBg = [ colorVividMagentaBold , colorVividCyanBold , colorVividYellowBold , colorDullMagenta , colorDullCyan , colorDullYellow , colorDullMagentaBold , colorDullCyanBold , colorDullYellowBold , colorVividMagenta , colorVividCyan , colorVividYellow ] ------------------------------------- -- Light background default colors -- ------------------------------------- -- | Default color options for use on a light background. -- -- 'colorQuote' is 'defaultColorQuoteLightBg'. 'colorString' is -- 'defaultColorStringLightBg'. 'colorError' is 'defaultColorErrorLightBg'. -- 'colorNum' is 'defaultColorNumLightBg'. 'colorRainbowParens' is -- 'defaultColorRainboxParensLightBg'. defaultColorOptionsLightBg :: ColorOptions defaultColorOptionsLightBg = ColorOptions { colorQuote = defaultColorQuoteLightBg , colorString = defaultColorStringLightBg , colorError = defaultColorErrorLightBg , colorNum = defaultColorNumLightBg , colorRainbowParens = defaultColorRainbowParensLightBg } -- | Default color for 'colorQuote' for light backgrounds. This is -- 'colorVividWhiteBold'. defaultColorQuoteLightBg :: Builder defaultColorQuoteLightBg = colorVividBlackBold -- | Default color for 'colorString' for light backgrounds. This is -- 'colorVividBlueBold'. defaultColorStringLightBg :: Builder defaultColorStringLightBg = colorVividBlueBold -- | Default color for 'colorError' for light backgrounds. This is -- 'colorVividRedBold'. defaultColorErrorLightBg :: Builder defaultColorErrorLightBg = colorVividRedBold -- | Default color for 'colorNum' for light backgrounds. This is -- 'colorVividGreenBold'. defaultColorNumLightBg :: Builder defaultColorNumLightBg = colorVividGreenBold -- | Default colors for 'colorRainbowParens' for light backgrounds. defaultColorRainbowParensLightBg :: [Builder] defaultColorRainbowParensLightBg = [ colorVividMagentaBold , colorVividCyanBold , colorDullMagenta , colorDullCyan , colorDullMagentaBold , colorDullCyanBold , colorVividMagenta , colorVividCyan ] ----------------------- -- Vivid Bold Colors -- ----------------------- colorVividBlackBold :: Builder colorVividBlackBold = colorBold `mappend` colorVividBlack colorVividBlueBold :: Builder colorVividBlueBold = colorBold `mappend` colorVividBlue colorVividCyanBold :: Builder colorVividCyanBold = colorBold `mappend` colorVividCyan colorVividGreenBold :: Builder colorVividGreenBold = colorBold `mappend` colorVividGreen colorVividMagentaBold :: Builder colorVividMagentaBold = colorBold `mappend` colorVividMagenta colorVividRedBold :: Builder colorVividRedBold = colorBold `mappend` colorVividRed colorVividWhiteBold :: Builder colorVividWhiteBold = colorBold `mappend` colorVividWhite colorVividYellowBold :: Builder colorVividYellowBold = colorBold `mappend` colorVividYellow ----------------------- -- Dull Bold Colors -- ----------------------- colorDullBlackBold :: Builder colorDullBlackBold = colorBold `mappend` colorDullBlack colorDullBlueBold :: Builder colorDullBlueBold = colorBold `mappend` colorDullBlue colorDullCyanBold :: Builder colorDullCyanBold = colorBold `mappend` colorDullCyan colorDullGreenBold :: Builder colorDullGreenBold = colorBold `mappend` colorDullGreen colorDullMagentaBold :: Builder colorDullMagentaBold = colorBold `mappend` colorDullMagenta colorDullRedBold :: Builder colorDullRedBold = colorBold `mappend` colorDullRed colorDullWhiteBold :: Builder colorDullWhiteBold = colorBold `mappend` colorDullWhite colorDullYellowBold :: Builder colorDullYellowBold = colorBold `mappend` colorDullYellow ------------------ -- Vivid Colors -- ------------------ colorVividBlack :: Builder colorVividBlack = colorHelper Vivid Black colorVividBlue :: Builder colorVividBlue = colorHelper Vivid Blue colorVividCyan :: Builder colorVividCyan = colorHelper Vivid Cyan colorVividGreen :: Builder colorVividGreen = colorHelper Vivid Green colorVividMagenta :: Builder colorVividMagenta = colorHelper Vivid Magenta colorVividRed :: Builder colorVividRed = colorHelper Vivid Red colorVividWhite :: Builder colorVividWhite = colorHelper Vivid White colorVividYellow :: Builder colorVividYellow = colorHelper Vivid Yellow ------------------ -- Dull Colors -- ------------------ colorDullBlack :: Builder colorDullBlack = colorHelper Dull Black colorDullBlue :: Builder colorDullBlue = colorHelper Dull Blue colorDullCyan :: Builder colorDullCyan = colorHelper Dull Cyan colorDullGreen :: Builder colorDullGreen = colorHelper Dull Green colorDullMagenta :: Builder colorDullMagenta = colorHelper Dull Magenta colorDullRed :: Builder colorDullRed = colorHelper Dull Red colorDullWhite :: Builder colorDullWhite = colorHelper Dull White colorDullYellow :: Builder colorDullYellow = colorHelper Dull Yellow -------------------- -- Special Colors -- -------------------- -- | Change the intensity to 'BoldIntensity'. colorBold :: Builder colorBold = setSGRCodeBuilder [SetConsoleIntensity BoldIntensity] -- | 'Reset' the console color back to normal. colorReset :: Builder colorReset = setSGRCodeBuilder [Reset] -- | Empty string. colorNull :: Builder colorNull = "" ------------- -- Helpers -- ------------- -- | Helper for creating a 'Builder' for an ANSI escape sequence color based on -- a 'ColorIntensity' and a 'Color'. colorHelper :: ColorIntensity -> Color -> Builder colorHelper colorIntensity color = setSGRCodeBuilder [SetColor Foreground colorIntensity color] -- | Convert a list of 'SGR' to a 'Builder'. setSGRCodeBuilder :: [SGR] -> Builder setSGRCodeBuilder = fromString . setSGRCode pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal/Expr.hs0000644000000000000000000000262713577341425022164 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| 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-3.2.3.0/src/Text/Pretty/Simple/Internal/ExprParser.hs0000644000000000000000000001471613666166531023345 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| 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-3.2.3.0/src/Text/Pretty/Simple/Internal/ExprToOutput.hs0000644000000000000000000002361113577341425023704 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| 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.ExprToOutput 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 (when) import Control.Monad.State (MonadState, evalState, gets, modify) import Data.Data (Data) import Data.Monoid ((<>)) import Data.List (intersperse) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Text.Pretty.Simple.Internal.Expr (CommaSeparated(..), Expr(..)) import Text.Pretty.Simple.Internal.Output (NestLevel(..), Output(..), OutputType(..), unNestLevel) -- $setup -- >>> :set -XOverloadedStrings -- >>> import Control.Monad.State (State) -- >>> :{ -- let test :: PrinterState -> State PrinterState [Output] -> [Output] -- test initState state = evalState state initState -- testInit :: State PrinterState [Output] -> [Output] -- testInit = test initPrinterState -- :} -- | Newtype around 'Int' to represent a line number. After a newline, the -- 'LineNum' will increase by 1. newtype LineNum = LineNum { unLineNum :: Int } deriving (Data, Eq, Generic, Num, Ord, Read, Show, Typeable) data PrinterState = PrinterState { currLine :: {-# UNPACK #-} !LineNum , nestLevel :: {-# UNPACK #-} !NestLevel } deriving (Eq, Data, Generic, Show, Typeable) -- | Smart-constructor for 'PrinterState'. printerState :: LineNum -> NestLevel -> PrinterState printerState currLineNum nestNum = PrinterState { currLine = currLineNum , nestLevel = nestNum } addOutput :: MonadState PrinterState m => OutputType -> m Output addOutput outputType = do nest <- gets nestLevel return $ Output nest outputType addOutputs :: MonadState PrinterState m => [OutputType] -> m [Output] addOutputs outputTypes = do nest <- gets nestLevel return $ Output nest <$> outputTypes initPrinterState :: PrinterState initPrinterState = printerState 0 (-1) -- | Print a surrounding expression (like @\[\]@ or @\{\}@ or @\(\)@). -- -- If the 'CommaSeparated' expressions are empty, just print the start and end -- markers. -- -- >>> testInit $ putSurroundExpr "[" "]" (CommaSeparated []) -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBracket},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBracket}] -- -- If there is only one expression, and it will print out on one line, then -- just print everything all on one line, with spaces around the expressions. -- -- >>> testInit $ putSurroundExpr "{" "}" (CommaSeparated [[Other "hello"]]) -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBrace},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "hello"},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBrace}] -- -- If there is only one expression, but it will print out on multiple lines, -- then go to newline and print out on multiple lines. -- -- >>> 1 + 1 -- TODO: Example here. -- 2 -- -- If there are multiple expressions, then first go to a newline. -- Print out on multiple lines. -- -- >>> 1 + 1 -- TODO: Example here. -- 2 putSurroundExpr :: MonadState PrinterState m => OutputType -> OutputType -> CommaSeparated [Expr] -- ^ comma separated inner expression. -> m [Output] putSurroundExpr startOutputType endOutputType (CommaSeparated []) = do addToNestLevel 1 outputs <- addOutputs [startOutputType, endOutputType] addToNestLevel (-1) return outputs putSurroundExpr startOutputType endOutputType (CommaSeparated [exprs]) = do addToNestLevel 1 let (thisLayerMulti, nextLayerMulti) = thisAndNextMulti exprs maybeNL <- if thisLayerMulti then newLineAndDoIndent else return [] start <- addOutputs [startOutputType, OutputOther " "] middle <- concat <$> traverse putExpression exprs nlOrSpace <- if nextLayerMulti then newLineAndDoIndent else (:[]) <$> (addOutput $ OutputOther " ") end <- addOutput endOutputType addToNestLevel (-1) return $ maybeNL <> start <> middle <> nlOrSpace <> [end] where thisAndNextMulti = (\(a,b) -> (or a, or b)) . unzip . map isMultiLine isMultiLine (Brackets commaSeparated) = isMultiLine' commaSeparated isMultiLine (Braces commaSeparated) = isMultiLine' commaSeparated isMultiLine (Parens commaSeparated) = isMultiLine' commaSeparated isMultiLine _ = (False, False) isMultiLine' (CommaSeparated []) = (False, False) isMultiLine' (CommaSeparated [es]) = (True, fst $ thisAndNextMulti es) isMultiLine' _ = (True, True) putSurroundExpr startOutputType endOutputType commaSeparated = do addToNestLevel 1 nl <- newLineAndDoIndent start <- addOutputs [startOutputType, OutputOther " "] middle <- putCommaSep commaSeparated nl2 <- newLineAndDoIndent end <- addOutput endOutputType addToNestLevel (-1) endSpace <- addOutput $ OutputOther " " return $ nl <> start <> middle <> nl2 <> [end, endSpace] putCommaSep :: forall m. MonadState PrinterState m => CommaSeparated [Expr] -> m [Output] putCommaSep (CommaSeparated expressionsList) = concat <$> (sequence $ intersperse putComma evaledExpressionList) where evaledExpressionList :: [m [Output]] evaledExpressionList = (concat <.> traverse putExpression) <$> expressionsList (f <.> g) x = f <$> g x putComma :: MonadState PrinterState m => m [Output] putComma = do nl <- newLineAndDoIndent outputs <- addOutputs [OutputComma, OutputOther " "] return $ nl <> outputs doIndent :: MonadState PrinterState m => m [Output] doIndent = do nest <- gets $ unNestLevel . nestLevel addOutputs $ replicate nest OutputIndent newLine :: MonadState PrinterState m => m Output newLine = do output <- addOutput OutputNewLine addToCurrentLine 1 return output newLineAndDoIndent :: MonadState PrinterState m => m [Output] newLineAndDoIndent = do nl <- newLine indent <- doIndent return $ nl:indent addToNestLevel :: MonadState PrinterState m => NestLevel -> m () addToNestLevel diff = modify (\printState -> printState {nestLevel = nestLevel printState + diff}) addToCurrentLine :: MonadState PrinterState m => LineNum -> m () addToCurrentLine diff = modify (\printState -> printState {currLine = currLine printState + diff}) putExpression :: MonadState PrinterState m => Expr -> m [Output] putExpression (Brackets commaSeparated) = putSurroundExpr OutputOpenBracket OutputCloseBracket commaSeparated putExpression (Braces commaSeparated) = putSurroundExpr OutputOpenBrace OutputCloseBrace commaSeparated putExpression (Parens commaSeparated) = putSurroundExpr OutputOpenParen OutputCloseParen commaSeparated putExpression (StringLit string) = do nest <- gets nestLevel when (nest < 0) $ addToNestLevel 1 addOutputs [OutputStringLit string, OutputOther " "] putExpression (CharLit string) = do nest <- gets nestLevel when (nest < 0) $ addToNestLevel 1 addOutputs [OutputCharLit string, OutputOther " "] putExpression (NumberLit integer) = do nest <- gets nestLevel when (nest < 0) $ addToNestLevel 1 (:[]) <$> (addOutput $ OutputNumberLit integer) putExpression (Other string) = do nest <- gets nestLevel when (nest < 0) $ addToNestLevel 1 (:[]) <$> (addOutput $ OutputOther string) runPrinterState :: PrinterState -> [Expr] -> [Output] runPrinterState initState expressions = concat $ evalState (traverse putExpression expressions) initState runInitPrinterState :: [Expr] -> [Output] runInitPrinterState = runPrinterState initPrinterState expressionsToOutputs :: [Expr] -> [Output] expressionsToOutputs = runInitPrinterState . modificationsExprList -- | A function that performs optimizations and modifications to a list of -- input 'Expr's. -- -- An sample of an optimization is 'removeEmptyInnerCommaSeparatedExprList' -- which removes empty inner lists in a 'CommaSeparated' value. modificationsExprList :: [Expr] -> [Expr] modificationsExprList = removeEmptyInnerCommaSeparatedExprList removeEmptyInnerCommaSeparatedExprList :: [Expr] -> [Expr] removeEmptyInnerCommaSeparatedExprList = fmap removeEmptyInnerCommaSeparatedExpr removeEmptyInnerCommaSeparatedExpr :: Expr -> Expr removeEmptyInnerCommaSeparatedExpr (Brackets commaSeparated) = Brackets $ removeEmptyInnerCommaSeparated commaSeparated removeEmptyInnerCommaSeparatedExpr (Braces commaSeparated) = Braces $ removeEmptyInnerCommaSeparated commaSeparated removeEmptyInnerCommaSeparatedExpr (Parens commaSeparated) = Parens $ removeEmptyInnerCommaSeparated commaSeparated removeEmptyInnerCommaSeparatedExpr other = other removeEmptyInnerCommaSeparated :: CommaSeparated [Expr] -> CommaSeparated [Expr] removeEmptyInnerCommaSeparated (CommaSeparated commaSeps) = CommaSeparated . fmap removeEmptyInnerCommaSeparatedExprList $ removeEmptyList commaSeps -- | Remove empty lists from a list of lists. -- -- >>> removeEmptyList [[1,2,3], [], [4,5]] -- [[1,2,3],[4,5]] -- -- >>> removeEmptyList [[]] -- [] -- -- >>> removeEmptyList [[1]] -- [[1]] -- -- >>> removeEmptyList [[1,2], [10,20], [100,200]] -- [[1,2],[10,20],[100,200]] removeEmptyList :: forall a . [[a]] -> [[a]] removeEmptyList = foldr f [] where f :: [a] -> [[a]] -> [[a]] f [] accum = accum f a accum = [a] <> accum pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal/Output.hs0000644000000000000000000000654513577341425022551 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module : Text.Pretty.Simple.Internal.Output 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.Output 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.String (IsString, fromString) import Data.Typeable (Typeable) import GHC.Generics (Generic) -- | Datatype representing how much something is nested. -- -- For example, a 'NestLevel' of 0 would mean an 'Output' token -- is at the very highest level, not in any braces. -- -- A 'NestLevel' of 1 would mean that an 'Output' token is in one single pair -- of @\{@ and @\}@, or @\[@ and @\], or @\(@ and @\)@. -- -- A 'NestLevel' of 2 would mean that an 'Output' token is two levels of -- brackets, etc. newtype NestLevel = NestLevel { unNestLevel :: Int } deriving (Data, Eq, Generic, Num, Ord, Read, Show, Typeable) -- | These are the output tokens that we will be printing to the screen. data OutputType = OutputCloseBrace -- ^ This represents the @\}@ character. | OutputCloseBracket -- ^ This represents the @\]@ character. | OutputCloseParen -- ^ This represents the @\)@ character. | OutputComma -- ^ This represents the @\,@ character. | OutputIndent -- ^ This represents an indentation. | OutputNewLine -- ^ This represents the @\\n@ character. | OutputOpenBrace -- ^ This represents the @\{@ character. | OutputOpenBracket -- ^ This represents the @\[@ character. | OutputOpenParen -- ^ This represents the @\(@ character. | OutputOther !String -- ^ This represents some collection of characters that don\'t fit into any -- of the other tokens. | OutputStringLit !String -- ^ This represents a string literal. For instance, @\"foobar\"@. | OutputCharLit !String -- ^ This represents a char literal. For example, @'x'@ or @'\b'@ | OutputNumberLit !String -- ^ This represents a numeric literal. For example, @12345@ or @3.14159@. deriving (Data, Eq, Generic, Read, Show, Typeable) -- | 'IsString' (and 'fromString') should generally only be used in tests and -- debugging. There is no way to represent 'OutputIndent', 'OutputNumberLit' -- and 'OutputStringLit'. instance IsString OutputType where fromString :: String -> OutputType fromString "}" = OutputCloseBrace fromString "]" = OutputCloseBracket fromString ")" = OutputCloseParen fromString "," = OutputComma fromString "\n" = OutputNewLine fromString "{" = OutputOpenBrace fromString "[" = OutputOpenBracket fromString "(" = OutputOpenParen fromString string = OutputOther string -- | An 'OutputType' token together with a 'NestLevel'. Basically, each -- 'OutputType' keeps track of its own 'NestLevel'. data Output = Output { outputNestLevel :: {-# UNPACK #-} !NestLevel , outputOutputType :: !OutputType } deriving (Data, Eq, Generic, Read, Show, Typeable) pretty-simple-3.2.3.0/src/Text/Pretty/Simple/Internal/OutputPrinter.hs0000644000000000000000000003345713613216676024117 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Text.Pretty.Simple.Internal.OutputPrinter 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.OutputPrinter 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 Control.Monad.Reader (MonadReader(ask, reader), runReader) import Data.Char (isPrint, isSpace, ord) import Numeric (showHex) import Data.Foldable (fold) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import Data.Typeable (Typeable) import Data.List (dropWhileEnd, intercalate) import Data.Maybe (fromMaybe) import Text.Read (readMaybe) import GHC.Generics (Generic) import System.IO (Handle, hIsTerminalDevice) import Text.Pretty.Simple.Internal.Color (ColorOptions(..), colorReset, defaultColorOptionsDarkBg, defaultColorOptionsLightBg) import Text.Pretty.Simple.Internal.Output (NestLevel(..), Output(..), OutputType(..)) -- | Determines whether pretty-simple should check if the output 'Handle' is a -- TTY device. Normally, users only want to print in color if the output -- 'Handle' is a TTY device. data CheckColorTty = CheckColorTty -- ^ Check if the output 'Handle' is a TTY device. If the output 'Handle' is -- a TTY device, determine whether to print in color based on -- 'outputOptionsColorOptions'. If not, then set 'outputOptionsColorOptions' -- to 'Nothing' so the output does not get colorized. | NoCheckColorTty -- ^ Don't check if the output 'Handle' is a TTY device. Determine whether to -- colorize the output based solely on the value of -- 'outputOptionsColorOptions'. deriving (Eq, Generic, Show, Typeable) -- | Data-type wrapping up all the options available when rendering the list -- of 'Output's. data OutputOptions = OutputOptions { outputOptionsIndentAmount :: Int -- ^ Number of spaces to use when indenting. It should probably be either 2 -- or 4. , outputOptionsColorOptions :: Maybe ColorOptions -- ^ If this is 'Nothing', then don't colorize the output. If this is -- @'Just' colorOptions@, then use @colorOptions@ to colorize the output. -- , outputOptionsEscapeNonPrintable :: Bool -- ^ Whether to replace non-printable characters with hexadecimal escape -- sequences. } deriving (Eq, Generic, Show, Typeable) -- | Default values for 'OutputOptions' when printing to a console with a dark -- background. 'outputOptionsIndentAmount' is 4, and -- 'outputOptionsColorOptions' is 'defaultColorOptionsDarkBg'. defaultOutputOptionsDarkBg :: OutputOptions defaultOutputOptionsDarkBg = OutputOptions { outputOptionsIndentAmount = 4 , outputOptionsColorOptions = Just defaultColorOptionsDarkBg , outputOptionsEscapeNonPrintable = True } -- | Default values for 'OutputOptions' when printing to a console with a light -- background. 'outputOptionsIndentAmount' is 4, and -- 'outputOptionsColorOptions' is 'defaultColorOptionsLightBg'. defaultOutputOptionsLightBg :: OutputOptions defaultOutputOptionsLightBg = OutputOptions { outputOptionsIndentAmount = 4 , outputOptionsColorOptions = Just defaultColorOptionsLightBg , outputOptionsEscapeNonPrintable = True } -- | 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 , outputOptionsColorOptions = Nothing , outputOptionsEscapeNonPrintable = True } -- | Given 'OutputOptions', disable colorful output if the given handle -- is not connected to a TTY. hCheckTTY :: MonadIO m => Handle -> OutputOptions -> m OutputOptions hCheckTTY h options = liftIO $ conv <$> tty where conv :: Bool -> OutputOptions conv True = options conv False = options { outputOptionsColorOptions = Nothing } tty :: IO Bool tty = hIsTerminalDevice h -- | Given 'OutputOptions' and a list of 'Output', turn the 'Output' into a -- lazy 'Text'. render :: OutputOptions -> [Output] -> Text render options = toLazyText . foldr foldFunc "" . modificationsOutputList where foldFunc :: Output -> Builder -> Builder foldFunc output accum = runReader (renderOutput output) options `mappend` accum -- | Render a single 'Output' as a 'Builder', using the options specified in -- the 'OutputOptions'. renderOutput :: MonadReader OutputOptions m => Output -> m Builder renderOutput (Output nest OutputCloseBrace) = renderRainbowParenFor nest "}" renderOutput (Output nest OutputCloseBracket) = renderRainbowParenFor nest "]" renderOutput (Output nest OutputCloseParen) = renderRainbowParenFor nest ")" renderOutput (Output nest OutputComma) = renderRainbowParenFor nest "," renderOutput (Output _ OutputIndent) = do indentSpaces <- reader outputOptionsIndentAmount pure . mconcat $ replicate indentSpaces " " renderOutput (Output _ OutputNewLine) = pure "\n" renderOutput (Output nest OutputOpenBrace) = renderRainbowParenFor nest "{" renderOutput (Output nest OutputOpenBracket) = renderRainbowParenFor nest "[" renderOutput (Output nest OutputOpenParen) = renderRainbowParenFor nest "(" renderOutput (Output _ (OutputOther string)) = do indentSpaces <- reader outputOptionsIndentAmount let spaces = replicate (indentSpaces + 2) ' ' -- TODO: This probably shouldn't be a string to begin with. pure $ fromString $ indentSubsequentLinesWith spaces string renderOutput (Output _ (OutputNumberLit number)) = do sequenceFold [ useColorNum , pure (fromString number) , useColorReset ] renderOutput (Output _ (OutputStringLit string)) = do options <- ask sequenceFold [ useColorQuote , pure "\"" , useColorReset , useColorString -- TODO: This probably shouldn't be a string to begin with. , pure (fromString (process options string)) , useColorReset , useColorQuote , pure "\"" , useColorReset ] where process :: OutputOptions -> String -> String process opts = if outputOptionsEscapeNonPrintable opts then indentSubsequentLinesWith spaces . escapeNonPrintable . readStr else indentSubsequentLinesWith spaces . readStr where spaces :: String spaces = replicate (indentSpaces + 2) ' ' indentSpaces :: Int indentSpaces = outputOptionsIndentAmount opts readStr :: String -> String readStr s = fromMaybe s . readMaybe $ '"':s ++ "\"" renderOutput (Output _ (OutputCharLit string)) = do sequenceFold [ useColorQuote , pure "'" , useColorReset , useColorString , pure (fromString string) , useColorReset , useColorQuote , pure "'" , useColorReset ] -- | Replace non-printable characters with hex escape sequences. -- -- >>> escapeNonPrintable "\x1\x2" -- "\\x1\\x2" -- -- Newlines will not be escaped. -- -- >>> escapeNonPrintable "hello\nworld" -- "hello\nworld" -- -- Printable characters will not be escaped. -- -- >>> escapeNonPrintable "h\101llo" -- "hello" escapeNonPrintable :: String -> String escapeNonPrintable input = foldr escape "" input -- Replace an unprintable character except a newline -- with a hex escape sequence. escape :: Char -> ShowS escape c | isPrint c || c == '\n' = (c:) | otherwise = ('\\':) . ('x':) . showHex (ord c) -- | -- >>> indentSubsequentLinesWith " " "aaa" -- "aaa" -- -- >>> indentSubsequentLinesWith " " "aaa\nbbb\nccc" -- "aaa\n bbb\n ccc" -- -- >>> indentSubsequentLinesWith " " "" -- "" indentSubsequentLinesWith :: String -> String -> String indentSubsequentLinesWith indent input = intercalate "\n" $ (start ++) $ map (indent ++) $ end where (start, end) = splitAt 1 $ lines input -- | Produce a 'Builder' corresponding to the ANSI escape sequence for the -- color for the @\"@, based on whether or not 'outputOptionsColorOptions' is -- 'Just' or 'Nothing', and the value of 'colorQuote'. useColorQuote :: forall m. MonadReader OutputOptions m => m Builder useColorQuote = maybe "" colorQuote <$> reader outputOptionsColorOptions -- | Produce a 'Builder' corresponding to the ANSI escape sequence for the -- color for the characters of a string, based on whether or not -- 'outputOptionsColorOptions' is 'Just' or 'Nothing', and the value of -- 'colorString'. useColorString :: forall m. MonadReader OutputOptions m => m Builder useColorString = maybe "" colorString <$> reader outputOptionsColorOptions useColorError :: forall m. MonadReader OutputOptions m => m Builder useColorError = maybe "" colorError <$> reader outputOptionsColorOptions useColorNum :: forall m. MonadReader OutputOptions m => m Builder useColorNum = maybe "" colorNum <$> reader outputOptionsColorOptions -- | Produce a 'Builder' corresponding to the ANSI escape sequence for -- resetting the console color back to the default. Produces an empty 'Builder' -- if 'outputOptionsColorOptions' is 'Nothing'. useColorReset :: forall m. MonadReader OutputOptions m => m Builder useColorReset = maybe "" (const colorReset) <$> reader outputOptionsColorOptions -- | Produce a 'Builder' representing the ANSI escape sequence for the color of -- the rainbow parenthesis, given an input 'NestLevel' and 'Builder' to use as -- the input character. -- -- If 'outputOptionsColorOptions' is 'Nothing', then just return the input -- character. If it is 'Just', then return the input character colorized. renderRainbowParenFor :: MonadReader OutputOptions m => NestLevel -> Builder -> m Builder renderRainbowParenFor nest string = sequenceFold [useColorRainbowParens nest, pure string, useColorReset] useColorRainbowParens :: forall m. MonadReader OutputOptions m => NestLevel -> m Builder useColorRainbowParens nest = do maybeOutputColor <- reader outputOptionsColorOptions pure $ case maybeOutputColor of Just ColorOptions {colorRainbowParens} -> do let choicesLen = length colorRainbowParens if choicesLen == 0 then "" else colorRainbowParens !! (unNestLevel nest `mod` choicesLen) Nothing -> "" -- | This is simply @'fmap' 'fold' '.' 'sequence'@. sequenceFold :: (Monad f, Monoid a, Traversable t) => t (f a) -> f a sequenceFold = fmap fold . sequence -- | A function that performs optimizations and modifications to a list of -- input 'Output's. -- -- An sample of an optimization is 'removeStartingNewLine' which just removes a -- newline if it is the first item in an 'Output' list. modificationsOutputList :: [Output] -> [Output] modificationsOutputList = removeTrailingSpacesInOtherBeforeNewLine . shrinkWhitespaceInOthers . compressOthers . removeStartingNewLine -- | Remove a 'OutputNewLine' if it is the first item in the 'Output' list. -- -- >>> removeStartingNewLine [Output 3 OutputNewLine, Output 3 OutputComma] -- [Output {outputNestLevel = NestLevel {unNestLevel = 3}, outputOutputType = OutputComma}] removeStartingNewLine :: [Output] -> [Output] removeStartingNewLine ((Output _ OutputNewLine) : t) = t removeStartingNewLine outputs = outputs -- | Remove trailing spaces from the end of a 'OutputOther' token if it is -- followed by a 'OutputNewLine', or if it is the final 'Output' in the list. -- This function assumes that there is a single 'OutputOther' before any -- 'OutputNewLine' (and before the end of the list), so it must be run after -- running 'compressOthers'. -- -- >>> removeTrailingSpacesInOtherBeforeNewLine [Output 2 (OutputOther "foo "), Output 4 OutputNewLine] -- [Output {outputNestLevel = NestLevel {unNestLevel = 2}, outputOutputType = OutputOther "foo"},Output {outputNestLevel = NestLevel {unNestLevel = 4}, outputOutputType = OutputNewLine}] removeTrailingSpacesInOtherBeforeNewLine :: [Output] -> [Output] removeTrailingSpacesInOtherBeforeNewLine [] = [] removeTrailingSpacesInOtherBeforeNewLine (Output nest (OutputOther string):[]) = (Output nest (OutputOther $ dropWhileEnd isSpace string)):[] removeTrailingSpacesInOtherBeforeNewLine (Output nest (OutputOther string):nl@(Output _ OutputNewLine):t) = (Output nest (OutputOther $ dropWhileEnd isSpace string)):nl:removeTrailingSpacesInOtherBeforeNewLine t removeTrailingSpacesInOtherBeforeNewLine (h:t) = h : removeTrailingSpacesInOtherBeforeNewLine t -- | If there are two subsequent 'OutputOther' tokens, combine them into just -- one 'OutputOther'. -- -- >>> compressOthers [Output 0 (OutputOther "foo"), Output 0 (OutputOther "bar")] -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "foobar"}] compressOthers :: [Output] -> [Output] compressOthers [] = [] compressOthers (Output _ (OutputOther string1):(Output nest (OutputOther string2)):t) = compressOthers ((Output nest (OutputOther (string1 `mappend` string2))) : t) compressOthers (h:t) = h : compressOthers t -- | In each 'OutputOther' token, compress multiple whitespaces to just one -- whitespace. -- -- >>> shrinkWhitespaceInOthers [Output 0 (OutputOther " hello ")] -- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " hello "}] shrinkWhitespaceInOthers :: [Output] -> [Output] shrinkWhitespaceInOthers = fmap shrinkWhitespaceInOther shrinkWhitespaceInOther :: Output -> Output shrinkWhitespaceInOther (Output nest (OutputOther string)) = Output nest . OutputOther $ shrinkWhitespace string shrinkWhitespaceInOther other = other shrinkWhitespace :: String -> String shrinkWhitespace (' ':' ':t) = shrinkWhitespace (' ':t) shrinkWhitespace (h:t) = h : shrinkWhitespace t shrinkWhitespace "" = "" pretty-simple-3.2.3.0/example/ExampleJSON.hs0000644000000000000000000000352513375121461016745 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-3.2.3.0/example/Example/Data.hs0000644000000000000000000000244313375121461017122 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-3.2.3.0/example/Example.hs0000644000000000000000000000103713375121461016247 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-3.2.3.0/app/Main.hs0000644000000000000000000000423213521742153014665 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.Text (unpack) import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as LT import Options.Applicative ( Parser, ReadM, execParser, fullDesc, help, helper, info, long , option, progDesc, readerError, short, showDefaultWith, str, value, (<**>)) import Data.Monoid ((<>)) import Text.Pretty.Simple ( pStringOpt, OutputOptions , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg , defaultOutputOptionsNoColor ) data Color = DarkBg | LightBg | NoColor newtype Args = Args { color :: Color } 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 (\_ -> "dark-bg") <> value DarkBg ) main :: IO () main = do args' <- execParser opts input <- T.getContents let printOpt = getPrintOpt $ color args' output = pStringOpt printOpt $ unpack input LT.putStr output where opts = info (args <**> helper) ( fullDesc <> progDesc "Format Haskell data types with indentation and highlighting" ) getPrintOpt :: Color -> OutputOptions getPrintOpt DarkBg = defaultOutputOptionsDarkBg getPrintOpt LightBg = defaultOutputOptionsLightBg getPrintOpt NoColor = defaultOutputOptionsNoColor pretty-simple-3.2.3.0/test/DocTest.hs0000644000000000000000000000040113526372524015545 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-3.2.3.0/bench/Bench.hs0000644000000000000000000000210513375121461015314 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-3.2.3.0/LICENSE0000644000000000000000000000276713375121461013705 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-3.2.3.0/Setup.hs0000644000000000000000000000151613526372524014331 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-3.2.3.0/pretty-simple.cabal0000644000000000000000000001005113666167657016507 0ustar0000000000000000name: pretty-simple version: 3.2.3.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: False 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.ExprToOutput , Text.Pretty.Simple.Internal.Output , Text.Pretty.Simple.Internal.OutputPrinter build-depends: base >= 4.8 && < 5 , ansi-terminal >= 0.6 , containers , mtl >= 2.2 , text >= 1.2 , transformers >= 0.4 default-language: Haskell2010 ghc-options: -Wall other-extensions: TemplateHaskell executable pretty-simple main-is: Main.hs 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 pretty-simple-3.2.3.0/CHANGELOG.md0000644000000000000000000001061113666170013014474 0ustar0000000000000000 ## 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-3.2.3.0/README.md0000644000000000000000000001506513375121461014152 0ustar0000000000000000 Text.Pretty.Simple ================== [![Build Status](https://secure.travis-ci.org/cdepillabout/pretty-simple.svg)](http://travis-ci.org/cdepillabout/pretty-simple) [![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](/img/pretty-simple-example-screenshot.png?raw=true "example screenshot") ## Usage `pretty-simple` can be easily used from `ghci` when debugging. When using `stack` to run `ghci`, just append append the `--package` flag to the command line to load `pretty-simple`. ```sh $ stack ghci --package 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 - Amount of indentation is 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 like this: ```sh $ stack ghci --ghci-options "-interactive-print=Text.Pretty.Simple.pPrint" --package 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](/img/pretty-simple-json-example-screenshot.png?raw=true "json example screenshot") (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. Note that you must enable the `buildexe` flag, since it will not be built by default: ```sh $ stack install pretty-simple-2.2.0.1 --flag pretty-simple:buildexe ``` 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](/img/pretty-simple-cli-screenshot.png?raw=true "cli example screenshot") 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. pretty-simple-3.2.3.0/img/pretty-simple-example-screenshot.png0000644000000000000000000003572713375121461022606 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`