{-# 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 :: [Column] -> Doc
renderTable = [(ColumnWidth, Column)] -> Doc
renderColumnsWithWidth ([(ColumnWidth, Column)] -> Doc)
-> ([Column] -> [(ColumnWidth, Column)]) -> [Column] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> (ColumnWidth, Column))
-> [Column] -> [(ColumnWidth, Column)]
forall a b. (a -> b) -> [a] -> [b]
map (\column :: Column
column -> (Column -> ColumnWidth
findColumnWidth Column
column, Column
column))


findColumnWidth :: Column -> Int
findColumnWidth :: Column -> ColumnWidth
findColumnWidth SeperatorColumn = 0
findColumnWidth (Column cells :: [Cell]
cells)  = [ColumnWidth] -> ColumnWidth
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Cell -> ColumnWidth) -> [Cell] -> [ColumnWidth]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> ColumnWidth
findCellWidth [Cell]
cells)

findCellWidth :: Cell -> Int
findCellWidth :: Cell -> ColumnWidth
findCellWidth (TextCell doc :: Doc
doc) = [ColumnWidth] -> ColumnWidth
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 ColumnWidth -> [ColumnWidth] -> [ColumnWidth]
forall a. a -> [a] -> [a]
: ([Char] -> ColumnWidth) -> [[Char]] -> [ColumnWidth]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ColumnWidth
forall (t :: * -> *) a. Foldable t => t a -> ColumnWidth
length ([Char] -> [[Char]]
lines (Doc -> ShowS
forall a. Show a => a -> ShowS
shows Doc
doc "")))
findCellWidth SeperatorCell  = 0


renderColumnsWithWidth :: [(ColumnWidth, Column)] -> Doc
renderColumnsWithWidth :: [(ColumnWidth, Column)] -> Doc
renderColumnsWithWidth columns :: [(ColumnWidth, Column)]
columns
  | ((ColumnWidth, Column) -> Bool) -> [(ColumnWidth, Column)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Column -> Bool
columnFinished (Column -> Bool)
-> ((ColumnWidth, Column) -> Column)
-> (ColumnWidth, Column)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnWidth, Column) -> Column
forall a b. (a, b) -> b
snd) [(ColumnWidth, Column)]
columns
  = Doc
empty
  | Bool
otherwise
  = Doc
first_cells_str Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    [(ColumnWidth, Column)] -> Doc
renderColumnsWithWidth (((ColumnWidth, Column) -> (ColumnWidth, Column))
-> [(ColumnWidth, Column)] -> [(ColumnWidth, Column)]
forall a b. (a -> b) -> [a] -> [b]
map ((Column -> Column)
-> (ColumnWidth, Column) -> (ColumnWidth, Column)
forall b c a. (b -> c) -> (a, b) -> (a, c)
onRight Column -> Column
columnDropHead) [(ColumnWidth, Column)]
columns)
  where
    first_cells_str :: Doc
first_cells_str = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((ColumnWidth, Column) -> Bool -> Doc)
-> [(ColumnWidth, Column)] -> [Bool] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((ColumnWidth -> Column -> Bool -> Doc)
-> (ColumnWidth, Column) -> Bool -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ColumnWidth -> Column -> Bool -> Doc
renderFirstColumnCell) [(ColumnWidth, Column)]
columns ([Column] -> [Bool]
eitherSideSeperator (((ColumnWidth, Column) -> Column)
-> [(ColumnWidth, Column)] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnWidth, Column) -> Column
forall a b. (a, b) -> b
snd [(ColumnWidth, Column)]
columns))


eitherSideSeperator :: [Column] -> [Bool]
eitherSideSeperator :: [Column] -> [Bool]
eitherSideSeperator columns :: [Column]
columns = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(||) (Bool
FalseBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
column_is_seperator) ([Bool] -> [Bool]
forall a. [a] -> [a]
tail [Bool]
column_is_seperator [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
False])
  where
    column_is_seperator :: [Bool]
column_is_seperator = (Column -> Bool) -> [Column] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Column -> Bool
isSeperatorColumn [Column]
columns

isSeperatorColumn :: Column -> Bool
isSeperatorColumn :: Column -> Bool
isSeperatorColumn SeperatorColumn = Bool
False
isSeperatorColumn (Column cells :: [Cell]
cells)  = case [Cell]
cells of
    []       -> Bool
False
    (cell :: Cell
cell:_) -> Cell -> Bool
isSeperatorCell Cell
cell

isSeperatorCell :: Cell -> Bool
isSeperatorCell :: Cell -> Bool
isSeperatorCell SeperatorCell = Bool
True
isSeperatorCell _             = Bool
False


renderFirstColumnCell :: ColumnWidth -> Column -> Bool -> Doc
renderFirstColumnCell :: ColumnWidth -> Column -> Bool -> Doc
renderFirstColumnCell column_width :: ColumnWidth
column_width (Column cells :: [Cell]
cells) _ = case [Cell]
cells of
    []                    -> [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ ColumnWidth -> Char -> [Char]
forall a. ColumnWidth -> a -> [a]
replicate (ColumnWidth
column_width ColumnWidth -> ColumnWidth -> ColumnWidth
forall a. Num a => a -> a -> a
+ 2) ' '
    (SeperatorCell:_)     -> [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ ColumnWidth -> Char -> [Char]
forall a. ColumnWidth -> a -> [a]
replicate (ColumnWidth
column_width ColumnWidth -> ColumnWidth -> ColumnWidth
forall a. Num a => a -> a -> a
+ 2) '-'
    (TextCell contents :: Doc
contents:_) -> Char -> Doc
char ' ' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ColumnWidth -> Doc -> Doc
fill ColumnWidth
column_width Doc
contents Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char ' '
renderFirstColumnCell _ SeperatorColumn either_side_seperator :: Bool
either_side_seperator 
  = if Bool
either_side_seperator then Char -> Doc
char '+' else Char -> Doc
char '|'

columnFinished :: Column -> Bool
columnFinished :: Column -> Bool
columnFinished (Column cells :: [Cell]
cells)  = [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cell]
cells
columnFinished SeperatorColumn = Bool
True

columnDropHead :: Column -> Column
columnDropHead :: Column -> Column
columnDropHead (Column cells :: [Cell]
cells)  = [Cell] -> Column
Column (ColumnWidth -> [Cell] -> [Cell]
forall a. ColumnWidth -> [a] -> [a]
drop 1 [Cell]
cells)
columnDropHead SeperatorColumn = Column
SeperatorColumn