diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Changelog for safe-coloured-text-layout +## [0.2.0.0] - 2024-06-23 + +### Added + +* `layoutAsTableLines` +* `renderTableLines` + +### Changed + +* Table cells are now lists of chunks instead of individual chunks. + ## [0.1.0.0] - 2024-03-26 ### Changed diff --git a/safe-coloured-text-layout.cabal b/safe-coloured-text-layout.cabal --- a/safe-coloured-text-layout.cabal +++ b/safe-coloured-text-layout.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: safe-coloured-text-layout -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Safely layout output coloured text category: User Interfaces homepage: https://github.com/NorfairKing/safe-coloured-text#readme diff --git a/src/Text/Colour/Layout.hs b/src/Text/Colour/Layout.hs --- a/src/Text/Colour/Layout.hs +++ b/src/Text/Colour/Layout.hs @@ -1,13 +1,16 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} module Text.Colour.Layout ( layoutAsTable, + layoutAsTableLines, table, Table (..), TableBackground (..), renderTable, + renderTableLines, ) where @@ -17,15 +20,19 @@ import Data.Validity import GHC.Generics (Generic) import Text.Colour +import Text.Colour.Chunk -- | Render as a default-settings table. -layoutAsTable :: [[Chunk]] -> [Chunk] +layoutAsTable :: [[[Chunk]]] -> [Chunk] layoutAsTable = renderTable . table +layoutAsTableLines :: [[[Chunk]]] -> [[Chunk]] +layoutAsTableLines = renderTableLines . table + -- | Make a table with default settings -- -- You can then update table settings by changing the fields in the resulting 'Table'. -table :: [[Chunk]] -> Table +table :: [[[Chunk]]] -> Table table cs = Table { tableCells = cs, @@ -35,8 +42,8 @@ -- | Table with separator and background settings data Table = Table - { -- | A list of rows. They must be of the same length. - tableCells :: [[Chunk]], + { -- | A list of rows. They must be of the same total length. + tableCells :: [[[Chunk]]], tableColumnSeparator :: Chunk, tableBackground :: Maybe TableBackground } @@ -47,52 +54,72 @@ data TableBackground = SingleColour Colour | Bicolour + -- Even-numbered table rows (0-indexed) (Maybe Colour) - -- ^ Even-numbered table rows (0-indexed) + -- Odd-numbered table rows (Maybe Colour) - -- ^ Odd-numbered table rows deriving (Show, Eq, Generic) instance Validity TableBackground -- | Render a table to chunks that can be rendered to text. renderTable :: Table -> [Chunk] -renderTable Table {..} = - let asColumns = transpose (padRows tableCells) - addLengthsToColumn :: [Chunk] -> [(Int, Chunk)] - addLengthsToColumn = map (\c -> (T.length (chunkText c), c)) - maxLengthOfColum :: [(Int, Chunk)] -> Int +renderTable = unlinesChunks . renderTableLines + +renderTableLines :: Table -> [[Chunk]] +renderTableLines Table {..} = + let asColumns :: [[[Chunk]]] + asColumns = transpose (padRows [] tableCells) + + addLengthsToColumn :: [[Chunk]] -> [(Int, [Chunk])] + addLengthsToColumn = map (\c -> (cellWidth c, c)) + maxLengthOfColum :: [(Int, [Chunk])] -> Int maxLengthOfColum = maximum . map fst - padColumn :: Int -> [(Int, Chunk)] -> [(Chunk, Chunk)] - padColumn maxLength = map (\(l, c) -> (c, paddingChunk (maxLength - l) ' ')) - padEntireColumn :: [(Int, Chunk)] -> [(Chunk, Chunk)] + padColumn :: Int -> [(Int, [Chunk])] -> [[Chunk]] + padColumn maxLength = map (\(l, c) -> c ++ [paddingChunk (maxLength - l) ' ']) + padEntireColumn :: [(Int, [Chunk])] -> [[Chunk]] padEntireColumn col = let maxLength = maxLengthOfColum col in padColumn maxLength col - paddedColumns :: [[(Chunk, Chunk)]] + paddedColumns :: [[[Chunk]]] paddedColumns = map (padEntireColumn . addLengthsToColumn) asColumns - paddedRows :: [[(Chunk, Chunk)]] + paddedRows :: [[[Chunk]]] paddedRows = transpose paddedColumns + withBg :: Int -> Chunk -> Chunk withBg i = possiblyAddBackground $ backgroundForRow i tableBackground - renderRow :: Int -> [(Chunk, Chunk)] -> [Chunk] + renderRow :: Int -> [[Chunk]] -> [Chunk] renderRow i = go where - go [] = ["\n"] - go [(c, p)] = withBg i c : withBg i p : go [] - go ((c1, p1) : t2 : rest) = withBg i c1 : withBg i p1 : withBg i tableColumnSeparator : go (t2 : rest) - in concat $ iterateLikeInPython renderRow paddedRows + go :: [[Chunk]] -> [Chunk] + go [] = [] + go [cs] = map (withBg i) cs ++ go [] + go (cs1 : cs2 : rest) = + map (withBg i) cs1 + ++ [withBg i tableColumnSeparator] + ++ go (cs2 : rest) + in iterateLikeInPython renderRow paddedRows iterateLikeInPython :: (Int -> a -> b) -> [a] -> [b] iterateLikeInPython f = zipWith f [0 ..] -padRows :: [[Chunk]] -> [[Chunk]] -padRows [] = [] -padRows css = - let withLengths = map (\ls -> (length ls, ls)) css +-- | Make every row contain the same number of cells, irrespective of the +-- width of the cells. +-- +-- Use the first argument to fill as the extra cells. +padRows :: forall a. a -> [[a]] -> [[a]] +padRows _ [] = [] +padRows d css = + let withLengths :: [(Int, [a])] + withLengths = map (\ls -> (length ls, ls)) css + maximumLength :: Int maximumLength = maximum $ map fst withLengths - pad (l, cs) = cs ++ replicate (maximumLength - l) "" + pad :: (Int, [a]) -> [a] + pad (l, cs) = cs ++ replicate (maximumLength - l) d in map pad withLengths + +cellWidth :: [Chunk] -> Int +cellWidth = sum . map chunkWidth paddingChunk :: Int -> Char -> Chunk paddingChunk l c = chunk $ T.pack $ replicate l c diff --git a/test/Text/Colour/LayoutSpec.hs b/test/Text/Colour/LayoutSpec.hs --- a/test/Text/Colour/LayoutSpec.hs +++ b/test/Text/Colour/LayoutSpec.hs @@ -17,10 +17,10 @@ ( renderChunksText With24BitColours ( layoutAsTable - [ ["this"], - ["is"], - ["a"], - ["list"] + [ [["this"]], + [["is"]], + [["a"]], + [["list"]] ] ) ) @@ -30,10 +30,10 @@ ( renderChunksText With24BitColours ( layoutAsTable - [ ["this", "this"], - ["is", "is"], - ["a", "another"], - ["list", "list"] + [ [["this"], ["this"]], + [["is"], ["is"]], + [["a"], ["another"]], + [["list"], ["list"]] ] ) ) @@ -43,9 +43,9 @@ ( renderChunksText With24BitColours ( layoutAsTable - [ ["what", "the", ""], - ["is", "this", "", "-ing", ""], - ["I", "don't", "understand", "one", "", "of", "it"] + [ [["what"], ["the"], []], + [["is"], ["this"], [], ["-ing"], []], + [["I"], ["don't"], ["understand"], ["one"], [], ["of"], ["it"]] ] ) ) @@ -55,7 +55,7 @@ ( renderChunksText With24BitColours ( renderTable $ - ( table $ [[chunk (T.pack (show (x + y))) | x <- [0 :: Int .. 9]] | y <- [0 :: Int .. 9]] + ( table $ [[[chunk (T.pack (show (x + y)))] | x <- [0 :: Int .. 9]] | y <- [0 :: Int .. 9]] ) { tableColumnSeparator = "@" } @@ -67,7 +67,7 @@ ( renderChunksText With24BitColours ( renderTable $ - ( table $ [[fore red $ chunk (T.pack (show (x ^ y))) | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]] + ( table $ [[[fore red $ chunk (T.pack (show (x ^ y)))] | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]] ) { tableBackground = Just (SingleColour black) } @@ -79,7 +79,7 @@ ( renderChunksText With24BitColours ( renderTable $ - ( table $ [[fore red $ chunk (T.pack (show (x ^ y))) | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]] + ( table $ [[[fore red $ chunk (T.pack (show (x ^ y)))] | x <- [0 :: Int .. 4]] | y <- [0 :: Int .. 4]] ) { tableBackground = Just (Bicolour (Just black) (Just brightBlack)) }