Safe Haskell | None |
---|---|
Language | Haskell2010 |
Let's make a table!
> let Just (Object
o1) =decode
"{\"foo\": \"bar\"}" > let Just (Object
o2) =decode
"{\"baz\": 5}" > let Just (Object
o3) =decode
"{\"oink\": true}" > let slice1 = [[Just o1, Just o3], [Just o2, Nothing]] > let slice2 = [[Nothing, Just o1]] >pretty
(makeTable
["object 1", "object 2"] [slice1, slice2, slice1]) +-----------+------------+ | object 1 | object 2 | | | | | baz foo | foo oink | +===========+============+ | "bar" | True | | 5.0 | | +-----------+------------+ | | "bar" | +-----------+------------+ | "bar" | True | | 5.0 | | +-----------+------------+
- data Table
- type TableRow a = [Maybe a]
- type TableSlice a = [TableRow a]
- makeTable :: [String] -> [TableSlice Object] -> Table
- makeTableWith :: forall header key value. (Ord key, Hashable key) => (Int -> header -> String) -> (Int -> header -> (Int, Int) -> key -> String) -> (Int -> header -> (Int, Int) -> key -> value -> String) -> [header] -> [TableSlice (HashMap key value)] -> Table
- prettyValue :: Value -> String
- flattenObject :: Object -> Object
- data Doc e :: * -> *
- putDoc :: Doc e -> IO ()
- hPutDoc :: Handle -> Doc e -> IO ()
- class Pretty a where
- data SimpleDoc e :: * -> *
- renderPretty :: Float -> Int -> Doc e -> SimpleDoc e
- renderCompact :: Doc e -> SimpleDoc e
- renderSmart :: Int -> Doc e -> SimpleDoc e
- displayS :: SimpleDoc e -> ShowS
- displayIO :: Handle -> SimpleDoc e -> IO ()
Documentation
type TableSlice a = [TableRow a] Source #
:: [String] | Headers |
-> [TableSlice Object] | Table slices |
-> Table |
Make a Table
from a list of headers and a list of TableSlice
s, each of
which contains a list of TableRow
s, each of which contain a list of
Object
s. It is assumed that all dimensions align properly (e.g. each row
contains the same number of elements, which is equal to the length of the
list of headers).
Each top-level object is flattened into one column per leaf. Note that this
means it is not possible to distinguish between e.g. {"foo":{"bar":5}}
and {"foo.bar":5}
. Hopefully this is not too much of a problem in
practice.
Each vertically aligned element need not contain the same set of keys; for example, the table corresponding to
[ [{"foo": "bar"}], [{"baz": "qux"}] ] -- one TableSlice
will simply look like
+-------------+ | foo baz | +=============+ | "bar" | | "qux" | +-------------+
That is, each missing value is simply not displayed.
:: (Ord key, Hashable key) | |
=> (Int -> header -> String) | Header rendering function |
-> (Int -> header -> (Int, Int) -> key -> String) | Cell header rendering function |
-> (Int -> header -> (Int, Int) -> key -> value -> String) | Cell rendering function |
-> [header] | Headers |
-> [TableSlice (HashMap key value)] | Table slices |
-> Table |
Like makeTable
, but takes explicit rendering functions. This is useful for
adding ANSI escape codes to color output, or for rendering values depending on
what their key is.
For example, you may wish to render String
s with a
"timestamp"
key without quotation marks.
The Int
argument is the header's index. The (Int, Int)
argument is the
(absolute, relative)
index of the key and value. Visually,
+-------------+-------------+ | 0 | 1 | | | | | (0,0) (1,1) | (2,0) (3,1) | +=============+=============+ | (0,0) (1,1) | (2,0) (3,1) | | (0,0) (1,1) | (2,0) (3,1) | +-------------+-------------+
This function is (unfortunately) String
-based as of 0.3.0.0, because the
pretty printing and ANSI escape code functions are String
-based, too.
Misc. helper functions
flattenObject :: Object -> Object Source #
Re-exports
The abstract data type Doc
represents pretty documents.
Doc
is an instance of the Show
class. (show doc)
pretty
prints document doc
with a page width of 100 characters and a
ribbon width of 40 characters.
show (text "hello" `above` text "world")
Which would return the string "hello\nworld", i.e.
hello world
The action (putDoc doc)
pretty prints document doc
to the
standard output, with a page width of 100 characters and a ribbon
width of 40 characters.
main :: IO () main = do{ putDoc (text "hello" <+> text "world") }
Which would output
hello world
hPutDoc :: Handle -> Doc e -> IO () #
(hPutDoc handle doc)
pretty prints document doc
to the file
handle handle
with a page width of 100 characters and a ribbon
width of 40 characters.
main = do{ handle <- openFile "MyFile" WriteMode ; hPutDoc handle (vcat (map text ["vertical","text"])) ; hClose handle }
The member prettyList
is only used to define the instance Pretty
a => Pretty [a]
. In normal circumstances only the pretty
function
is used.
Pretty Bool | |
Pretty Char | |
Pretty Double | |
Pretty Float | |
Pretty Int | |
Pretty Int8 | |
Pretty Int16 | |
Pretty Int32 | |
Pretty Int64 | |
Pretty Integer | |
Pretty Natural | |
Pretty Word | |
Pretty Word8 | |
Pretty Word16 | |
Pretty Word32 | |
Pretty Word64 | |
Pretty () | |
Pretty ByteString | |
Pretty ByteString | |
Pretty Text | |
Pretty Text | |
Pretty Table # | |
Pretty a => Pretty [a] | |
Pretty a => Pretty (Maybe a) | |
Pretty a => Pretty (NonEmpty a) | |
Pretty a => Pretty (Seq a) | |
Pretty (Doc a) | |
(Pretty a, Pretty b) => Pretty (a, b) | |
(Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) | |
The data type SimpleDoc
represents rendered documents and is
used by the display functions.
The Int
in SText
contains the length of the string. The Int
in SLine
contains the indentation for that line. The library
provides two default display functions displayS
and
displayIO
. You can provide your own display function by writing a
function from a SimpleDoc
to your own output format.
renderPretty :: Float -> Int -> Doc e -> SimpleDoc e #
This is the default pretty printer which is used by show
,
putDoc
and hPutDoc
. (renderPretty ribbonfrac width x)
renders
document x
with a page width of width
and a ribbon width of
(ribbonfrac * width)
characters. The ribbon width is the maximal
amount of non-indentation characters on a line. The parameter
ribbonfrac
should be between 0.0
and 1.0
. If it is lower or
higher, the ribbon width will be 0 or width
respectively.
renderCompact :: Doc e -> SimpleDoc e #
(renderCompact x)
renders document x
without adding any
indentation. Since no 'pretty' printing is involved, this
renderer is very fast. The resulting output contains fewer
characters than a pretty printed version and can be used for output
that is read by other programs.
renderSmart :: Int -> Doc e -> SimpleDoc e #
A slightly smarter rendering algorithm with more lookahead. It provides
provide earlier breaking on deeply nested structures.
For example, consider this python-ish pseudocode:
fun(fun(fun(fun(fun([abcdefg, abcdefg])))))
If we put a softbreak (+ nesting 2) after each open parenthesis, and align
the elements of the list to match the opening brackets, this will render with
renderPretty
and a page width of 20c as:
fun(fun(fun(fun(fun([
| abcdef,
| abcdef,
]
))))) |
Where the 20c. boundary has been marked with |. Because renderPretty
only
uses one-line lookahead, it sees that the first line fits, and is stuck
putting the second and third lines after the 20c mark. In contrast,
renderSmart
will continue to check the potential document up to the end of
the indentation level. Thus, it will format the document as:
fun( | fun( | fun( | fun( | fun([ | abcdef, abcdef, ] | ))))) |
Which fits within the 20c. mark.
In addition, renderSmart
uses this lookahead to minimize the number of
lines printed, leading to more compact and visually appealing output.
Consider this example using the same syntax as above:
aaaaaaaaaaa([abc, def, ghi])
When rendered with renderPretty
and a page width of 20c, we get:
aaaaaaaaaaa([ abc
, def
, ghi ])
Whereas when rendered with renderSmart
and a page width of 20c, we get:
aaaaaaaaaaa(
[abc, def, ghi])