{-# 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 -> ColumnWidth findColumnWidth Column column, Column column)) findColumnWidth :: Column -> Int findColumnWidth :: Column -> ColumnWidth findColumnWidth Column SeperatorColumn = ColumnWidth 0 findColumnWidth (Column [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) = [ColumnWidth] -> ColumnWidth forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum (ColumnWidth 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 [Char] ""))) findCellWidth Cell SeperatorCell = ColumnWidth 0 renderColumnsWithWidth :: [(ColumnWidth, Column)] -> Doc renderColumnsWithWidth :: [(ColumnWidth, Column)] -> Doc renderColumnsWithWidth [(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 [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 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 :: ColumnWidth -> Column -> Bool -> Doc renderFirstColumnCell ColumnWidth column_width (Column [Cell] cells) Bool _ = 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 + ColumnWidth 2) Char ' ' (Cell SeperatorCell:[Cell] _) -> [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 + ColumnWidth 2) Char '-' (TextCell Doc contents:[Cell] _) -> Char -> Doc char 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 Char ' ' renderFirstColumnCell ColumnWidth _ 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 (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 (ColumnWidth -> [Cell] -> [Cell] forall a. ColumnWidth -> [a] -> [a] drop ColumnWidth 1 [Cell] cells) columnDropHead Column SeperatorColumn = Column SeperatorColumn