Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Darcs pretty printing library
The combinator names are taken from HughesPJ
, although
the behaviour of the two libraries is slightly different.
This code was made generic in the element type by Juliusz Chroboczek.
Synopsis
- newtype Doc = Doc {
- unDoc :: St -> Document
- empty :: Doc
- (<>) :: Semigroup a => a -> a -> a
- (<?>) :: Doc -> Doc -> Doc
- (<+>) :: Doc -> Doc -> Doc
- ($$) :: Doc -> Doc -> Doc
- ($+$) :: Doc -> Doc -> Doc
- vcat :: [Doc] -> Doc
- vsep :: [Doc] -> Doc
- hcat :: [Doc] -> Doc
- hsep :: [Doc] -> Doc
- minus :: Doc
- newline :: Doc
- plus :: Doc
- space :: Doc
- backslash :: Doc
- lparen :: Doc
- rparen :: Doc
- parens :: Doc -> Doc
- sentence :: Doc -> Doc
- text :: String -> Doc
- hiddenText :: String -> Doc
- invisibleText :: String -> Doc
- wrapText :: Int -> String -> Doc
- quoted :: String -> Doc
- formatText :: Int -> [String] -> Doc
- formatWords :: [String] -> Doc
- pathlist :: [FilePath] -> Doc
- userchunk :: String -> Doc
- packedString :: ByteString -> Doc
- prefix :: String -> Doc -> Doc
- hiddenPrefix :: String -> Doc -> Doc
- insertBeforeLastline :: Doc -> Doc -> Doc
- prefixLines :: Doc -> Doc -> Doc
- invisiblePS :: ByteString -> Doc
- userchunkPS :: ByteString -> Doc
- renderString :: Doc -> String
- renderStringWith :: Printers' -> Doc -> String
- renderPS :: Doc -> ByteString
- renderPSWith :: Printers' -> Doc -> ByteString
- renderPSs :: Doc -> [ByteString]
- renderPSsWith :: Printers' -> Doc -> [ByteString]
- type Printers = Handle -> IO Printers'
- data Printers' = Printers {
- colorP :: !(Color -> Printer)
- invisibleP :: !Printer
- hiddenP :: !Printer
- userchunkP :: !Printer
- defP :: !Printer
- lineColorT :: !(Color -> Doc -> Doc)
- lineColorS :: !([Printable] -> [Printable])
- type Printer = Printable -> St -> Document
- simplePrinters :: Printers
- invisiblePrinter :: Printer
- simplePrinter :: Printer
- data Printable
- = S !String
- | PS !ByteString
- | Both !String !ByteString
- doc :: ([Printable] -> [Printable]) -> Doc
- printable :: Printable -> Doc
- invisiblePrintable :: Printable -> Doc
- hiddenPrintable :: Printable -> Doc
- userchunkPrintable :: Printable -> Doc
- data Color
- blueText :: String -> Doc
- redText :: String -> Doc
- greenText :: String -> Doc
- magentaText :: String -> Doc
- cyanText :: String -> Doc
- colorText :: Color -> String -> Doc
- lineColor :: Color -> Doc -> Doc
- hPutDoc :: Handle -> Doc -> IO ()
- hPutDocLn :: Handle -> Doc -> IO ()
- putDoc :: Doc -> IO ()
- putDocLn :: Doc -> IO ()
- hPutDocWith :: Printers -> Handle -> Doc -> IO ()
- hPutDocLnWith :: Printers -> Handle -> Doc -> IO ()
- putDocWith :: Printers -> Doc -> IO ()
- putDocLnWith :: Printers -> Doc -> IO ()
- hPutDocCompr :: Handle -> Doc -> IO ()
- debugDocLn :: Doc -> IO ()
- unsafeText :: String -> Doc
- unsafeBoth :: String -> ByteString -> Doc
- unsafeBothText :: String -> Doc
- unsafeChar :: Char -> Doc
- unsafePackedString :: ByteString -> Doc
Doc
type and structural combinators
A Doc
is a bit of enriched text. Doc
s are concatenated using
<>
from class Monoid
, which is right-associative.
(<>) :: Semigroup a => a -> a -> a infixr 6 #
An associative operation.
>>>
[1,2,3] <> [4,5,6]
[1,2,3,4,5,6]
(<+>) :: Doc -> Doc -> Doc infixr 6 Source #
a
is <+>
ba
followed by b
with a space in between if both are non-empty
($+$) :: Doc -> Doc -> Doc infixr 5 Source #
a
is $+$
ba
above b
with an empty line in between if both are non-empty
Constructing Doc
s
invisibleText :: String -> Doc Source #
invisibleText
creates a Doc
containing invisible text from a String
formatWords :: [String] -> Doc Source #
A variant of wrapText
that takes a list of strings as input.
Useful when {-# LANGUAGE CPP #-}
makes it impossible to use multiline
string literals.
pathlist :: [FilePath] -> Doc Source #
Format a list of FilePath
s as quoted text. It deliberately refuses to
use English.andClauses but rather separates the quoted strings only with a
space, because this makes it usable for copy and paste e.g. as arguments to
another shell command.
userchunk :: String -> Doc Source #
Create a Doc
containing a userchunk from a String
.
Userchunks are used for printing arbitrary bytes stored in prim patches:
- old and new preference values in ChangePref prims
- tokenChars, old token and new token in TokReplace prims
- old and new content lines in Hunk prims
In colored mode they are printed such that trailing whitespace before the
end of a line is made visible by marking the actual line ending with a red
$
char (unless DARCS_DONT_ESCAPE_TRAILING_SPACES or even
DARCS_DONT_ESCAPE_ANYTHING are set in the environment).
packedString :: ByteString -> Doc Source #
packedString
builds a Doc
from a ByteString
using printable
invisiblePS :: ByteString -> Doc Source #
invisiblePS
creates a Doc
with invisible text from a ByteString
userchunkPS :: ByteString -> Doc Source #
Create a Doc
representing a user chunk from a ByteString
;
see userchunk
for details.
Rendering to String
renderString :: Doc -> String Source #
Rendering to ByteString
renderPS :: Doc -> ByteString Source #
renders a Doc
into ByteString
with control codes for the
special features of the Doc. See also readerString
.
renderPSWith :: Printers' -> Doc -> ByteString Source #
renders a Doc
into a ByteString
using a given set of printers.
renderPSs :: Doc -> [ByteString] Source #
renders a Doc
into a list of PackedStrings
, one for each line.
renderPSsWith :: Printers' -> Doc -> [ByteString] Source #
Printers
A set of printers to print different types of text to a handle.
Printers | |
|
simplePrinters :: Printers Source #
simplePrinters
is a Printers
which uses the set 'simplePriners'' on any
handle.
invisiblePrinter :: Printer Source #
invisiblePrinter
is the Printer
for hidden text. It just replaces
the document with empty
. It's useful to have a printer that doesn't
actually do anything because this allows you to have tunable policies,
for example, only printing some text if it's to the terminal, but not
if it's to a file or vice-versa.
simplePrinter :: Printer Source #
simplePrinter
is the simplest Printer
: it just concatenates together
the pieces of the Doc
Printables
A Printable
is either a String, a packed string, or a chunk of
text with both representations.
S !String | |
PS !ByteString | |
Both !String !ByteString |
userchunkPrintable :: Printable -> Doc Source #
Constructing colored Doc
s
magentaText :: String -> Doc Source #
IO, uses hPut
for output
hPutDoc :: Handle -> Doc -> IO () Source #
hputDoc
puts a Doc
on the given handle using simplePrinters
hPutDocLn :: Handle -> Doc -> IO () Source #
hputDocLn
puts a Doc
, followed by a newline on the given handle using
simplePrinters
.
putDocLn :: Doc -> IO () Source #
putDocLn
puts a Doc
, followed by a newline on stdout using
simplePrinters
hPutDocWith :: Printers -> Handle -> Doc -> IO () Source #
hputDocWith
puts a Doc
on the given handle using the given printer.
hPutDocLnWith :: Printers -> Handle -> Doc -> IO () Source #
hputDocLnWith
puts a Doc
, followed by a newline on the given
handle using the given printer.
putDocWith :: Printers -> Doc -> IO () Source #
putDocWith
puts a Doc
on stdout using the given printer.
putDocLnWith :: Printers -> Doc -> IO () Source #
putDocLnWith
puts a Doc
, followed by a newline on stdout using
the given printer.
TODO: It is unclear what is unsafe about these constructors
unsafeText :: String -> Doc Source #
unsafeText
creates a Doc
from a String
, using simplePrinter
directly
unsafeBoth :: String -> ByteString -> Doc Source #
unsafeBoth
builds a Doc from a String
and a ByteString
representing
the same text, but does not check that they do.
unsafeBothText :: String -> Doc Source #
unsafeBothText
builds a Doc
from a String
. The string is stored in the
Doc as both a String and a ByteString
.
unsafeChar :: Char -> Doc Source #
unsafeChar
creates a Doc containing just one character.
unsafePackedString :: ByteString -> Doc Source #
unsafePackedString
builds a Doc
from a ByteString
using simplePrinter