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

import Test.Framework.Utilities

import Text.PrettyPrint.ANSI.Leijen hiding (column)


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