Pretty-printed tables in Haskell

Question

Purpose

A clean, reusable module to generate pretty tables (much like those in SQL-clients), like so:

+--------+--------+--------+
| HEADER | HEADER | HEADER |
+--------+--------+--------+
| CELL | CELL | CELL |
+--------+--------+--------+
| CELL | CELL | CELL |
+--------+--------+--------+
| CELL | CELL | CELL |
+--------+--------+--------+

Description

Something I often stumble upon (I don't even know why, seems like I just very much like tables) is prettily printing a table from... anything. As most solutions I see align the data but don't seperate cells, I decided to roll my own to use every so often. For the format, I took a liking to the way SQL clients usually return the data, which is what I aim to replicate. Generally, tables are surrounded by hyphen (-) and pipe (|) delimiters, forming crosses using a plus (+). Every cell has at least one space to the left and right; header cells are centered, all other cells ('data' cells) are left-padded.

The Code

module Tablefy
 ( tablefy
 ) where
import Prelude hiding (Left, Right)
import Data.List (intercalate, intersperse, transpose)
-- | Constructs a pretty table. @tablefy h rs@ constructs a table using the
-- elements of @h@ as headers and each list in @rs@ as row. If any list in
-- @rs@ has a length different than the length from @h@, this function throws
-- an error.
--
-- The table is returned in the following format:
--
-- @
-- +--------+--------+--------+
-- | HEADER | HEADER | HEADER |
-- +--------+--------+--------+
-- | CELL | CELL | CELL |
-- +--------+--------+--------+
-- | CELL | CELL | CELL |
-- +--------+--------+--------+
-- | CELL | CELL | CELL |
-- +--------+--------+--------+
-- @
--
-- Header cells are centrally padded, data cells are left padded; both use
-- a single space as fill character.
tablefy :: [String] -> [[String]] -> String
tablefy h rs
 | any (/= length h) (map length rs) = error "Tablefy.tablefy: Differences in length"
 | otherwise = table
 where
 table = unlines $ insert' sep (header:rows)
 widths = map (maximum . map length) (transpose (h:rs))
 sep = insert "+" $ map (flip replicate '-' . (+2)) widths
 header = mkRow Center h
 rows = map (mkRow Left) rs
 mkRow a = insert "|" . zipWith (mkCell a) widths
 mkCell a n xs = " " ++ pad a n ' ' xs ++ " "
-- | @insert x xs@ prepends and appends @x@ to the result of @intercalate x xs@.
--
-- >>> insert "#" ["Alpha","Beta","Gamma"]
-- "#Alpha#Beta#Gamma#"
insert :: [a] -> [[a]] -> [a]
insert x xs = intercalate x ([] : xs ++ [[]])
-- | Version of 'insert' that uses 'intersperse' instead of 'intercalate'.
--
-- >>> insert' "#" ["Alpha","Beta","Gamma"]
-- >>> ["#", "Alpha", "#", "Beta", "#", "Gamma", "#"]
insert' :: [a] -> [[a]] -> [[a]]
insert' x xs = intersperse x ([] : xs ++ [[]])
-- | Alignment is a simple sum type containing the different modes of padding.
data Alignment = Left | Right | Center deriving Eq
-- | @pad a n x xs@ pads the given list @xs@ using the element @x@ to make sure
-- it has length @n@. Exceeding elements are cut off. If @a@ is 'Left', the
-- fill element is appended. If @a@ is 'Right', the fill element is prepended.
-- If @a@ is 'Center', the fill element is both appended and prepended. If an
-- odd number of fills needs to be inserted, there will be one more element
-- appended than there will be prepended.
--
-- >>> pad Center 6 ' ' "Hello"
-- "Hello "
--
-- >>> pad Center 9 '-' "Hello"
-- "--Hello--"
--
-- >>> pad Right 3 'x' "Hello"
-- "Hel"
pad :: Alignment -> Int -> a -> [a] -> [a]
pad a n x xs
 | n < 1 = error "Tablefy.pad: Length must not be smaller than one"
 | n <= length xs = take n xs
 | a == Left = xs ++ replicate (n - length xs) x
 | a == Right = replicate (n - length xs) x ++ xs
 | a == Center = let (space, extra) = quotRem (n - length xs) 2
 in replicate space x ++ xs ++ replicate (space + extra) x

What to pick on

I'd like to hear everything that comes to mind, with a small focus on ease-of-use and encapsulation. Maybe I'll even add customization to the tables in the near future, if you'd guess this to be a pain then please express your concerns as well!

Answer 1

This is not bad code, but I would encourage you to look at the Text.PrettyPrint.Boxes module for some ideas.

A first step would be to reimplement what you have using that library. You might find it interesting to think in terms of columns as opposed to rows.

Update:

Since you said you already looked at that package, here is one way to use it.

 import Text.PrettyPrint.Boxes
 import Data.List
 pad width x = x ++ replicate k ' '
 where k = width - length x
 fmt_column :: [String] -> Box
 fmt_column items = hsep // vcat left (intersperse hsep (map (text.pad width) items)) // hsep
 where width = maximum $ map length items
 hsep = text ( replicate width '-' )
 table :: [[String]] -> Box
 table rows = vsep <> hcat top (intersperse vsep (map fmt_column columns)) <> vsep
 where
 columns = transpose rows
 nrows = length rows
 vsep = vcat left $ map char ("+" ++ (concat $ replicate nrows "|+")) 

Some example usage:

 test1 = putStrLn $ render $ fmt_column ["one", "two", "three", "four", "seven" ]
 test2 = putStrLn $ render $
 table [ ["h1", "head2", "h3" ],
 ["one", "two", "three" ]
 ]

• Phil Kiener: I actually took a look at that library, but as far as I have seen there is no support for separators as I'd like them to have. May also be I've just overlooked them... As for the colums vs. rows thing, my data typically comes in rows, and when printed it does get printed row after row. I'd like to keep the actual flow as it is, not transpose it twice.
• ErikR: Updated answer with some example code.
• Phil Kiener: Seems like I didn't take a long enough look, that library sure does work for my needs. Guess I'll take a shot at reimplementing, maybe it'll be just fine.

Answer 2

I don't know if that is actually a thing, but a few days worth of reflection made me do a self-review.

Naming

I really like my insert and insert' functions, as they perfectly handle placing the pipes and plusses or even the seperator rows. But the name is... misleading, at best. A different name capturing the essence of these functions would be way better.

Alignments constructors conflict with the Prelude, as I have used Left and Right. This is okay for the current scope, but since I plan to add customizability, this is not a good idea, especially for something as common as Either. Simplest approach would be LeftAlign and RightAlign, I should go with that for now. Makes it clearer, too, as one no longer has to wonder whether the text gets aligned to the left or have spaces inserted on the left-hand side.

The pad function

I like it. I really like it! But there is some duplication to create the amount of spaces needed. A nice way to remove that would be to use a where clause for the common parts:

pad :: Alignment -> Int -> a -> [a] -> [a]
pad a n x xs
 | n < 1 = error "Tablefy.pad: Length must not be smaller than one"
 | n <= length xs = take n xs
 | a == Left = xs ++ take diff fill
 | a == Right = take diff fill ++ xs
 | a == Center = let (space, extra) = quotRem diff 2
 in take space fill ++ xs ++ take (space + extra) fill
 where
 diff = n - length xs
 fill = repeat x

One can even go further and remove all the take diff fill parts!

pad :: Alignment -> Int -> a -> [a] -> [a]
pad a n x xs
 | n < 1 = error "Tablefy.pad: Length must not be smaller than one"
 | n <= length xs = take n xs
 | a == Left = xs ++ fill
 | a == Right = fill ++ xs
 | a == Center = let (front, back) = splitAt (diff `div` 2) fill
 in front ++ xs ++ back
 where
 fill = replicate diff x
 diff = n - length xs

Adding customizability

It does work well for what it's supposed to do. But maybe, someday, I'd like to change the padding for some cells (think numbers, which are typically aligned right). I'd have to either pass Text-Alignment tuples... or step up the game.

Stepping up the game

Instead of passing a list of strings for the header and a list of lists of strings for the actual cells, I could pass in a list of lists of Cells (or a list of rows, same difference).

type Cell = String

But how would that benefit me?

cell :: String -> Alignment -> Cell

The signature should be enough to hint at what I plan to do. One could go even further and do...

cell' :: (a -> String) -> a -> Alignment -> Cell

To really display any kind of data. Should be very useful to print currencies, where it's just e.g. (\n -> '€':show n).

tablefy would then only care about placing the symbols to seperate the cells. Huge win for encapsulation! To make it more robust, I'd use a newtype instead, so one has to use cell.

Configuration Object

But what if I ever want to use a different symbol than a hyphen? I could pass all three symbols as parameters... or use a configuration object.

data TableConfig
 = TableConfig
 { verticalSep :: Char
 , horizontalSep :: Char
 , crossSep :: Char
 , verticalPadding :: Int
 , horizontalPadding :: Int
 }
defaultConfig = TableConfig '|' '-' '+' 0 1

Then I could define two functions:

tablefy :: [[Cell]] -> String
tablefy = tablefy' defaultConfig
tablefy' :: TableConfig -> [[Cell]] -> String
tablefy' = do stuff!

The actual tablefy would thus change drastically, so I don't extensively review that one.

The heart of it all: tablefy

In retrospect, I'd probably change behaviour on what happens when the rows do not have equal length. One could even pass the actual behaviour as a parameter! Cut off excess, fill with blanks or error (as is) would be the three choices that spring to mind.

I'd reorganize all the where clauses as well. table has no need to exist, that one can go into the main function. widths can stay as-is. sep has a magic (+2) in it that should be explained; it does make sense to me, but when reading the code for the first time, one has to think about why it's there (hint: all text has at least one space to the left and right, which is not counted into widths).

As far as I have seen, mkSomething is typically used for TemplateHaskell. As such, I'd rename those two buildRow and buildCell or something else.

• Zeta: "I don't know if that is actually a thing, but a few days worth of reflection made me do a self-review." It is, don't worry.

Answer 3

Since others have already offered suggestions, my review will not be complete. However, I did notice some things.

1. Don't use error. Instead, use a sum type for your errors and return an Either SumType String in tablefy. For example:

   data TableError = BadLegnth | PadLength
   instance Show TableError where
    show BadLength = "tablefy: differences in length"
    show PadLength = "pad: length must be greater than zero."
   pad :: Alignment -> Int -> a -> [a] -> [a]
   pad a n x xs
    | n < 1 = Left PadLength
    | n <= length xs = Right $ take n xs
   

2. Strings are almost always the wrong choice. The expression xs ++ [[]] looks innocuous, but it's \$O(n)\,ドル so we should use another data structure. Haskell has a number of really pleasant pretty printing libraries, so there's no reason to deal with (++) being \$O(n)\$ or whatever.

3. In general, be careful to not traverse data structures twice. Haskell makes it possible to write very efficient traversals, but often there is an easier "wrong" way. A lot of the algorithms for lists have far worse algorithmic complexity than those for arrays - this doesn't always bite you because of laziness and fusion, but you should still get in the habit of writing functions that use one traversal.

4. Your insert function is more elegantly expressed as

   insert :: [a] -> [[a]] -> [a]
   insert = concat . insert'
   

5. Your documentation is very good. Far above most of what's on Hackage. This is definitely a good thing, but do be aware that haddocks aren't generated for functions that your module doesn't export.

• Phil Kiener: How could I not have noticed concat . insert'! And it is exactly because many packages on hackage lack proper documentation that I picked up the habit of writing documentation even for hidden stuff... I wonder if there is an easy way to generate a "maintainers documentation" that includes everything...
• user141259: I believe with cabal there is a haddock-internal option you can set to True in your cabal.project.local file, if you use it :)
• Phil Kiener: Just found out it works with stack as well - thanks for the tip!