Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Data.Portray.Prettyprinter
Description
Provides rendering of Portrayal
to Doc
.
There are two intended uses of this module: firstly, to use prettyprinter
's
layout and rendering algorithms to render Portray
instances, Diff
s, or
other Portrayal
s; and secondly, to derive Pretty
instances based on
existing Portray
instances. I find the former more ergonomic, but in
established codebases that want to benefit from deriving, the latter may be
more achievable.
The first usage is for codebases with pervasive use of Portray
, and
involves using e.g. pp
and ppd
in GHCi, or showPortrayal
or showDiff
in application code. With this usage, anything you want to pretty-print
needs a Portray
instance, and the typeclass Pretty
is not involved in
any way. With this approach, pretty-printable types and the types they
include should derive only Portray
, and pretty-printing should be done
with the aforementioned utility functions:
data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord }
deriving Generic
deriving Portray via Wrapped Generic MyRecord
example = showPortrayal
(MyRecord 2 ...)
This usage provides colorized pretty-printing by default with pp
. Note if
you don't like the default choice of colors or don't want colors at all, you
can roll your own pp
function with portray
, toDocAssocPrec
and your
prettyprinter
rendering backend of choice.
The second usage is to use portray
's generic deriving to provide derived
Pretty
instances, in a codebase that uses Pretty
as the preferred
typeclass for pretty-printable values. With this usage, things you want to
pretty-print need Pretty
instances, and Portray
is needed for the
transitive closure of types included in types you want to derive Pretty
instances for. This may result in many types needing both instances of both
Pretty
(for direct pretty-printing) and Portray
(for deriving Portray
on downstream types) instances. Note that with this approach, types that
derive their Pretty
instances via Portray
will ignore any custom
Pretty
instances of nested types, since they recurse to nested Portray
instances instead.
To derive an instance for a pretty-printable type, the type itself should look like the following:
data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord } deriving Generic deriving Portray via Wrapped Generic MyRecord deriving Pretty via WrappedPortray MyRecord example =renderStrict
$pretty
(MyRecord 2 ...)
And any types transitively included in it should look like the following:
data MyOtherRecord = MyOtherRecord deriving Generic deriving Portray via Wrapped Generic MyRecord
Since the Pretty
class requires a universally-quantified annotation type,
its instances cannot provide any annotations. As such, this usage cannot
provide automatic colorization.
This module also exports the underlying rendering functionality in a variety of forms for more esoteric uses.
Synopsis
- showPortrayal :: Portray a => a -> Text
- pp :: Portray a => a -> IO ()
- showDiff :: Diff a => a -> a -> Text
- ppd :: Diff a => a -> a -> IO ()
- newtype WrappedPortray a = WrappedPortray {
- unWrappedPortray :: a
- data Config
- defaultConfig :: Config
- prettyConfig :: Config
- setShouldEscapeChar :: (Char -> Bool) -> Config -> Config
- escapeNonASCII :: Char -> Bool
- escapeSpecialOnly :: Char -> Bool
- setTrimTrailingFloatZeros :: Bool -> Config -> Config
- setScientificNotationThreshold :: Int -> Config -> Config
- setSeparatorGroupSizes :: (Base -> [Int]) -> Config -> Config
- data SyntaxClass
- data LitKind
- defaultStyling :: SyntaxClass -> Maybe AnsiStyle
- subtleStyling :: SyntaxClass -> Maybe AnsiStyle
- noStyling :: SyntaxClass -> Maybe AnsiStyle
- type DocAssocPrec ann = Assoc -> Rational -> Doc ann
- toDocAssocPrecF :: Config -> PortrayalF (DocAssocPrec SyntaxClass) -> DocAssocPrec SyntaxClass
- toDocAssocPrec :: Config -> Portrayal -> DocAssocPrec SyntaxClass
- portrayalToDoc :: Config -> Portrayal -> Doc SyntaxClass
- styleShowPortrayal :: Config -> (SyntaxClass -> Maybe AnsiStyle) -> Portrayal -> Text
- styleShowPortrayalLazy :: Config -> (SyntaxClass -> Maybe AnsiStyle) -> Portrayal -> Text
- prettyShowPortrayal :: Portrayal -> Text
- prettyShowPortrayalLazy :: Portrayal -> Text
- basicShowPortrayal :: Portrayal -> Text
Pretty-Printing
showPortrayal :: Portray a => a -> Text Source #
Pretty-print a value using its Portray
instance.
This uses no ANSI terminal escape codes and escapes all non-ASCII characters.
pp :: Portray a => a -> IO () Source #
Pretty-print a value to stdout using its Portray
instance.
This uses ANSI color codes, so take care not to use it in contexts where it might output to something other than a terminal.
Diffing
showDiff :: Diff a => a -> a -> Text Source #
Pretty-print a diff between two values using a Diff
instance.
This uses no ANSI terminal escape codes and escapes all non-ASCII characters.
ppd :: Diff a => a -> a -> IO () Source #
Pretty-print a diff between two values to stdout using a Diff
instance.
This uses ANSI color codes, so take care not to use it in contexts where it might output to something other than a terminal.
DerivingVia wrapper
newtype WrappedPortray a Source #
A newtype providing a Pretty
instance via Portray
, for DerivingVia
.
Sadly we can't use Wrapped
since it would be an orphan instance. Oh well.
We'll just define a unique WrappedPortray
newtype in each
pretty-printer-integration package.
Constructors
WrappedPortray | |
Fields
|
Instances
Show a => Show (WrappedPortray a) Source # | |
Defined in Data.Portray.Prettyprinter Methods showsPrec :: Int -> WrappedPortray a -> ShowS # show :: WrappedPortray a -> String # showList :: [WrappedPortray a] -> ShowS # | |
Eq a => Eq (WrappedPortray a) Source # | |
Defined in Data.Portray.Prettyprinter Methods (==) :: WrappedPortray a -> WrappedPortray a -> Bool # (/=) :: WrappedPortray a -> WrappedPortray a -> Bool # | |
Ord a => Ord (WrappedPortray a) Source # | |
Defined in Data.Portray.Prettyprinter Methods compare :: WrappedPortray a -> WrappedPortray a -> Ordering # (<) :: WrappedPortray a -> WrappedPortray a -> Bool # (<=) :: WrappedPortray a -> WrappedPortray a -> Bool # (>) :: WrappedPortray a -> WrappedPortray a -> Bool # (>=) :: WrappedPortray a -> WrappedPortray a -> Bool # max :: WrappedPortray a -> WrappedPortray a -> WrappedPortray a # min :: WrappedPortray a -> WrappedPortray a -> WrappedPortray a # | |
Portray a => Pretty (WrappedPortray a) Source # | |
Defined in Data.Portray.Prettyprinter |
Rendering
Configuration
Configuration for the conversion to Doc
.
Includes the following:
setShouldEscapeChar
, a function determining whether an escapable character should be escaped in a string or character literal. Unprintable characters, backslashes, and the relevant quote for the current literal type are always escaped, and anything that wouldn't be escaped byShow
is never escaped.setTrimTrailingFloatZeros
, whether to trim trailing zeros in floating-point literals.setScientificNotationThreshold
, a limit on the number of padding (non-precision) zeros in floating-point literals before switching to scientific notation.setSeparatorGroupSizes
, configuration of where to place underscores in the whole-number part of integral and fractional literals.
For forwards-compatibility reasons, the field selectors and constructor of this type are hidden; use the provided setters to build a config. For example:
config = defaultConfig & setShouldEscapeChar (const True) -- Escape everything we can. & setTrimTrailingFloatZeros True
defaultConfig :: Config Source #
A sensible, conservative default configuration to build on.
- Uses
escapeNonASCII
to escape everything but printable ASCII characters. - Preserves any trailing zeros in float literals.
- Uses scientific notation when any padding zeros would be needed.
- Does not use numeric underscores.
prettyConfig :: Config Source #
A default "pretty" config with more opinionated choices.
This using numeric underscores, slightly less scientific notation, and less
escaping compared to defaultConfig
.
Since: 0.2.1
Escape Sequences
setShouldEscapeChar :: (Char -> Bool) -> Config -> Config Source #
Set the predicate for whether to escape a given character; see Config
.
escapeNonASCII :: Char -> Bool Source #
An escape-sequence predicate to escape any non-ASCII character.
escapeSpecialOnly :: Char -> Bool Source #
An escape-sequence predicate to escape as little as possible.
Numeric Literals
setTrimTrailingFloatZeros :: Bool -> Config -> Config Source #
Configure trimming of trailing zeros from floating-point literals.
Since: 0.2.1
setScientificNotationThreshold :: Int -> Config -> Config Source #
Configure the number of zeros to pad with before using scientific notation.
If the radix point is within or adjaecent to the specified digits in a float literal, it's considered to need no padding zeros. If the radix point is outside the specified digits, we can either materialize extra zeros to cover the gap between the specified digits and the radix point, or use scientific notation to move the radix point into the specified digits. A single placeholder zero to the left of the radix point is not considered to be a padding zero.
FloatLiteral False "1234" (-4) = _.____1 234 = 0.00001 234 -- 4 padding 0s = 1.234e-5
FloatLiteral False "1234" 8 = 1 234____._ = 1 2340000 -- 4 padding 0s = 1.234e7
Trailing that are part of the specified digits are not considered to be
padding (if not trimmed by setTrimTrailingFloatZeros
):
FloatLiteral False "100" 4 = 1 00_._ = 1 000 -- 1 padding 0 = 1.000e3
This threshold determines how many padding zeros to tolerate before switching over to scientific notation. Choosing a very high threshold naturally means scientific notation will ~never be used. Choosing a negative threshold naturally means scientific notation will always be used.
Deciding based on the number of padding zeros rather than the absolute
magnitude of the number means we won't needlessly format 1234567
as
1.234567e6
when doing so doesn't actually make the representation more
compact.
Since: 0.2.1
setSeparatorGroupSizes :: (Base -> [Int]) -> Config -> Config Source #
Set the separator spacing for NumericUnderscores, or disable underscores.
The list of group sizes is used working leftwards from the radix point. If the list runs out, no further separators will be inserted.
[4, 3, 2, 2] : 123456000000 => 1_23_45_600_0000 repeat 3 : 123456000000 => 123_456_000_000 [1] : 123456000000 => 12345600000_0
This allows both the conventional US separator placement of every three
digits by providing cycle 3
, as well as more complex spacings such as
3 : repeat 2
reportedly used in India.
Backends should not cache these lists, and should attempt to use them in a single-use, streaming manner, so that large portions of infinite lists are not held in memory. Clients should assume returning infinite lists is fine.
Since: 0.2.1
Colorization
data SyntaxClass Source #
The kind of syntactic element represented by an annotated Doc
.
Constructors
Identifier IdentKind | Identifiers, whether alphanumeric names or operators. |
Literal LitKind | Literals, including integers, floats/rationals, chars, and strings. |
EscapeSequence | Escaped characters in strings and char literals. |
Keyword | Alphanumeric keywords, e.g. |
Bracket | Matched pairs of symbols that denote nesting, e.g. parens. |
Separator | Syntactic separators/terminators, e.g. |
Structural | Other fixed syntactic symbols, e.g. |
The particular kind of literal represented by a Literal
.
defaultStyling :: SyntaxClass -> Maybe AnsiStyle Source #
A fairly arbitrary colorization style based on what looked good to me.
To use a custom color mapping, define it the same way this function is
defined, then use it as an argument to styleShowPortrayal
.
Consider also wrapping that up into a custom pp
function for use at the
REPL or even as the interactive print function.
subtleStyling :: SyntaxClass -> Maybe AnsiStyle Source #
A subtler style that colorizes only operators (blue) and literals (cyan).
With Associativity
type DocAssocPrec ann = Assoc -> Rational -> Doc ann Source #
A Doc
that varies according to associativity and precedence context.
toDocAssocPrecF :: Config -> PortrayalF (DocAssocPrec SyntaxClass) -> DocAssocPrec SyntaxClass Source #
Render one layer of PortrayalF
to DocAssocPrec
.
toDocAssocPrec :: Config -> Portrayal -> DocAssocPrec SyntaxClass Source #
Convenience Functions
portrayalToDoc :: Config -> Portrayal -> Doc SyntaxClass Source #
styleShowPortrayal :: Config -> (SyntaxClass -> Maybe AnsiStyle) -> Portrayal -> Text Source #
styleShowPortrayalLazy :: Config -> (SyntaxClass -> Maybe AnsiStyle) -> Portrayal -> Text Source #
A lazy Text
variant of styleShowPortrayal
.
Since: 0.2.1
prettyShowPortrayal :: Portrayal -> Text Source #
prettyShowPortrayalLazy :: Portrayal -> Text Source #
A lazy Text
variant of prettyShowPortrayal
.
Since: 0.2.1