{- text based table generation
 -
 - Copyright 2014 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

module Utility.Table where

type Table = [[String]]

-- | A table with a header that is set off with lines under each
-- header item.
tableWithHeader :: [String] -> [[String]] -> Table
tableWithHeader :: [String] -> [[String]] -> [[String]]
tableWithHeader [String]
header [[String]]
rows = [String]
header forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. [a] -> String
linesep [String]
header forall a. a -> [a] -> [a]
: [[String]]
rows
  where
	linesep :: [a] -> String
linesep = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Char
'-')

-- | Formats a table to lines, automatically padding columns to the same size.
formatTable :: Table -> [String]
formatTable :: [[String]] -> [String]
formatTable [[String]]
table = forall a b. (a -> b) -> [a] -> [b]
map (\[String]
r -> [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
pad (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
r [Int]
colsizes))) [[String]]
table
  where
	pad :: (String, Int) -> String
pad (String
cell, Int
size) = String
cell forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take (Int
size forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cell) String
padding
	padding :: String
padding = forall a. a -> [a]
repeat Char
' '
	colsizes :: [Int]
colsizes = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (Int
0forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
		forall {c}. (Num c, Ord c) => [[c]] -> [c]
sumcols (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
table)
	sumcols :: [[c]] -> [c]
sumcols [] = forall a. a -> [a]
repeat c
0
	sumcols [[c]
r] = [c]
r
	sumcols ([c]
r1:[c]
r2:[[c]]
rs) = [[c]] -> [c]
sumcols forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Ord a => a -> a -> a
max [c]
r1 [c]
r2 forall a. a -> [a] -> [a]
: [[c]]
rs