1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE CPP #-}
module Test.Framework.Runners.Console.Table (
Cell(..), Column(..), renderTable
) where
import Test.Framework.Utilities
#if MIN_VERSION_ansi_wl_pprint(0,6,6)
import Text.PrettyPrint.ANSI.Leijen hiding (column, columns)
#else
import Text.PrettyPrint.ANSI.Leijen hiding (column)
#endif
data Cell = TextCell Doc
| SeperatorCell
data Column = Column [Cell]
| SeperatorColumn
type ColumnWidth = Int
renderTable :: [Column] -> Doc
renderTable = renderColumnsWithWidth . map (\column -> (findColumnWidth column, column))
findColumnWidth :: Column -> Int
findColumnWidth SeperatorColumn = 0
findColumnWidth (Column cells) = maximum (map findCellWidth cells)
findCellWidth :: Cell -> Int
findCellWidth (TextCell doc) = maximum (0 : map length (lines (shows doc "")))
findCellWidth SeperatorCell = 0
renderColumnsWithWidth :: [(ColumnWidth, Column)] -> Doc
renderColumnsWithWidth columns
| all (columnFinished . snd) columns
= empty
| otherwise
= first_cells_str <> line <>
renderColumnsWithWidth (map (onRight columnDropHead) columns)
where
first_cells_str = hcat $ zipWith (uncurry renderFirstColumnCell) columns (eitherSideSeperator (map snd columns))
eitherSideSeperator :: [Column] -> [Bool]
eitherSideSeperator columns = zipWith (||) (False:column_is_seperator) (tail column_is_seperator ++ [False])
where
column_is_seperator = map isSeperatorColumn columns
isSeperatorColumn :: Column -> Bool
isSeperatorColumn SeperatorColumn = False
isSeperatorColumn (Column cells) = case cells of
[] -> False
(cell:_) -> isSeperatorCell cell
isSeperatorCell :: Cell -> Bool
isSeperatorCell SeperatorCell = True
isSeperatorCell _ = False
renderFirstColumnCell :: ColumnWidth -> Column -> Bool -> Doc
renderFirstColumnCell column_width (Column cells) _ = case cells of
[] -> text $ replicate (column_width + 2) ' '
(SeperatorCell:_) -> text $ replicate (column_width + 2) '-'
(TextCell contents:_) -> char ' ' <> fill column_width contents <> char ' '
renderFirstColumnCell _ SeperatorColumn either_side_seperator
= if either_side_seperator then char '+' else char '|'
columnFinished :: Column -> Bool
columnFinished (Column cells) = null cells
columnFinished SeperatorColumn = True
columnDropHead :: Column -> Column
columnDropHead (Column cells) = Column (drop 1 cells)
columnDropHead SeperatorColumn = SeperatorColumn
|
