pretty-simple-4.1.2.0: 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 HaskellSafe-Inferred
LanguageHaskell2010

Text.Pretty.Simple.Internal.Printer

Description

 
Synopsis

Documentation

>>> import Text.Pretty.Simple (pPrintString, pPrintStringOpt)

data CheckColorTty Source #

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.

Constructors

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.

Instances

Instances details
Generic CheckColorTty Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Associated Types

type Rep CheckColorTty :: Type -> Type #

Show CheckColorTty Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Eq CheckColorTty Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep CheckColorTty Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep CheckColorTty = D1 ('MetaData "CheckColorTty" "Text.Pretty.Simple.Internal.Printer" "pretty-simple-4.1.2.0-GMnRiTYYdgPHrTLYlYPD9K" 'False) (C1 ('MetaCons "CheckColorTty" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NoCheckColorTty" 'PrefixI 'False) (U1 :: Type -> Type))

data StringOutputStyle Source #

Control how escaped and non-printable are output for strings.

See outputOptionsStringStyle for what the output looks like with each of these options.

Constructors

Literal

Output string literals by printing the source characters exactly.

For examples: without this option the printer will insert a newline in place of "n", with this options the printer will output '\' and n. Similarly the exact escape codes used in the input string will be replicated, so "65" will be printed as "65" and not A.

EscapeNonPrintable

Replace non-printable characters with hexadecimal escape sequences.

DoNotEscapeNonPrintable

Output non-printable characters without modification.

Instances

Instances details
Generic StringOutputStyle Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Associated Types

type Rep StringOutputStyle :: Type -> Type #

Show StringOutputStyle Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Eq StringOutputStyle Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep StringOutputStyle Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep StringOutputStyle = D1 ('MetaData "StringOutputStyle" "Text.Pretty.Simple.Internal.Printer" "pretty-simple-4.1.2.0-GMnRiTYYdgPHrTLYlYPD9K" 'False) (C1 ('MetaCons "Literal" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "EscapeNonPrintable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DoNotEscapeNonPrintable" 'PrefixI 'False) (U1 :: Type -> Type)))

data OutputOptions Source #

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

Constructors

OutputOptions 

Fields

  • outputOptionsIndentAmount :: Int

    Number of spaces to use when indenting. It should probably be either 2 or 4.

  • outputOptionsPageWidth :: Int

    The maximum number of characters to fit on to one line.

  • outputOptionsCompact :: Bool

    Use less vertical (and more horizontal) space.

  • outputOptionsCompactParens :: Bool

    Group closing parentheses on to a single line.

  • outputOptionsInitialIndent :: Int

    Indent the whole output by this amount.

  • outputOptionsColorOptions :: Maybe ColorOptions

    If this is Nothing, then don't colorize the output. If this is Just colorOptions, then use colorOptions to colorize the output.

  • outputOptionsStringStyle :: StringOutputStyle

    Controls how string literals are output.

    By default, the pPrint functions escape non-printable characters, but print all printable characters:

    >>> pPrintString "\"A \\x42 Ä \\xC4 \\x1 \\n\""
    "A B Ä Ä \x1
    "
    

    Here, you can see that the character A has been printed as-is. x42 has been printed in the non-escaped version, B. The non-printable character x1 has been printed as x1. Newlines will be removed to make the output easier to read.

    This corresponds to the StringOutputStyle called EscapeNonPrintable.

    (Note that in the above and following examples, the characters have to be double-escaped, which makes it somewhat confusing...)

    Another output style is DoNotEscapeNonPrintable. This is similar to EscapeNonPrintable, except that non-printable characters get printed out literally to the screen.

    >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = DoNotEscapeNonPrintable } "\"A \\x42 Ä \\xC4 \\n\""
    "A B Ä Ä
    "
    

    If you change the above example to contain x1, you can see that it is output as a literal, non-escaped character. Newlines are still removed for readability.

    Another output style is Literal. This just outputs all escape characters.

    >>> pPrintStringOpt CheckColorTty defaultOutputOptionsDarkBg{ outputOptionsStringStyle = Literal } "\"A \\x42 Ä \\xC4 \\x1 \\n\""
    "A \x42 Ä \xC4 \x1 \n"
    

    You can see that all the escape characters get output literally, including newline.

Instances

Instances details
Generic OutputOptions Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Associated Types

type Rep OutputOptions :: Type -> Type #

Show OutputOptions Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Eq OutputOptions Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep OutputOptions Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

type Rep OutputOptions = D1 ('MetaData "OutputOptions" "Text.Pretty.Simple.Internal.Printer" "pretty-simple-4.1.2.0-GMnRiTYYdgPHrTLYlYPD9K" 'False) (C1 ('MetaCons "OutputOptions" 'PrefixI 'True) ((S1 ('MetaSel ('Just "outputOptionsIndentAmount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: (S1 ('MetaSel ('Just "outputOptionsPageWidth") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "outputOptionsCompact") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))) :*: ((S1 ('MetaSel ('Just "outputOptionsCompactParens") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool) :*: S1 ('MetaSel ('Just "outputOptionsInitialIndent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :*: (S1 ('MetaSel ('Just "outputOptionsColorOptions") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ColorOptions)) :*: S1 ('MetaSel ('Just "outputOptionsStringStyle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StringOutputStyle)))))

defaultOutputOptionsDarkBg :: OutputOptions Source #

Default values for OutputOptions when printing to a console with a dark background. outputOptionsIndentAmount is 4, and outputOptionsColorOptions is defaultColorOptionsDarkBg.

defaultOutputOptionsLightBg :: OutputOptions Source #

Default values for OutputOptions when printing to a console with a light background. outputOptionsIndentAmount is 4, and outputOptionsColorOptions is defaultColorOptionsLightBg.

defaultOutputOptionsNoColor :: OutputOptions Source #

Default values for OutputOptions when printing using using ANSI escape sequences for color. outputOptionsIndentAmount is 4, and outputOptionsColorOptions is Nothing.

hCheckTTY :: MonadIO m => Handle -> OutputOptions -> m OutputOptions Source #

Given OutputOptions, disable colorful output if the given handle is not connected to a TTY.

layoutString :: OutputOptions -> String -> SimpleDocStream Style Source #

Parse a string, and generate an intermediate representation, suitable for passing to any prettyprinter backend. Used by pString etc.

prettyExprs' :: OutputOptions -> [Expr] -> Doc Annotation Source #

Slight adjustment of prettyExprs for the outermost level, to avoid indenting everything.

prettyExprs :: OutputOptions -> [Expr] -> Doc Annotation Source #

Construct a Doc from multiple Exprs.

prettyExpr :: OutputOptions -> Expr -> Doc Annotation Source #

Construct a Doc from a single Expr.

isSimple :: Expr -> Bool Source #

Determine whether this expression should be displayed on a single line.

annotateStyle :: OutputOptions -> SimpleDocStream Annotation -> SimpleDocStream Style Source #

Traverse the stream, using a Tape to keep track of the current style.

data Annotation Source #

An abstract annotation type, representing the various elements we may want to highlight.

Constructors

Open 
Close 
Comma 
Quote 
String 
Num 

Instances

Instances details
Show Annotation Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Eq Annotation Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

escapeNonPrintable :: String -> String Source #

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"

escape :: Char -> ShowS Source #

Replace an unprintable character except a newline with a hex escape sequence.

data Tape a Source #

A bidirectional Turing-machine tape: infinite in both directions, with a head pointing to one element.

Constructors

Tape 

Fields

Instances

Instances details
Show a => Show (Tape a) Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Methods

showsPrec :: Int -> Tape a -> ShowS #

show :: Tape a -> String #

showList :: [Tape a] -> ShowS #

moveL :: Tape a -> Tape a Source #

Move the head left

moveR :: Tape a -> Tape a Source #

Move the head right

data Stream a Source #

An infinite list

Constructors

a :.. (Stream a) 

Instances

Instances details
Show a => Show (Stream a) Source # 
Instance details

Defined in Text.Pretty.Simple.Internal.Printer

Methods

showsPrec :: Int -> Stream a -> ShowS #

show :: Stream a -> String #

showList :: [Stream a] -> ShowS #

streamRepeat :: t -> Stream t Source #

Analogous to repeat

streamCycle :: NonEmpty a -> Stream a Source #

Analogous to cycle While the inferred signature here is more general, it would diverge on an empty structure