pretty-simple-2.2.0.1/app/0000755000000000000000000000000013375121461013441 5ustar0000000000000000pretty-simple-2.2.0.1/bench/0000755000000000000000000000000013375121461013740 5ustar0000000000000000pretty-simple-2.2.0.1/example/0000755000000000000000000000000013375121461014314 5ustar0000000000000000pretty-simple-2.2.0.1/example/Example/0000755000000000000000000000000013375121461015707 5ustar0000000000000000pretty-simple-2.2.0.1/img/0000755000000000000000000000000013375121461013435 5ustar0000000000000000pretty-simple-2.2.0.1/src/0000755000000000000000000000000013375121461013450 5ustar0000000000000000pretty-simple-2.2.0.1/src/Debug/0000755000000000000000000000000013375121461014476 5ustar0000000000000000pretty-simple-2.2.0.1/src/Debug/Pretty/0000755000000000000000000000000013375121461015765 5ustar0000000000000000pretty-simple-2.2.0.1/src/Text/0000755000000000000000000000000013375121461014374 5ustar0000000000000000pretty-simple-2.2.0.1/src/Text/Pretty/0000755000000000000000000000000013375121461015663 5ustar0000000000000000pretty-simple-2.2.0.1/src/Text/Pretty/Simple/0000755000000000000000000000000013375121461017114 5ustar0000000000000000pretty-simple-2.2.0.1/src/Text/Pretty/Simple/Internal/0000755000000000000000000000000013375121461020670 5ustar0000000000000000pretty-simple-2.2.0.1/test/0000755000000000000000000000000013375121461013640 5ustar0000000000000000pretty-simple-2.2.0.1/src/Debug/Pretty/Simple.hs0000644000000000000000000002247513375121461017564 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 pTrace , pTraceId , pTraceShow , pTraceShowId , pTraceIO , pTraceM , pTraceShowM , pTraceStack , pTraceEvent , pTraceEventIO , pTraceMarker , pTraceMarkerIO -- * Trace without color , pTraceNoColor , pTraceIdNoColor , pTraceShowNoColor , pTraceShowIdNoColor , pTraceMNoColor , pTraceShowMNoColor , pTraceStackNoColor , pTraceEventNoColor , pTraceEventIONoColor , pTraceMarkerNoColor , pTraceMarkerIONoColor , pTraceIONoColor ) where import Data.Text.Lazy (unpack) import Debug.Trace (trace, traceEvent, traceEventIO, traceIO, traceM, traceMarker, traceMarkerIO, traceStack) import Text.Pretty.Simple (pShow, pShowNoColor, pString, pStringNoColor) #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 = traceIO . unpack . pString {-| 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 = trace . unpack . pString {-| Like 'pTrace' but returns the message instead of a third value. @since 2.0.1.0 -} pTraceId :: String -> String pTraceId a = pTrace a a {-| 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 = trace . unpack . pShow {-| Like 'pTraceShow' but returns the shown value instead of a third value. @since 2.0.1.0 -} pTraceShowId :: (Show a) => a -> a pTraceShowId a = trace (unpack (pShow a)) a {-| 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 string = trace (unpack (pString string)) $ pure () {-| 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 = traceM . unpack . pShow {-| 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 = traceStack . unpack . pString {-| 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 = traceEvent . unpack . pString {-| 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 = traceEventIO . unpack . pString -- | 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 = traceMarker . unpack . pString -- | 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 = traceMarkerIO . unpack . pString ------------------------------------------ -- Traces without color ------------------------------------------ -- | Similar to 'pTrace', but without color. -- -- >>> pTraceNoColor "wow" () -- wow -- () -- -- @since 2.0.2.0 pTraceNoColor :: String -> a -> a pTraceNoColor = trace . unpack . pStringNoColor -- | Similar to 'pTraceId', but without color. -- -- >>> pTraceIdNoColor "(1, 2, 3)" `seq` () -- ( 1 -- , 2 -- , 3 -- ) -- () -- -- @since 2.0.2.0 pTraceIdNoColor :: String -> String pTraceIdNoColor a = pTraceNoColor a a -- | 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 = trace . unpack . pShowNoColor -- | 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 a = trace (unpack (pShowNoColor a)) a -- | 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 string = trace (unpack (pString string)) $ pure () -- | 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 = traceM . unpack . pShowNoColor -- | Similar to 'pTraceStack', but without color. -- -- >>> pTraceStackNoColor "wow" () `seq` () -- wow -- () -- -- @since 2.0.2.0 pTraceStackNoColor :: String -> a -> a pTraceStackNoColor = traceStack . unpack . pStringNoColor -- | Similar to 'pTraceEvent', but without color. -- -- @since 2.0.2.0 pTraceEventNoColor :: String -> a -> a pTraceEventNoColor = traceEvent . unpack . pStringNoColor -- | Similar to 'pTraceEventIO', but without color. -- -- @since 2.0.2.0 pTraceEventIONoColor :: String -> IO () pTraceEventIONoColor = traceEventIO . unpack . pStringNoColor -- | Similar to 'pTraceMarker', but without color. -- -- @since 2.0.2.0 pTraceMarkerNoColor :: String -> a -> a pTraceMarkerNoColor = traceMarker . unpack . pStringNoColor -- | Similar to 'pTraceMarkerIO', but without color. -- -- @since 2.0.2.0 pTraceMarkerIONoColor :: String -> IO () pTraceMarkerIONoColor = traceMarkerIO . unpack . pStringNoColor -- | Similar to 'pTraceIO', but without color. -- -- >>> pTraceIONoColor "(1, 2, 3)" -- ( 1 -- , 2 -- , 3 -- ) -- -- @since 2.0.2.0 pTraceIONoColor :: String -> IO () pTraceIONoColor = traceIO . unpack . pStringNoColor pretty-simple-2.2.0.1/src/Text/Pretty/Simple.hs0000644000000000000000000002440213375121461017452 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. The variations 'pPrintOpt', 'pShowOpt', and 'pStringOpt' are used when specifying the 'OutputOptions'. Most users can ignore these. 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 , pShow , pString -- * Aliases for output with color on dark background , pPrintDarkBg , pShowDarkBg , pStringDarkBg -- * Output with color on light background , pPrintLightBg , pShowLightBg , pStringLightBg -- * Output with NO color , pPrintNoColor , pShowNoColor , pStringNoColor -- * Output With 'OutputOptions' , pPrintOpt , pShowOpt , pStringOpt -- * 'OutputOptions' , OutputOptions(..) , defaultOutputOptionsDarkBg , defaultOutputOptionsLightBg , defaultOutputOptionsNoColor -- * '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, pack, unpack) import Data.Text.Lazy.IO as LText import Text.Pretty.Simple.Internal (OutputOptions(..), defaultColorOptionsDarkBg, defaultColorOptionsLightBg, defaultOutputOptionsDarkBg, defaultOutputOptionsLightBg, defaultOutputOptionsNoColor, expressionParse, expressionsToOutputs, render) ---------------------------------------------------------- -- 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 is for printing to a dark background. pPrint :: (MonadIO m, Show a) => a -> m () pPrint = pPrintOpt defaultOutputOptionsDarkBg -- | Similar to 'pPrint', but just return the resulting pretty-printed data -- type as a 'Text' instead of printing it to the screen. -- -- This function is for printing to a dark background. pShow :: Show a => a -> Text 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. 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 '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 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 defaultOutputOptionsNoColor -- | Like 'pShow', but without color. pShowNoColor :: Show a => a -> Text pShowNoColor = pShowOpt defaultOutputOptionsNoColor -- | LIke 'pString', but without color. 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 defaultOutputOptionsNoColor $ Just ("hello", "bye") -- Just -- ( "hello" -- , "bye" -- ) -- -- This is what smaller indentation looks like: -- -- >>> let smallIndent = defaultOutputOptionsNoColor {outputOptionsIndentAmount = 1} -- >>> pPrintOpt smallIndent $ Just ("hello", "bye") -- Just -- ( "hello" -- , "bye" -- ) -- -- Lines in strings get indented -- -- >>> pPrintOpt 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 defaultOutputOptionsNoColor (1, (2, Foo, 3)) -- ( 1 -- , -- ( 2 -- , foo -- bar -- baz -- , 3 -- ) -- ) pPrintOpt :: (MonadIO m, Show a) => OutputOptions -> a -> m () pPrintOpt outputOptions = liftIO . LText.putStrLn . pShowOpt outputOptions -- | 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. -- -- The following examples are all using 'pPrintNoColor' instead of 'pPrint' -- because their output is being checked using -- . 'pPrint' outputs ANSI -- escape codes in order to produce color, so the following examples would be -- hard to read had 'pPrint' been used. -- -- __Simple Haskell data type__ -- -- >>> data Foo a = Foo a String deriving Show -- -- >>> pPrintNoColor $ Foo 3 "hello" -- Foo 3 "hello" -- -- __List__ -- -- >>> pPrintNoColor $ [1,2,3] -- [ 1 -- , 2 -- , 3 -- ] -- -- __Slightly more complicated list__ -- -- >>> pPrintNoColor $ [ Foo [ (), () ] "hello" ] -- [ Foo -- [ () -- , () -- ] "hello" -- ] -- -- >>> pPrintNoColor $ [ Foo [ "bar", "baz" ] "hello", Foo [] "bye" ] -- [ Foo -- [ "bar" -- , "baz" -- ] "hello" -- , Foo [] "bye" -- ] -- -- __Record__ -- -- >>> :{ -- data Bar b = Bar -- { barInt :: Int -- , barA :: b -- , barList :: [Foo Double] -- } deriving Show -- :} -- -- >>> pPrintNoColor $ Bar 1 [10, 11] [Foo 1.1 "", Foo 2.2 "hello"] -- Bar -- { barInt = 1 -- , barA = -- [ 10 -- , 11 -- ] -- , barList = -- [ Foo 1.1 "" -- , Foo 2.2 "hello" -- ] -- } -- -- __Newtype__ -- -- >>> newtype Baz = Baz { unBaz :: [String] } deriving Show -- -- >>> pPrintNoColor $ Baz ["hello", "bye"] -- Baz -- { unBaz = -- [ "hello" -- , "bye" -- ] -- } -- -- __Newline Rules__ -- -- >>> data Foo = A | B Foo | C [Foo] [Foo] deriving Show -- -- >>> pPrintNoColor $ B ( B A ) -- B ( B A ) -- -- >>> pPrintNoColor $ B ( B ( B A ) ) -- B -- ( B ( B A ) ) -- -- >>> pPrintNoColor $ B ( B ( B ( B A ) ) ) -- B -- ( B -- ( B ( B A ) ) -- ) -- -- >>> pPrintNoColor $ 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__ -- -- >>> pPrintNoColor $ Baz ["猫", "犬", "ヤギ"] -- Baz -- { unBaz = -- [ "猫" -- , "犬" -- , "ヤギ" -- ] -- } -- -- __Other__ -- -- Making sure the spacing after a string is correct -- -- >>> data Foo = Foo String Int deriving Show -- -- >>> pPrintNoColor $ Foo "bar" 0 -- Foo "bar" 0 pretty-simple-2.2.0.1/src/Text/Pretty/Simple/Internal.hs0000644000000000000000000000107413375121461021226 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-2.2.0.1/src/Text/Pretty/Simple/Internal/Color.hs0000644000000000000000000002146313375121461022310 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 -- ^ (currently not used) , 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-2.2.0.1/src/Text/Pretty/Simple/Internal/Expr.hs0000644000000000000000000000205013375121461022137 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 | Other !String deriving (Data, Eq, Generic, Show, Typeable) pretty-simple-2.2.0.1/src/Text/Pretty/Simple/Internal/ExprParser.hs0000644000000000000000000000575713375121461023335 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) testString1, testString2 :: 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\"})}]" 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 other = first Other $ parseOther other 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) 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 parseOther :: String -> (String, String) parseOther = span . flip notElem $ ("{[()]}\"," :: String) -- | -- Handle escaped characters correctly -- -- >>> parseExprs $ "Foo \"hello \\\"world!\"" -- ([Other "Foo ",StringLit "hello \\\"world!"],"") pretty-simple-2.2.0.1/src/Text/Pretty/Simple/Internal/ExprToOutput.hs0000644000000000000000000002307713375121461023677 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 -- >>> 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 (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-2.2.0.1/src/Text/Pretty/Simple/Internal/Output.hs0000644000000000000000000000621113375121461022524 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\"@. 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' 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-2.2.0.1/src/Text/Pretty/Simple/Internal/OutputPrinter.hs0000644000000000000000000002332313375121461024073 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.Reader (MonadReader(reader), runReader) import Data.Foldable (fold) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import Data.Typeable (Typeable) import Data.List (intercalate) import Data.Maybe (fromMaybe) import Text.Read (readMaybe) import GHC.Generics (Generic) import Text.Pretty.Simple.Internal.Color (ColorOptions(..), colorReset, defaultColorOptionsDarkBg, defaultColorOptionsLightBg) import Text.Pretty.Simple.Internal.Output (NestLevel(..), Output(..), OutputType(..)) -- | 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. } 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 } -- | 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 } -- | 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} -- | 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) = renderRaibowParenFor nest "}" renderOutput (Output nest OutputCloseBracket) = renderRaibowParenFor nest "]" renderOutput (Output nest OutputCloseParen) = renderRaibowParenFor nest ")" renderOutput (Output nest OutputComma) = renderRaibowParenFor nest "," renderOutput (Output _ OutputIndent) = do indentSpaces <- reader outputOptionsIndentAmount pure . mconcat $ replicate indentSpaces " " renderOutput (Output _ OutputNewLine) = pure "\n" renderOutput (Output nest OutputOpenBrace) = renderRaibowParenFor nest "{" renderOutput (Output nest OutputOpenBracket) = renderRaibowParenFor nest "[" renderOutput (Output nest OutputOpenParen) = renderRaibowParenFor 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 _ (OutputStringLit string)) = do indentSpaces <- reader outputOptionsIndentAmount let spaces = replicate (indentSpaces + 2) ' ' sequenceFold [ useColorQuote , pure "\"" , useColorReset , useColorString -- TODO: This probably shouldn't be a string to begin with. , pure $ fromString $ indentSubsequentLinesWith spaces $ readStr string , useColorReset , useColorQuote , pure "\"" , useColorReset ] where readStr s = fromMaybe s . readMaybe $ '"':s ++ "\"" -- | -- >>> 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. renderRaibowParenFor :: MonadReader OutputOptions m => NestLevel -> Builder -> m Builder renderRaibowParenFor 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 = 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 -- | 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-2.2.0.1/example/ExampleJSON.hs0000644000000000000000000000352513375121461016742 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-2.2.0.1/example/Example/Data.hs0000644000000000000000000000244313375121461017117 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-2.2.0.1/example/Example.hs0000644000000000000000000000103713375121461016244 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-2.2.0.1/app/Main.hs0000644000000000000000000000423213375121461014662 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-2.2.0.1/test/DocTest.hs0000644000000000000000000000162713375121461015547 0ustar0000000000000000 module Main (main) where import Prelude import Data.Monoid ((<>)) import System.FilePath.Glob (glob) import Test.DocTest (doctest) main :: IO () main = glob "src/**/*.hs" >>= doDocTest doDocTest :: [String] -> IO () doDocTest options = doctest $ options <> ghcExtensions ghcExtensions :: [String] ghcExtensions = [ -- "-XConstraintKinds" -- , "-XDataKinds" "-XDeriveDataTypeable" , "-XDeriveGeneric" -- , "-XEmptyDataDecls" , "-XFlexibleContexts" -- , "-XFlexibleInstances" -- , "-XGADTs" -- , "-XGeneralizedNewtypeDeriving" -- , "-XInstanceSigs" -- , "-XMultiParamTypeClasses" -- , "-XNoImplicitPrelude" , "-XOverloadedStrings" -- , "-XPolyKinds" -- , "-XRankNTypes" -- , "-XRecordWildCards" , "-XScopedTypeVariables" -- , "-XStandaloneDeriving" -- , "-XTupleSections" -- , "-XTypeFamilies" -- , "-XTypeOperators" ] pretty-simple-2.2.0.1/bench/Bench.hs0000644000000000000000000000210513375121461015311 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-2.2.0.1/LICENSE0000644000000000000000000000276713375121461013702 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-2.2.0.1/Setup.hs0000644000000000000000000000005613375121461014316 0ustar0000000000000000import Distribution.Simple main = defaultMain pretty-simple-2.2.0.1/pretty-simple.cabal0000644000000000000000000000747213402470613016472 0ustar0000000000000000name: pretty-simple version: 2.2.0.1 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 Dennis Gosnell category: Text build-type: Simple extra-source-files: CHANGELOG.md , README.md , img/pretty-simple-example-screenshot.png cabal-version: >=1.10 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 , 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 , Glob 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-2.2.0.1/CHANGELOG.md0000644000000000000000000000413713402470635014500 0ustar0000000000000000## 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-2.2.0.1/README.md0000644000000000000000000001506513375121461014147 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-2.2.0.1/img/pretty-simple-example-screenshot.png0000644000000000000000000003572713375121461022603 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`