{-# LANGUAGE TemplateHaskell #-} -- | Functions and types to build 'BicolorTable's. Everything you should -- typically need is exported from "Rainbox". module Rainbox.BicolorTable where import Control.Lens import Data.Foldable (foldl') import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Rainbow import qualified Rainbow.Types as R import Rainbox.Core import System.IO -- | A single line within a cell in a 'BicolorTable'. For each -- 'Chunk', leave the 'back' as the default if you want the 'Chunk' -- background to match '_bctEvenBackground' or '_bctOddBackground'. -- If you specify a background color for any 'Chunk', it will for -- that 'Chunk' override the table's background color. type BicolorTableCellLine = Seq Chunk -- | The set of all lines within a cell in a 'BicolorTable'. type BicolorTableCell = Seq BicolorTableCellLine -- | The set of all columns in a single row. If any single row is -- narrower than the widest row in the table, it will be padded with -- empty cells so that it is the same width as the widest row in the -- table. type BicolorTableRow = Seq BicolorTableCell -- | Description for a table with rows of alternating background colors. For -- instance, if designed for a terminal with a white background, the -- row backgrounds might alternate between white and light grey. -- The different backgrounds help with readability. -- -- For the 'Chunk' that are in the table, simply leave the 'back' -- color blank if you wish to use the row's background color. Upon -- rendering, 'bicolorTable' will render the 'Chunk' with a -- background color that matches that of the row. If you specify a -- background color for a 'Chunk', it will override the background -- color for the row. -- -- Note that a row may contain more than one line of text. -- -- Unlike tables built with 'tableByRows' or 'tableByColumns', all -- tables built with 'bicolorTable' will have separator colums -- between each column. data BicolorTable = BicolorTable { _bctEvenBackground :: Radiant -- ^ Background color for all even-numbered rows. Row numbering -- starts with zero. To use the terminal's default background color, use -- 'mempty'. , _bctOddBackground :: Radiant -- ^ Background color for all odd-colored rows. Row numbering -- starts with zero. To use the terminal's default background color, use -- 'mempty'. , _bctSpacerWidth :: Int -- ^ The width of each column of spacer cells. , _bctAlignments :: Seq (Alignment Vertical) -- ^ Specifies the alignment for each column in the table. If any -- row in '_bctRows' is longer than this 'Seq', each extra column -- is assumed to have an alignment 'left'. , _bctRows :: Seq BicolorTableRow -- ^ Specifies all the textual and color data for the -- BicolorTable. The outermost 'Seq' is the set of all rows. -- These will alternate in background color bewteen -- '_bctEvenBackground' and '_bctOddBackground'. This is a -- Russian doll of nested 'Seq'; the type synonyms help explain -- the types. } deriving Show makeLenses ''BicolorTable -- | Transforms a 'BicolorTable' to a 'Box'. bicolorTableToBox :: BicolorTable -> Box Vertical bicolorTableToBox = tableByRows . bicolorToPlainTable -- | Creates a bi-color table and renders it to the given 'Handle' -- using 'bicolorTable' and 'hPutBox'. hPutBicolorTable :: Handle -> BicolorTable -> IO () hPutBicolorTable h = hPutBox h . bicolorTableToBox -- | Creates a bi-color table and renders it to standard output -- using 'hPutBicolorTable'. putBicolorTable :: BicolorTable -> IO () putBicolorTable = hPutBicolorTable stdout -- | Convert a 'Chunk' for rendering by substituting the table's -- row background for the chunk's row background if applicable. convertChunkForRendering :: Radiant -- ^ Background for this row -> Chunk -> Chunk convertChunkForRendering rad chk = chk & over (R.scheme . R.style8 . R.back) newBack8 & over (R.scheme . R.style256 . R.back) newBack256 where newBack8 (R.Color Nothing) = R._color8 rad newBack8 x = x newBack256 (R.Color Nothing) = R._color256 rad newBack256 x = x -- | Converts a 'BicolorTableCellLine' for rendering. convertBicolorTableCellLineForRendering :: Radiant -> BicolorTableCellLine -> BicolorTableCellLine convertBicolorTableCellLineForRendering rad = fmap (convertChunkForRendering rad) -- | Converts a 'BicolorTableCell' for rendering. convertBicolorTableCellForRendering :: Radiant -> BicolorTableCell -> BicolorTableCell convertBicolorTableCellForRendering rad = fmap (convertBicolorTableCellLineForRendering rad) -- | Convert a BicolorTable cell to a plain Cell. Does all necessary Chunk -- conversions. bicolorToPlainCell :: Radiant -- ^ Appropriate background color -> Alignment Vertical -- ^ Column alignment -> BicolorTableCell -> Cell bicolorToPlainCell rad align bic = Cell rws top align rad where rws = convertBicolorTableCellForRendering rad bic -- | Convert a BicolorTable row to a plain Row. Does all necessary Chunk conversions. -- Includes spacer cells. bicolorToPlainRow :: Radiant -- ^ Background color for even rows -> Radiant -- ^ Background color for odd rows -> Int -- ^ Width of spacer cells -> Int -- ^ Number for this row -> Seq (Alignment Vertical) -- ^ Column alignments -> BicolorTableRow -> Seq Cell bicolorToPlainRow bkgdEven bkgdOdd sepWidth colNum aligns = Seq.intersperse spcr . Seq.zipWith (bicolorToPlainCell bkgd) aligns where bkgd | even colNum = bkgdEven | otherwise = bkgdOdd spcr = separator bkgd sepWidth -- | Converts a BicolorTable table to a plain table with 'Cell'. Does all -- necessary Chunk conversions, and includes spacer cells. bicolorToPlainTable :: BicolorTable -> Seq (Seq Cell) bicolorToPlainTable bct = Seq.mapWithIndex f rws where (BicolorTable bkgdEven bkgdOdd sepWidth aligns rws) = padBicolorTable bct f rowIdx = bicolorToPlainRow bkgdEven bkgdOdd sepWidth rowIdx aligns -- | Pads out '_bctAlignments' so that it is as long as the longest -- row in the table, and pads out each row in '_bctRows' so that it -- is as long as the longest row in the table. padBicolorTable :: BicolorTable -> BicolorTable padBicolorTable bct = bct & over bctRows padRows & over bctAlignments padAligns where maxLen = foldl' max 0 . fmap Seq.length . _bctRows $ bct padRows = fmap pad where pad row = row <> Seq.replicate (max 0 (maxLen - Seq.length row)) Seq.empty padAligns aligns = aligns <> Seq.replicate (max 0 (maxLen - Seq.length aligns)) left