pretty-simple-1.1.0.2: pretty printer for data types with a 'Show' instance.

Copyright(c) Dennis Gosnell 2016
LicenseBSD-style (see LICENSE file)
Maintainercdep.illabout@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Text.Pretty.Simple

Contents

Description

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.

The other variations of pPrint, pShow, and pString are for printing without color and changing the indentation amount. Most users can ignore these.

See the Examples section at the end of this module for examples of acutally using pPrint.

Synopsis

Output With Color

pShow :: Show a => a -> Text Source #

Similar to pPrint, but just return the resulting pretty-printed data type as a Text instead of printing it to the screen.

pPrint :: (MonadIO m, Show a) => a -> m () Source #

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 ()

pString :: String -> Text Source #

Similar to pShow, but the first argument is a String representing a data type that has already been showed.

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.

Output With NO Color

pShowNoColor :: Show a => a -> Text Source #

Like pShow, but without color.

pPrintNoColor :: (MonadIO m, Show a) => a -> m () Source #

Similar to pPrint, but doesn't print in color. However, data types will still be indented nicely.

>>> pPrintNoColor $ Just ["hello", "bye"]
Just
    [ "hello"
    , "bye"
    ]

pStringNoColor :: String -> Text Source #

LIke pString, but without color.

Output With Output Options

pShowOpt :: Show a => OutputOptions -> a -> Text Source #

Like pShow but takes OutputOptions to change how the pretty-printing is done.

pPrintOpt :: (MonadIO m, Show a) => OutputOptions -> a -> m () Source #

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 noColorOutputOptions $ Just ("hello", "bye")
Just
    ( "hello"
    , "bye"
    )

This is what smaller indentation looks like:

>>> let smallIndent = noColorOutputOptions {outputOptionsIndentAmount = 1}
>>> pPrintOpt smallIndent $ Just ("hello", "bye")
Just
 ( "hello"
 , "bye"
 )

pStringOpt :: OutputOptions -> String -> Text Source #

Like pString but takes OutputOptions to change how the pretty-printing is done.

data OutputOptions Source #

Data-type wrapping up all the options available when rendering the list of Outputs.

Constructors

OutputOptions 

Fields

Instances

Eq OutputOptions Source # 
Data OutputOptions Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OutputOptions -> c OutputOptions #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OutputOptions #

toConstr :: OutputOptions -> Constr #

dataTypeOf :: OutputOptions -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c OutputOptions) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OutputOptions) #

gmapT :: (forall b. Data b => b -> b) -> OutputOptions -> OutputOptions #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OutputOptions -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OutputOptions -> r #

gmapQ :: (forall d. Data d => d -> u) -> OutputOptions -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> OutputOptions -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> OutputOptions -> m OutputOptions #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> OutputOptions -> m OutputOptions #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> OutputOptions -> m OutputOptions #

Read OutputOptions Source # 
Show OutputOptions Source # 
Generic OutputOptions Source # 

Associated Types

type Rep OutputOptions :: * -> * #

type Rep OutputOptions Source # 
type Rep OutputOptions = D1 (MetaData "OutputOptions" "Text.Pretty.Simple.Internal.OutputPrinter" "pretty-simple-1.1.0.2-4x88hZB4KxbA70S1ITmjhP" False) (C1 (MetaCons "OutputOptions" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "outputOptionsIndentAmount") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)) (S1 (MetaSel (Just Symbol "outputOptionsUseColor") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UseColor))))

data UseColor Source #

UseColor describes whether or not we want to use color when printing the Output list.

Constructors

NoColor 
UseColor 

Instances

Eq UseColor Source # 
Data UseColor Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UseColor -> c UseColor #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UseColor #

toConstr :: UseColor -> Constr #

dataTypeOf :: UseColor -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c UseColor) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UseColor) #

gmapT :: (forall b. Data b => b -> b) -> UseColor -> UseColor #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UseColor -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UseColor -> r #

gmapQ :: (forall d. Data d => d -> u) -> UseColor -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UseColor -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UseColor -> m UseColor #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UseColor -> m UseColor #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UseColor -> m UseColor #

Read UseColor Source # 
Show UseColor Source # 
Generic UseColor Source # 

Associated Types

type Rep UseColor :: * -> * #

Methods

from :: UseColor -> Rep UseColor x #

to :: Rep UseColor x -> UseColor #

type Rep UseColor Source # 
type Rep UseColor = D1 (MetaData "UseColor" "Text.Pretty.Simple.Internal.OutputPrinter" "pretty-simple-1.1.0.2-4x88hZB4KxbA70S1ITmjhP" False) ((:+:) (C1 (MetaCons "NoColor" PrefixI False) U1) (C1 (MetaCons "UseColor" PrefixI False) U1))

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 doctest. pPrint outputs ANSI escape codes in order to produce color, so the following examples would be hard to read had pPrint been used.

Simple Haskell data type

>>> data Foo a = Foo a String deriving Show
>>> pPrintNoColor $ Foo 3 "hello"
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"
        ]
    }