{-# LANGUAGE CPP #-}

module Test.Framework.Runners.Console.Table (
        Cell(..), Column(..), renderTable
    ) where

import Test.Framework.Utilities

import Text.PrettyPrint.ANSI.Leijen
    ( (<>), char, empty, fill, hcat, line, text, Doc )

data Cell = TextCell Doc
          | SeperatorCell

data Column = Column [Cell]
            | SeperatorColumn

type ColumnWidth = Int

renderTable :: [Column] -> Doc
renderTable :: [Column] -> Doc
renderTable = [(Int, Column)] -> Doc
renderColumnsWithWidth ([(Int, Column)] -> Doc)
-> ([Column] -> [(Int, Column)]) -> [Column] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> (Int, Column)) -> [Column] -> [(Int, Column)]
forall a b. (a -> b) -> [a] -> [b]
map (\Column
column -> (Column -> Int
findColumnWidth Column
column, Column
column))


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

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


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


eitherSideSeperator :: [Column] -> [Bool]
eitherSideSeperator :: [Column] -> [Bool]
eitherSideSeperator [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. HasCallStack => [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 Column
SeperatorColumn = Bool
False
isSeperatorColumn (Column [Cell]
cells)  = case [Cell]
cells of
    []       -> Bool
False
    (Cell
cell:[Cell]
_) -> Cell -> Bool
isSeperatorCell Cell
cell

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


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

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

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