    {-# 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