From d64a8154eafa9ae0c436ffb571ea56047518f0f7 Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Tue, 1 Nov 2022 19:16:07 +0100 Subject: [PATCH 1/7] Add TableSpec Refactor arguments of table functions into a separate type and provide smart constructors which ease creation. --- src/Test.hs | 51 +++++++++---------- src/Text/Layout/Table.hs | 49 ++++++------------ src/Text/Layout/Table/Spec/TableSpec.hs | 66 +++++++++++++++++++++++++ table-layout.cabal | 3 ++ 4 files changed, 110 insertions(+), 59 deletions(-) create mode 100644 src/Text/Layout/Table/Spec/TableSpec.hs diff --git a/src/Test.hs b/src/Test.hs index d75994e..572f825 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -12,37 +12,38 @@ inheritMyStyle = inheritStyleHeaderGroup makeLineSolid id (fst . style) (snd . s style TinySep = (SingleLine, NoLine) main :: IO () -main = putStrLn $ tableString [ column (expandUntil 30) left (charAlign ':') ellipsisCutMark - , column expand center noAlign noCutMark - ] - unicodeRoundS - noneH - (titlesH ["Layout", "Result"]) - rowGroups +main = putStrLn $ tableString $ columnHeaderTableS + [ column (expandUntil 30) left (charAlign ':') ellipsisCutMark + , column expand center noAlign noCutMark + ] + unicodeRoundS + (titlesH ["Layout", "Result"]) + rowGroups where rowGroups = flip concatMap styles $ \style -> flip map columTs $ \(cSpec, is) -> colsAllG center [ is , genTable cSpec style ] - genTable c s = tableLines (repeat c) - s - (fullSepH DashLine (repeat $ headerColumn right Nothing) ["1", "Two"]) - (groupH BigSep - [ fullSepH SmallSep (repeat defHeaderColSpec) ["Some text", "Some numbers", "X"] - , groupH SmallSep - [ fullSepH TinySep (repeat defHeaderColSpec) ["Z", "W"] - , fullSepH TinySep (repeat defHeaderColSpec) ["A", "B"] - ] - , fullSepH TinySep (repeat defHeaderColSpec) ["Text", "Y"] - ] - ) - [ rowsG [ [longText, smallNum, "foo", "blah", "bloo", "blop", "blog", shortText, "baz"] - , [shortText, bigNum, "bar", "yadda", "yoda", "yeeda", "york", shortText, "wibble"] - ] - , rowsG [ [longText, smallNum, "foo", "bibbidy", "babbidy", "boo", "blue", shortText, "wobble" ] - ] - ] + genTable c s = tableLines $ fullTableS + (repeat c) + s + (fullSepH DashLine (repeat $ headerColumn right Nothing) ["1", "Two"]) + (groupH BigSep + [ fullSepH SmallSep (repeat defHeaderColSpec) ["Some text", "Some numbers", "X"] + , groupH SmallSep + [ fullSepH TinySep (repeat defHeaderColSpec) ["Z", "W"] + , fullSepH TinySep (repeat defHeaderColSpec) ["A", "B"] + ] + , fullSepH TinySep (repeat defHeaderColSpec) ["Text", "Y"] + ] + ) + [ rowsG [ [longText, smallNum, "foo", "blah", "bloo", "blop", "blog", shortText, "baz"] + , [shortText, bigNum, "bar", "yadda", "yoda", "yeeda", "york", shortText, "wibble"] + ] + , rowsG [ [longText, smallNum, "foo", "bibbidy", "babbidy", "boo", "blue", shortText, "wobble" ] + ] + ] longText = "This is long text" shortText = "Short" bigNum = "200300400500600.2" diff --git a/src/Text/Layout/Table.hs b/src/Text/Layout/Table.hs index 381079a..49dd805 100644 --- a/src/Text/Layout/Table.hs +++ b/src/Text/Layout/Table.hs @@ -88,6 +88,9 @@ module Text.Layout.Table , flattenHeader , headerContents + -- ** Specifying tables + , module Text.Layout.Table.Spec.TableSpec + -- ** Layout , tableLines , tableLinesB @@ -164,6 +167,7 @@ import Text.Layout.Table.Spec.LenSpec import Text.Layout.Table.Spec.OccSpec import Text.Layout.Table.Spec.Position import Text.Layout.Table.Spec.RowGroup +import Text.Layout.Table.Spec.TableSpec import Text.Layout.Table.Spec.Util import Text.Layout.Table.StringBuilder import Text.Layout.Table.Style @@ -275,27 +279,18 @@ colsAllG p = nullableRowsG . colsAsRowsAll p -- layout specifications than columns or vice versa will result in not showing -- the redundant ones. tableLinesB :: (Cell a, Cell r, Cell c, StringBuilder b) - => [ColSpec] -- ^ Layout specification of columns - -> TableStyle hSep vSep -- ^ Visual table style - -> HeaderSpec hSep r -- ^ Optional row header details - -> HeaderSpec vSep c -- ^ Optional column header details - -> [RowGroup a] -- ^ Rows which form a cell together + => TableSpec hSep vSep r c a -> [b] -tableLinesB specs style rowHeader colHeader = - fst . tableLinesBWithCMIs specs style rowHeader colHeader +tableLinesB = fst . tableLinesBWithCMIs -- | Layouts a pretty table with an optional header. Note that providing fewer -- layout specifications than columns or vice versa will result in not showing -- the redundant ones. tableLinesBWithCMIs :: forall hSep r vSep c a b. (Cell a, Cell r, Cell c, StringBuilder b) - => [ColSpec] -- ^ Layout specification of columns - -> TableStyle hSep vSep -- ^ Visual table style - -> HeaderSpec hSep r -- ^ Optional row header details - -> HeaderSpec vSep c -- ^ Optional column header details - -> [RowGroup a] -- ^ Rows which form a cell together + => TableSpec hSep vSep r c a -> ([b], [ColModInfo]) -tableLinesBWithCMIs specs TableStyle { .. } rowHeader colHeader rowGroups = +tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = ( maybe id (:) optTopLine . addColHeader $ maybe id (\b -> (++[b])) optBottomLine rowGroupLines , cMIs ) @@ -418,9 +413,9 @@ tableLinesBWithCMIs specs TableStyle { .. } rowHeader colHeader rowGroups = emptyFromCMI = spacesB . widthCMI - cMSs = map cutMark specs - posSpecs = map position specs - cMIs = fitHeaderIntoCMIs $ deriveColModInfosFromColumns' specs $ transposeRowGroups rowGroups + cMSs = map cutMark colSpecs + posSpecs = map position colSpecs + cMIs = fitHeaderIntoCMIs $ deriveColModInfosFromColumns' colSpecs $ transposeRowGroups rowGroups rowMods = zipWith3 (\p cm cmi -> (emptyFromCMI cmi, columnModifier p cm cmi)) posSpecs cMSs cMIs rowBody :: RowGroup a -> [[b]] @@ -435,35 +430,21 @@ tableLinesBWithCMIs specs TableStyle { .. } rowHeader colHeader rowGroups = header cMI = fmap Just $ headerCellModifier hSpec noCutMark cMI r : repeat (emptyFromCMI cMI) applyRowMods (_, grp) = map (Nothing,) $ rowBody grp - -- | A version of 'tableLinesB' specialised to produce 'String's. tableLines :: (Cell a, Cell r, Cell c) - => [ColSpec] - -> TableStyle hSep vSep - -> HeaderSpec hSep r - -> HeaderSpec vSep c - -> [RowGroup a] + => TableSpec hSep vSep r c a -> [String] tableLines = tableLinesB -- | Does the same as 'tableLines', but concatenates lines. tableStringB :: (Cell a, Cell r, Cell c, StringBuilder b) - => [ColSpec] -- ^ Layout specification of columns - -> TableStyle hSep vSep -- ^ Visual table style - -> HeaderSpec hSep r -- ^ Optional row header details - -> HeaderSpec vSep c -- ^ Optional column header details - -> [RowGroup a] -- ^ Rows which form a cell together + => TableSpec hSep vSep r c a -> b -tableStringB specs style rowHeader colHeader rowGroups = - concatLines $ tableLinesB specs style rowHeader colHeader rowGroups +tableStringB = concatLines . tableLinesB -- | A version of 'tableStringB' specialised to produce 'String's. tableString :: (Cell a, Cell r, Cell c) - => [ColSpec] - -> TableStyle hSep vSep - -> HeaderSpec hSep r - -> HeaderSpec vSep c - -> [RowGroup a] + => TableSpec hSep vSep r c a -> String tableString = tableStringB diff --git a/src/Text/Layout/Table/Spec/TableSpec.hs b/src/Text/Layout/Table/Spec/TableSpec.hs new file mode 100644 index 0000000..d770806 --- /dev/null +++ b/src/Text/Layout/Table/Spec/TableSpec.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE RecordWildCards #-} +module Text.Layout.Table.Spec.TableSpec where + +import Data.Default.Class + +import Text.Layout.Table.Spec.ColSpec +import Text.Layout.Table.Spec.HeaderSpec +import Text.Layout.Table.Spec.RowGroup +import Text.Layout.Table.Style + +-- | Type used to specify tables. +data TableSpec hSep vSep r c a + = TableSpec + { colSpecs :: [ColSpec] + -- ^ Layout specification of the columns + , tableStyle :: TableStyle hSep vSep + -- ^ The style of the table + , rowHeader :: HeaderSpec hSep r + -- ^ Specification of the row header + , colHeader :: HeaderSpec vSep c + -- ^ Specification of the column header + , rowGroups :: [RowGroup a] + -- ^ A list of visually separated rows + } + +-- | Specify a table with the style and the row groups. +simpleTableS + :: (Default hSep, Default vSep) + => TableStyle hSep vSep + -> [RowGroup a] + -> TableSpec hSep vSep String String a +simpleTableS = headerlessTableS $ repeat defColSpec + +-- | Specify a table with the columns, the style, and the row groups. +headerlessTableS + :: (Default hSep, Default vSep) + => [ColSpec] + -> TableStyle hSep vSep + -> [RowGroup a] + -> TableSpec hSep vSep String String a +headerlessTableS colSpecs tableStyle rowGroups = TableSpec { .. } + where + rowHeader = noneH + colHeader = noneH + +-- | Specify a table without a row header. +columnHeaderTableS + :: Default hSep + => [ColSpec] + -> TableStyle hSep vSep + -> HeaderSpec vSep c + -> [RowGroup a] + -> TableSpec hSep vSep String c a +columnHeaderTableS colSpecs tableStyle colHeader rowGroups = TableSpec { .. } + where + rowHeader = noneH + +-- | Specify a table with everything. +fullTableS + :: [ColSpec] + -> TableStyle hSep vSep + -> HeaderSpec hSep r + -> HeaderSpec vSep c + -> [RowGroup a] + -> TableSpec hSep vSep r c a +fullTableS = TableSpec diff --git a/table-layout.cabal b/table-layout.cabal index 78e1cab..2ff43d4 100644 --- a/table-layout.cabal +++ b/table-layout.cabal @@ -79,6 +79,7 @@ library Text.Layout.Table.Spec.OccSpec, Text.Layout.Table.Spec.Position, Text.Layout.Table.Spec.RowGroup, + Text.Layout.Table.Spec.TableSpec, Text.Layout.Table.Spec.Util other-modules: @@ -133,6 +134,7 @@ executable table-layout-test-styles Text.Layout.Table.Spec.OccSpec, Text.Layout.Table.Spec.Position, Text.Layout.Table.Spec.RowGroup, + Text.Layout.Table.Spec.TableSpec, Text.Layout.Table.Spec.Util default-language: Haskell2010 @@ -177,6 +179,7 @@ test-suite table-layout-tests Text.Layout.Table.Spec.OccSpec, Text.Layout.Table.Spec.Position, Text.Layout.Table.Spec.RowGroup, + Text.Layout.Table.Spec.TableSpec, Text.Layout.Table.Spec.Util default-language: Haskell2010 From 4bfb1b71314626cacd57546552d750efbb888d4b Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Tue, 1 Nov 2022 19:17:09 +0100 Subject: [PATCH 2/7] Update documentation of HeaderSpec --- src/Text/Layout/Table/Spec/HeaderSpec.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/Text/Layout/Table/Spec/HeaderSpec.hs b/src/Text/Layout/Table/Spec/HeaderSpec.hs index f7ce5ba..d2567b2 100644 --- a/src/Text/Layout/Table/Spec/HeaderSpec.hs +++ b/src/Text/Layout/Table/Spec/HeaderSpec.hs @@ -28,7 +28,8 @@ instance Bifunctor HeaderSpec where instance Default sep => Default (HeaderSpec sep a) where def = defHeaderSpec --- | The default 'HeaderSpec' does not display the header and uses the default separator. +-- | The default 'HeaderSpec' does not display the header and uses the default +-- separator. defHeaderSpec :: Default sep => HeaderSpec sep a defHeaderSpec = NoneHS def @@ -40,11 +41,13 @@ noneSepH = NoneHS noneH :: Default sep => HeaderSpec sep String noneH = noneSepH def --- | Specify a header column for every title, with a given separator. +-- | Specify every header column in detail and separate them by the given +-- separator. fullSepH :: sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a fullSepH sep specs = GroupHS sep . zipWith HeaderHS specs --- | Specify a header column for every title, with a default separator. +-- | Specify every header column in detail and separate them with the default +-- separator. fullH :: Default sep => [HeaderColSpec] -> [a] -> HeaderSpec sep a fullH = fullSepH def @@ -52,11 +55,12 @@ fullH = fullSepH def titlesH :: Default sep => [a] -> HeaderSpec sep a titlesH = fullH (repeat defHeaderColSpec) --- | Use titles with the default header column specification. +-- | Combine the header specification for multiple columns by separating the +-- columns with a specific separator. groupH :: sep -> [HeaderSpec sep a] -> HeaderSpec sep a groupH = GroupHS --- | Use titles with the default header column specification. +-- | Specify the header for a single column. headerH :: HeaderColSpec -> a -> HeaderSpec sep a headerH = HeaderHS From 8713e6939c613c3f649e04524353e77a10ae8b65 Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Tue, 1 Nov 2022 19:23:37 +0100 Subject: [PATCH 3/7] Rename type variables for separators --- src/Text/Layout/Table.hs | 16 +++++------ src/Text/Layout/Table/Spec/TableSpec.hs | 36 ++++++++++++------------- src/Text/Layout/Table/Style.hs | 28 +++++++++---------- 3 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/Text/Layout/Table.hs b/src/Text/Layout/Table.hs index 49dd805..b61fd3e 100644 --- a/src/Text/Layout/Table.hs +++ b/src/Text/Layout/Table.hs @@ -279,16 +279,16 @@ colsAllG p = nullableRowsG . colsAsRowsAll p -- layout specifications than columns or vice versa will result in not showing -- the redundant ones. tableLinesB :: (Cell a, Cell r, Cell c, StringBuilder b) - => TableSpec hSep vSep r c a + => TableSpec rowSep colSep r c a -> [b] tableLinesB = fst . tableLinesBWithCMIs -- | Layouts a pretty table with an optional header. Note that providing fewer -- layout specifications than columns or vice versa will result in not showing -- the redundant ones. -tableLinesBWithCMIs :: forall hSep r vSep c a b. +tableLinesBWithCMIs :: forall rowSep r colSep c a b. (Cell a, Cell r, Cell c, StringBuilder b) - => TableSpec hSep vSep r c a + => TableSpec rowSep colSep r c a -> ([b], [ColModInfo]) tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = ( maybe id (:) optTopLine . addColHeader $ maybe id (\b -> (++[b])) optBottomLine rowGroupLines @@ -316,11 +316,11 @@ tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = flattenWithContent h _ r = flattenHeader . fmap fst $ zipHeader mempty r h -- | Intersperse a row with its rendered separators. - withRowSeparators :: (hSep -> Maybe b) -> [Row b] -> [Either (Maybe b) (Row b)] + withRowSeparators :: (rowSep -> Maybe b) -> [Row b] -> [Either (Maybe b) (Row b)] withRowSeparators renderDelimiter = map (first renderDelimiter) . flattenWithContent rowHeader rowGroups -- | Intersperse a column with its rendered separators, including an optional row header. - withColSeparators :: (vSep -> String) -> (Maybe b, Row b) -> (Maybe b, Row (Either String b)) + withColSeparators :: (colSep -> String) -> (Maybe b, Row b) -> (Maybe b, Row (Either String b)) withColSeparators renderDelimiter = second renderRow where renderRow = map (first renderIfDrawn) . flattenWithContent colHeader columns @@ -432,19 +432,19 @@ tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = -- | A version of 'tableLinesB' specialised to produce 'String's. tableLines :: (Cell a, Cell r, Cell c) - => TableSpec hSep vSep r c a + => TableSpec rowSep colSep r c a -> [String] tableLines = tableLinesB -- | Does the same as 'tableLines', but concatenates lines. tableStringB :: (Cell a, Cell r, Cell c, StringBuilder b) - => TableSpec hSep vSep r c a + => TableSpec rowSep colSep r c a -> b tableStringB = concatLines . tableLinesB -- | A version of 'tableStringB' specialised to produce 'String's. tableString :: (Cell a, Cell r, Cell c) - => TableSpec hSep vSep r c a + => TableSpec rowSep colSep r c a -> String tableString = tableStringB diff --git a/src/Text/Layout/Table/Spec/TableSpec.hs b/src/Text/Layout/Table/Spec/TableSpec.hs index d770806..1339d9f 100644 --- a/src/Text/Layout/Table/Spec/TableSpec.hs +++ b/src/Text/Layout/Table/Spec/TableSpec.hs @@ -9,15 +9,15 @@ import Text.Layout.Table.Spec.RowGroup import Text.Layout.Table.Style -- | Type used to specify tables. -data TableSpec hSep vSep r c a +data TableSpec rowSep colSep r c a = TableSpec { colSpecs :: [ColSpec] -- ^ Layout specification of the columns - , tableStyle :: TableStyle hSep vSep + , tableStyle :: TableStyle rowSep colSep -- ^ The style of the table - , rowHeader :: HeaderSpec hSep r + , rowHeader :: HeaderSpec rowSep r -- ^ Specification of the row header - , colHeader :: HeaderSpec vSep c + , colHeader :: HeaderSpec colSep c -- ^ Specification of the column header , rowGroups :: [RowGroup a] -- ^ A list of visually separated rows @@ -25,19 +25,19 @@ data TableSpec hSep vSep r c a -- | Specify a table with the style and the row groups. simpleTableS - :: (Default hSep, Default vSep) - => TableStyle hSep vSep + :: (Default rowSep, Default colSep) + => TableStyle rowSep colSep -> [RowGroup a] - -> TableSpec hSep vSep String String a + -> TableSpec rowSep colSep String String a simpleTableS = headerlessTableS $ repeat defColSpec -- | Specify a table with the columns, the style, and the row groups. headerlessTableS - :: (Default hSep, Default vSep) + :: (Default rowSep, Default colSep) => [ColSpec] - -> TableStyle hSep vSep + -> TableStyle rowSep colSep -> [RowGroup a] - -> TableSpec hSep vSep String String a + -> TableSpec rowSep colSep String String a headerlessTableS colSpecs tableStyle rowGroups = TableSpec { .. } where rowHeader = noneH @@ -45,12 +45,12 @@ headerlessTableS colSpecs tableStyle rowGroups = TableSpec { .. } -- | Specify a table without a row header. columnHeaderTableS - :: Default hSep + :: Default rowSep => [ColSpec] - -> TableStyle hSep vSep - -> HeaderSpec vSep c + -> TableStyle rowSep colSep + -> HeaderSpec colSep c -> [RowGroup a] - -> TableSpec hSep vSep String c a + -> TableSpec rowSep colSep String c a columnHeaderTableS colSpecs tableStyle colHeader rowGroups = TableSpec { .. } where rowHeader = noneH @@ -58,9 +58,9 @@ columnHeaderTableS colSpecs tableStyle colHeader rowGroups = TableSpec { .. } -- | Specify a table with everything. fullTableS :: [ColSpec] - -> TableStyle hSep vSep - -> HeaderSpec hSep r - -> HeaderSpec vSep c + -> TableStyle rowSep colSep + -> HeaderSpec rowSep r + -> HeaderSpec colSep c -> [RowGroup a] - -> TableSpec hSep vSep r c a + -> TableSpec rowSep colSep r c a fullTableS = TableSpec diff --git a/src/Text/Layout/Table/Style.hs b/src/Text/Layout/Table/Style.hs index b86d3d8..8597943 100644 --- a/src/Text/Layout/Table/Style.hs +++ b/src/Text/Layout/Table/Style.hs @@ -57,32 +57,32 @@ import Text.Layout.Table.LineStyle -- 3. 'unicodeTableStyleFromSpec' -- 4. 'asciiTableStyleFromSpec' -- 5. 'tableStyleFromSpec' -data TableStyle hSep vSep +data TableStyle rowSep colSep = TableStyle -- Within the column header but not the row header (11 cases) { headerSepH :: String , headerSepLC :: String , headerSepRC :: String - , headerSepC :: vSep -> vSep -> String + , headerSepC :: colSep -> colSep -> String , headerTopH :: String , headerTopL :: String , headerTopR :: String - , headerTopC :: vSep -> String + , headerTopC :: colSep -> String , headerL :: String , headerR :: String - , headerC :: vSep -> String + , headerC :: colSep -> String -- Within the row header but not the column header (11 cases) , rowHeaderSepV :: String , rowHeaderSepTC :: String , rowHeaderSepBC :: String - , rowHeaderSepC :: hSep -> hSep -> String + , rowHeaderSepC :: rowSep -> rowSep -> String , rowHeaderLeftV :: String , rowHeaderLeftT :: String , rowHeaderLeftB :: String - , rowHeaderLeftC :: hSep -> String + , rowHeaderLeftC :: rowSep -> String , rowHeaderT :: String , rowHeaderB :: String - , rowHeaderC :: hSep -> String + , rowHeaderC :: rowSep -> String -- Within the intersection of the row and column headers (8 cases) , bothHeadersTL :: String , bothHeadersTR :: String @@ -95,16 +95,16 @@ data TableStyle hSep vSep -- Main body of the table, in neither the row or column headers (15 cases) , groupL :: String , groupR :: String - , groupC :: vSep -> String - , groupSepH :: hSep -> String - , groupSepC :: hSep -> vSep -> String - , groupSepLC :: hSep -> String - , groupSepRC :: hSep -> String - , groupTopC :: vSep -> String + , groupC :: colSep -> String + , groupSepH :: rowSep -> String + , groupSepC :: rowSep -> colSep -> String + , groupSepLC :: rowSep -> String + , groupSepRC :: rowSep -> String + , groupTopC :: colSep -> String , groupTopL :: String , groupTopR :: String , groupTopH :: String - , groupBottomC :: vSep -> String + , groupBottomC :: colSep -> String , groupBottomL :: String , groupBottomR :: String , groupBottomH :: String From e4fa52d2c8e7a27453fb8d671ebd1eb196259824 Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Tue, 1 Nov 2022 19:43:44 +0100 Subject: [PATCH 4/7] Add expandBetween to example --- src/Test.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Test.hs b/src/Test.hs index 572f825..ca33a5c 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -61,8 +61,8 @@ main = putStrLn $ tableString $ columnHeaderTableS columTs = [ ( column l p a ellipsisCutMark , ["len spec: " ++ dL, "position: " ++ pL, "alignment: " ++ aL] ) - | (l, dL) <- zip [expand, fixed 10, expandUntil 10, fixedUntil 10] - ["expand", "fixed 10", "expand until 10", "fixed until 10"] + | (l, dL) <- zip [expand, fixed 10, expandUntil 10, fixedUntil 10, expandBetween 5 15] + ["expand", "fixed 10", "expand until 10", "fixed until 10", "expand [5, 15]"] , (p, pL) <- zip [left, right, center] ["left", "right", "center"] , (a, aL) <- zip [noAlign, dotAlign] ["no align", "align at '.'"] ] From 13063c758524109a93ff3579d3a3cd061f6e772b Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Tue, 1 Nov 2022 20:05:53 +0100 Subject: [PATCH 5/7] Update documentation * Restructure main module. * Capitalize titles. * Update outdated documentation. * Add missing documentation. * Clean up and simplify existing documentation. --- src/Text/Layout/Table.hs | 128 +++++++++++--------- src/Text/Layout/Table/Cell.hs | 69 +++++++---- src/Text/Layout/Table/Cell/Formatted.hs | 3 + src/Text/Layout/Table/LineStyle.hs | 6 +- src/Text/Layout/Table/Spec/AlignSpec.hs | 4 +- src/Text/Layout/Table/Spec/CutMark.hs | 7 +- src/Text/Layout/Table/Spec/HeaderColSpec.hs | 6 +- src/Text/Layout/Table/Style.hs | 23 ++-- 8 files changed, 143 insertions(+), 103 deletions(-) diff --git a/src/Text/Layout/Table.hs b/src/Text/Layout/Table.hs index b61fd3e..3dde99f 100644 --- a/src/Text/Layout/Table.hs +++ b/src/Text/Layout/Table.hs @@ -7,7 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Text.Layout.Table - ( -- * Layout combinators + ( -- * Column Layout -- | Specify how a column is rendered with the combinators in this -- section. Sensible default values are provided with 'def'. @@ -20,34 +20,35 @@ module Text.Layout.Table , fixedCol , fixedLeftCol , defColSpec - -- ** Length of columns + -- ** Length of Columns , LenSpec , expand , fixed , expandUntil , fixedUntil , expandBetween - -- ** Positional alignment + -- ** Positional Alignment , Position , H , left , right , center , beginning - -- ** Alignment of cells at characters + -- ** Alignment of Cells at Characters , AlignSpec , noAlign , charAlign , predAlign , dotAlign - -- ** Cut marks + -- ** Cut Marks , CutMark , noCutMark , singleCutMark , doubleCutMark , ellipsisCutMark - -- * Basic grid layout + -- * Grids + -- ** Rendering , Row , grid , gridB @@ -56,22 +57,45 @@ module Text.Layout.Table , gridLinesB , gridString , gridStringB + + -- ** Concatenating , concatRow , concatLines , concatGrid - -- * Grid modification functions + -- ** Modification Functions , altLines , checkeredCells - -- * Table layout - -- ** Grouping rows + -- * Tables + -- ** Grouping Rows + -- | Rows in character-based tables are separated by separator lines. + -- This section provides the tools to decide when this separation is + -- happening. Thus, several text rows may be in the same row of the + -- table. , RowGroup , rowsG , rowG + + -- *** Columns as Row Groups + -- | [Text justification](#text) may be used to turn text into + -- length-limited columns. Such columns may be turned into a 'RowGroup' + -- with 'colsG' or 'colsAllG'. , colsG , colsAllG + -- ** Specifying Tables + -- | The most basic `TableSpec` may be constructed by using `simpleTableS`. + , module Text.Layout.Table.Spec.TableSpec + + -- ** Rendering + -- | Render a 'TableSpec'. + , tableLines + , tableLinesB + , tableLinesBWithCMIs + , tableString + , tableStringB + -- ** Headers , HeaderColSpec , headerColumn @@ -84,38 +108,30 @@ module Text.Layout.Table , groupH , headerH , defHeaderColSpec - , zipHeader - , flattenHeader - , headerContents - -- ** Specifying tables - , module Text.Layout.Table.Spec.TableSpec + -- ** Styles + , module Text.Layout.Table.Style + , module Text.Layout.Table.LineStyle - -- ** Layout - , tableLines - , tableLinesB - , tableLinesBWithCMIs - , tableString - , tableStringB - -- * Text justification - -- $justify + -- * Multi-Row Cell Rendering + -- ** Text Justification + -- | #text# Split text and turn it into a column. Such columns may be + -- combined with other columns. , justify , justifyText - -- * Vertical column positioning + -- ** Vertical Column Positioning + -- | Turn rows of columns into a grid by aligning the columns. + , V + , top + , bottom , Col , colsAsRowsAll , colsAsRows - , top - , bottom - , V - - -- * Table styles - , module Text.Layout.Table.Style - , module Text.Layout.Table.LineStyle - -- * Column modification functions + -- * Custom Layout Generation + -- ** Column Modification Functions , pad , trim , trimOrPad @@ -124,7 +140,7 @@ module Text.Layout.Table , alignFixed , adjustCell - -- * Column modifaction primitives + -- ** Column Modifaction Primitives -- | These functions are provided to be reused. For example if someone -- wants to render their own kind of tables. , ColModInfo @@ -138,10 +154,14 @@ module Text.Layout.Table , deriveColModInfos , deriveAlignInfo , OccSpec + + -- ** Table Headers + , zipHeader + , flattenHeader + , headerContents ) where -- TODO AlignSpec: multiple alignment points - useful? --- TODO RowGroup: optional: vertical group labels -- TODO RowGroup: optional: provide extra layout for a RowGroup -- TODO ColSpec: add some kind of combinator to construct ColSpec values (e.g. via Monoid, see optparse-applicative) @@ -211,24 +231,23 @@ gridBWithCMIs specs tab = (zipWith4 columnModifier positions cms cMIs <$> tab, c positions = map position specs cms = map cutMark specs --- | A version of 'gridB' specialised to produce 'String's. +-- | A version of 'gridB' specialized to 'String'. grid :: Cell a => [ColSpec] -> [Row a] -> [Row String] grid = gridB --- | Behaves like 'grid' but produces lines by joining with whitespace. +-- | A version of 'gridB' that joins the cells of a row with one space. gridLinesB :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> [b] -gridLinesB specs = fmap (mconcat . intersperse (charB ' ')). gridB specs +gridLinesB specs = fmap (concatRow 1). gridB specs --- | A version of 'gridLinesB' specialised to produce 'String's. +-- | A version of 'gridLinesB' specialized to 'String'. gridLines :: Cell a => [ColSpec] -> [Row a] -> [String] gridLines = gridLinesB --- | Behaves like 'gridLines' but produces a string by joining with the newline --- character. +-- | A version of 'gridLinesB' that also concatenates the lines. gridStringB :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> b gridStringB specs = concatLines . gridLinesB specs --- | A version of 'gridStringB' specialised to produce 'String's. +-- | A version of 'gridStringB' specialized to 'String'. gridString :: Cell a => [ColSpec] -> [Row a] -> String gridString = gridStringB @@ -243,6 +262,8 @@ concatRow -> b concatRow n bs = mconcat $ intersperse (replicateCharB n ' ') bs +-- | Concatenates a whole grid with the given amount of horizontal spaces +-- between columns. concatGrid :: StringBuilder b => Int -> [Row b] -> b concatGrid n = concatLines . fmap (concatRow n) @@ -271,21 +292,21 @@ colsG :: [Position V] -> [Col a] -> RowGroup a colsG ps = nullableRowsG . colsAsRows ps -- | Create a 'RowGroup' by aligning the columns vertically. Each column uses --- the same vertical positioning. +-- the same position. colsAllG :: Position V -> [Col a] -> RowGroup a colsAllG p = nullableRowsG . colsAsRowsAll p --- | Layouts a pretty table with an optional header. Note that providing fewer --- layout specifications than columns or vice versa will result in not showing --- the redundant ones. +-- | Renders a table as 'StringBuilder' lines. Note that providing fewer layout +-- specifications than columns or vice versa will result in not showing the +-- redundant ones. tableLinesB :: (Cell a, Cell r, Cell c, StringBuilder b) => TableSpec rowSep colSep r c a -> [b] tableLinesB = fst . tableLinesBWithCMIs --- | Layouts a pretty table with an optional header. Note that providing fewer --- layout specifications than columns or vice versa will result in not showing --- the redundant ones. +-- | Renders a table as 'StringBuilder' lines, providing the 'ColModInfo' for +-- each column. Note that providing fewer layout specifications than columns or +-- vice versa will result in not showing the redundant ones. tableLinesBWithCMIs :: forall rowSep r colSep c a b. (Cell a, Cell r, Cell c, StringBuilder b) => TableSpec rowSep colSep r c a @@ -430,28 +451,21 @@ tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = header cMI = fmap Just $ headerCellModifier hSpec noCutMark cMI r : repeat (emptyFromCMI cMI) applyRowMods (_, grp) = map (Nothing,) $ rowBody grp --- | A version of 'tableLinesB' specialised to produce 'String's. +-- | A version of 'tableLinesB' specialized to 'String'. tableLines :: (Cell a, Cell r, Cell c) => TableSpec rowSep colSep r c a -> [String] tableLines = tableLinesB --- | Does the same as 'tableLines', but concatenates lines. +-- | A version of 'tableLinesB' that also concatenates the lines. tableStringB :: (Cell a, Cell r, Cell c, StringBuilder b) => TableSpec rowSep colSep r c a -> b tableStringB = concatLines . tableLinesB --- | A version of 'tableStringB' specialised to produce 'String's. +-- | A version of 'tableStringB' specialized to 'String'. tableString :: (Cell a, Cell r, Cell c) => TableSpec rowSep colSep r c a -> String tableString = tableStringB -------------------------------------------------------------------------------- --- Text justification -------------------------------------------------------------------------------- - --- $justify --- Text can easily be justified and distributed over multiple lines. Such --- columns can be combined with other columns. diff --git a/src/Text/Layout/Table/Cell.hs b/src/Text/Layout/Table/Cell.hs index 2d903c7..599b046 100644 --- a/src/Text/Layout/Table/Cell.hs +++ b/src/Text/Layout/Table/Cell.hs @@ -46,8 +46,8 @@ redistributeAdjustment l r a = CellView (baseCell a) lAdjustment rAdjustment lAdjustment = (totalAdjustment a * l) `div` (l + r) rAdjustment = totalAdjustment a - lAdjustment --- | Types that can be shortened, measured for visible characters, and turned --- into a 'StringBuilder'. +-- | Types that can be measured for visible characters, define a sub-string +-- operation and turned into a 'StringBuilder'. class Cell a where -- | Returns the length of the visible characters as displayed on the -- output medium. @@ -136,36 +136,38 @@ buildCellViewLRHelper build trimL trimR = -- trimming from the left and right simultaneously. -- -- Used to define instanced of 'Cell'. -buildCellViewBothHelper :: StringBuilder b - => (a -> b) -- ^ Builder function for 'a'. - -> (Int -> Int -> a -> a) -- ^ Function for trimming on the left and right simultaneously. - -> CellView a - -> b +buildCellViewBothHelper + :: StringBuilder b + => (a -> b) -- ^ Builder function for 'a'. + -> (Int -> Int -> a -> a) -- ^ Function for trimming on the left and right simultaneously. + -> CellView a + -> b buildCellViewBothHelper build trimBoth = buildCellViewHelper build build build (flip trimBoth 0) (trimBoth 0) trimBoth -- | Construct 'buildCellView' from builder functions, and trimming functions. -- -- Used to define instances of 'Cell'. -buildCellViewHelper :: StringBuilder b - => (a -> b) -- ^ Builder function for 'a'. - -> (a' -> b) -- ^ Builder function for the result of trimming 'a'. - -> (a'' -> b) -- ^ Builder function for the result of trimming 'a' twice. - -> (Int -> a -> a') -- ^ Function for trimming on the left. - -> (Int -> a -> a') -- ^ Function for trimming on the right. - -> (Int -> Int -> a -> a'') -- ^ Function for trimming on the left and right simultaneously. - -> CellView a - -> b -buildCellViewHelper build build' build'' trimL trimR trimBoth (CellView a l r) = +buildCellViewHelper + :: StringBuilder b + => (a -> b) -- ^ Builder function for 'a'. + -> (trimSingle -> b) -- ^ Builder function for the result of trimming 'a'. + -> (trimBoth -> b) -- ^ Builder function for the result of trimming 'a' twice. + -> (Int -> a -> trimSingle) -- ^ Function for trimming on the left. + -> (Int -> a -> trimSingle) -- ^ Function for trimming on the right. + -> (Int -> Int -> a -> trimBoth) -- ^ Function for trimming on the left and right simultaneously. + -> CellView a + -> b +buildCellViewHelper build buildSingleTrim buildTrimBoth trimL trimR trimBoth (CellView a l r) = case (compare l 0, compare r 0) of (GT, GT) -> spacesB l <> build a <> spacesB r - (GT, LT) -> spacesB l <> build' (trimR (negate r) a) + (GT, LT) -> spacesB l <> buildSingleTrim (trimR (negate r) a) (GT, EQ) -> spacesB l <> build a - (LT, GT) -> build' (trimL (negate l) a) <> spacesB r - (LT, LT) -> build'' $ trimBoth (negate l) (negate r) a - (LT, EQ) -> build' $ trimL (negate l) a + (LT, GT) -> buildSingleTrim (trimL (negate l) a) <> spacesB r + (LT, LT) -> buildTrimBoth $ trimBoth (negate l) (negate r) a + (LT, EQ) -> buildSingleTrim $ trimL (negate l) a (EQ, GT) -> build a <> spacesB r - (EQ, LT) -> build' $ trimR (negate r) a + (EQ, LT) -> buildSingleTrim $ trimR (negate r) a (EQ, EQ) -> build a -- | Drop a number of characters from the left side. Treats negative numbers @@ -182,10 +184,20 @@ dropRight = dropBoth 0 dropBoth :: Int -> Int -> a -> CellView a dropBoth l r = adjustCell (- max 0 l) (- max 0 r) -remSpacesB :: (Cell a, StringBuilder b) => Int -> a -> b +-- | Creates a 'StringBuilder' with the amount of missing spaces. +remSpacesB + :: (Cell a, StringBuilder b) + => Int -- ^ The expected length. + -> a -- ^ A cell. + -> b remSpacesB n c = remSpacesB' n $ visibleLength c -remSpacesB' :: StringBuilder b => Int -> Int -> b +-- | Creates a 'StringBuilder' with the amount of missing spaces. +remSpacesB' + :: StringBuilder b + => Int -- ^ The expected length. + -> Int -- ^ The actual length. + -> b remSpacesB' n k = spacesB $ n - k -- | Fill the right side with spaces if necessary. @@ -194,6 +206,7 @@ fillRight n c = fillRight' n (visibleLength c) c -- | Fill the right side with spaces if necessary. Preconditions that are -- required to be met (otherwise the function will produce garbage): +-- -- prop> visibleLength c == k fillRight' :: (Cell a, StringBuilder b) => Int -> Int -> a -> b fillRight' n k c = buildCell c <> remSpacesB' n k @@ -204,6 +217,7 @@ fillCenter n c = fillCenter' n (visibleLength c) c -- | Fill both sides with spaces if necessary. Preconditions that are -- required to be met (otherwise the function will produce garbage): +-- -- prop> visibleLength c == k fillCenter' :: (Cell a, StringBuilder b) => Int -> Int -> a -> b fillCenter' n k c = spacesB q <> buildCell c <> spacesB (q + r) @@ -217,6 +231,7 @@ fillLeft n c = fillLeft' n (visibleLength c) c -- | Fill the left side with spaces if necessary. Preconditions that are -- required to be met (otherwise the function will produce garbage): +-- -- prop> visibleLength c == k fillLeft' :: (Cell a, StringBuilder b) => Int -> Int -> a -> b fillLeft' n k c = remSpacesB' n k <> buildCell c @@ -229,8 +244,9 @@ pad :: (Cell a, StringBuilder b) => Position o -> Int -> a -> b pad p n c = pad' p n (visibleLength c) c -- | Pads the given cell accordingly using the position specification. --- Preconditions that require to be met (otherwise the function will produce --- garbage): +-- Preconditions that are required to be met (otherwise the function will +-- produce garbage): +-- -- prop> visibleLength c == k pad' :: (Cell a, StringBuilder b) => Position o -> Int -> Int -> a -> b pad' p n k = case p of @@ -293,6 +309,7 @@ trim p cm n c = if k <= n then buildCell c else trim' p cm n k c -- | Trim a cell based on the position. Cut marks may be trimmed if necessary. -- -- Preconditions that require to be met (otherwise the function will produce garbage): +-- -- prop> visibleLength c > n -- prop> visibleLength c == k trim' :: (Cell a, StringBuilder b) => Position o -> CutMark -> Int -> Int -> a -> b diff --git a/src/Text/Layout/Table/Cell/Formatted.hs b/src/Text/Layout/Table/Cell/Formatted.hs index 6876087..c5245cf 100644 --- a/src/Text/Layout/Table/Cell/Formatted.hs +++ b/src/Text/Layout/Table/Cell/Formatted.hs @@ -8,6 +8,9 @@ -- Hello World! -- -- The text then appears in dull red. +-- +-- More complex nested formatting can be achieved by using the `Monoid` +-- instance. module Text.Layout.Table.Cell.Formatted ( Formatted , plain diff --git a/src/Text/Layout/Table/LineStyle.hs b/src/Text/Layout/Table/LineStyle.hs index e559a48..9f33340 100644 --- a/src/Text/Layout/Table/LineStyle.hs +++ b/src/Text/Layout/Table/LineStyle.hs @@ -1,12 +1,12 @@ module Text.Layout.Table.LineStyle - ( -- * Line styling + ( -- * Line Styling LineStyle(..) , makeLineBold , makeLineLight , makeLineDashed , makeLineSolid - -- * ASCII lines and joins + -- * ASCII Lines and Joins , asciiHorizontal , asciiVertical , asciiJoinString @@ -14,7 +14,7 @@ module Text.Layout.Table.LineStyle , roundedAsciiJoinString , roundedAsciiJoinString4 - -- * Unicode lines and joins + -- * Unicode Lines and Joins , unicodeHorizontal , unicodeVertical , unicodeJoinString diff --git a/src/Text/Layout/Table/Spec/AlignSpec.hs b/src/Text/Layout/Table/Spec/AlignSpec.hs index b9ae543..82e7ce7 100644 --- a/src/Text/Layout/Table/Spec/AlignSpec.hs +++ b/src/Text/Layout/Table/Spec/AlignSpec.hs @@ -19,7 +19,7 @@ data AlignSpec instance Default AlignSpec where def = noAlign --- | Don't align text. +-- | Do not align text. noAlign :: AlignSpec noAlign = NoAlign @@ -27,7 +27,7 @@ noAlign = NoAlign occSpecAlign :: OccSpec -> AlignSpec occSpecAlign = AlignOcc --- | Align at the first match of a predicate. +-- | Align text at the first match of a predicate. predAlign :: (Char -> Bool) -> AlignSpec predAlign = occSpecAlign . predOccSpec diff --git a/src/Text/Layout/Table/Spec/CutMark.hs b/src/Text/Layout/Table/Spec/CutMark.hs index f9f92ce..07feafd 100644 --- a/src/Text/Layout/Table/Spec/CutMark.hs +++ b/src/Text/Layout/Table/Spec/CutMark.hs @@ -11,8 +11,9 @@ module Text.Layout.Table.Spec.CutMark import Data.Default.Class --- | Specifies how the place looks where a 'String' has been cut. Note that the --- cut mark may be cut itself to fit into a column. +-- | Specifies a cut mark that is used whenever content is cut to fit into a +-- cell. If the cut mark itself is too small to fit into a cell it may be cut +-- as well. data CutMark = CutMark { leftMark :: String @@ -36,7 +37,7 @@ doubleCutMark = CutMark singleCutMark :: String -> CutMark singleCutMark l = doubleCutMark l (reverse l) --- | Don't show any cut mark when text is cut. +-- | Do not show any cut mark when content is cut. noCutMark :: CutMark noCutMark = singleCutMark "" diff --git a/src/Text/Layout/Table/Spec/HeaderColSpec.hs b/src/Text/Layout/Table/Spec/HeaderColSpec.hs index 3f6a28c..7258429 100644 --- a/src/Text/Layout/Table/Spec/HeaderColSpec.hs +++ b/src/Text/Layout/Table/Spec/HeaderColSpec.hs @@ -8,9 +8,9 @@ import Text.Layout.Table.Spec.CutMark -- | Specifies how a header is rendered. data HeaderColSpec = HeaderColSpec (Position H) (Maybe CutMark) --- | Smart constructor for 'HeaderColSpec'. By omitting the cut mark it will use --- the one specified in the 'Text.Layout.Primitives.Column.ColSpec' like the --- other cells in that column. +-- | Smart constructor for 'HeaderColSpec'. By omitting the cut mark, it will +-- use the one specified in the 'Text.Layout.Primitives.Column.ColSpec' like +-- the other cells in that column. headerColumn :: Position H -> Maybe CutMark -> HeaderColSpec headerColumn = HeaderColSpec diff --git a/src/Text/Layout/Table/Style.hs b/src/Text/Layout/Table/Style.hs index 8597943..85aa481 100644 --- a/src/Text/Layout/Table/Style.hs +++ b/src/Text/Layout/Table/Style.hs @@ -1,16 +1,21 @@ --- | This module provides a primitive styling facility. To make your own style --- have a look at . +-- | This module provides predefined styles, combinators to modify them, +-- abstract style descriptions, and combinators for quickly turning them into +-- styles. +-- +-- The following resource may be useful for constructing your own primitive +-- styles: . {-# LANGUAGE RecordWildCards #-} module Text.Layout.Table.Style - ( -- * Pre-constructed 'TableStyle' - -- ** ASCII 'TableStyle' + ( -- * Pre-Constructed Table Styles + -- ** ASCII + -- These styles use only ASCII characters. asciiS , asciiRoundS , asciiDoubleS - -- ** Unicode 'TableStyle' + -- ** Unicode , unicodeS , unicodeBoldHeaderS , unicodeRoundS @@ -18,7 +23,7 @@ module Text.Layout.Table.Style , unicodeBoldStripedS , unicodeDoubleFrameS - -- * Transform 'TableStyle' + -- * Combinators , withoutBorders , withoutTopBorder , withoutBottomBorder @@ -28,18 +33,18 @@ module Text.Layout.Table.Style , inheritStyle , inheritStyleHeaderGroup - -- * Construct 'TableStyle' from 'TableStyleSpec' + -- * Construct Table Styles from an Abstract Specification , asciiTableStyleFromSpec , roundedAsciiTableStyleFromSpec , unicodeTableStyleFromSpec , tableStyleFromSpec - -- ** Construct 'TableStyleSpec' + -- ** Construct an Abstract Specifiction , TableStyleSpec(..) , simpleTableStyleSpec , setTableStyleSpecSeparator - -- * Low-level 'TableStyle' interface + -- * Low-Level Styling Facility , TableStyle(..) ) where From b148760fbd6df4e45e1e3e87451c116d583dd116 Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Wed, 2 Nov 2022 00:13:57 +0100 Subject: [PATCH 6/7] Update tutorial --- README.md | 63 +++++++++++++++++++++++++------------------------------ 1 file changed, 28 insertions(+), 35 deletions(-) diff --git a/README.md b/README.md index 9c12630..405c81e 100644 --- a/README.md +++ b/README.md @@ -16,14 +16,12 @@ Typically cells are rendered as a grid, but it is also possible to render tables ## Tutorial -### Grid layout +### Grids Render some text rows as grid: ``` hs -> putStrLn $ gridString [column expand left def def, column expand right def def] - [ ["top left", "top right"] - , ["bottom left", "bottom right"] - ] +> let g = [["top left", "top right"], ["bottom left", "bottom right"]] +> putStrLn $ gridString [column expand left def def, column expand right def def] g ``` `gridString` will join cells with a whitespace and rows with a newline character. The result is not spectacular but does look as expected: ``` @@ -32,7 +30,7 @@ bottom left bottom right ``` There are sensible default values for all column specification types, even for columns. We could have used just `def` for the first column. -### Number columns +### Number Columns Additionally some common types are provided. A particularly useful one is `numCol`: ``` hs @@ -48,7 +46,7 @@ This will display the given numbers as a dot-aligned single column: 5000.00001 ``` -### Improving readability of grids +### Improving Readability of Grids Big grids are usually not that readable. To improve their readability, two functions are provided: @@ -58,22 +56,20 @@ Big grids are usually not that readable. To improve their readability, two funct A good way to use this would be the [ansi-terminal package][], provided you are using a terminal to output your text. Another way to introduce color into cells is the `Formatted` type: ``` > :set -XOverloadedStrings -> let red s = formatted "\ESC[31m" s "\ESC[0m" -> gridString [def, numCol] [["Jim", "1203"], ["Jane", "523"], ["Jack", red "-959000"]] +> import Text.Layout.Table.Cell.Formatted +> let red s = formatted "\ESC[31m" (plain s) "\ESC[0m" +> let g = [["Jim", "1203"], ["Jane", "523"], ["Jack", red "-959000"]] +> putStrLn $ gridString [def, numCol] g ``` This way the color can depend on the cell content. -### Table layout +### Tables For more complex data, grids do not offer as much visibility. Sometimes we want to explicitly display a table, for example, as output in a database application. `tableLines` and `tableString` are used to create a table. ``` hs -putStrLn $ tableString [def , numCol] - unicodeRoundS - def - [ rowG ["Jack", "184.74"] - , rowG ["Jane", "162.2"] - ] +> let t = headerlessTableS [def , numCol] unicodeRoundS [rowG ["Jack", "184.74"], rowG ["Jane", "162.2"]] +> putStrLn $ tableString t ``` A row group is a group of rows which are not visually separated from each other. Thus multiple rows form one cell. @@ -86,17 +82,16 @@ In addition we specify the style and an optional header. By default the header i ╰──────┴────────╯ ``` -### Table headers +### Table Headers Optionally we can use table headers. `titlesH` will center titles, whereas `fullH` allows more control: ``` hs -putStrLn $ tableString [fixedLeftCol 10, column (fixed 10) center dotAlign def] - unicodeS - (titlesH ["Text", "Number"]) - [ rowG ["A very long text", "0.42000000"] - , rowG ["Short text", "100200.5"] - ] +> let cs = [fixedLeftCol 10, column (fixed 10) center dotAlign def] +> let h = (titlesH ["Text", "Number"]) +> let rgs = [rowG ["A very long text", "0.42000000"], rowG ["Short text", "100200.5"]] +> let t = columnHeaderTableS cs unicodeS h rgs +> putStrLn $ tableString t ``` Headers are always displayed with a different style than the other columns (centered by default). A maximum column width is respected, otherwise a header may acquire additional space. ``` @@ -109,16 +104,14 @@ Headers are always displayed with a different style than the other columns (cent └────────────┴────────────┘ ``` ### Vertical positioning and justified text -Because a row group consists of multiple lines, we may also want to align the content of cells vertically, especially when we don't know how many lines there will be. The following piece of code will display a left-justified text alongside the length of the text: +Because a row group consists of multiple lines, we may also want to align the content of cells vertically, especially when we do not know how many lines there will be. The following piece of code will display a left-justified text alongside the length of the text: ``` hs -let txt = "Lorem ipsum ..." -in putStrLn $ tableString [fixedLeftCol 50, numCol] - asciiS - (titlesH ["Text", "Length"]) - [ colsAllG center [ justifyText 50 txt - , [show $ length txt] - ] - ] +> let txt = "Lorem ipsum ..." +> let rgs = [colsAllG center [justifyText 50 txt, [show $ length txt]]] +> let cs = [fixedLeftCol 50, numCol] +> let h = titlesH ["Text", "Length"] +> let t = columnHeaderTableS cs asciiS h rgs +> putStrLn $ tableString t ``` `colsAllG` will merge the given columns into a row group with the given positioning: ``` @@ -136,11 +129,11 @@ in putStrLn $ tableString [fixedLeftCol 50, numCol] | officia deserunt mollit anim id est laborum. | | +----------------------------------------------------+--------+ ``` -Additionally, the positioning can be specified for each column with `colsG`. For grids `colsAsRows` and `colsAsRowsAll` are provided. +Additionally, the positioning can be specified for each column with `colsG`. For grids `colsAsRows` and `colsAsRowsAll` are provided. -## Get in contact +## Contact -* Report issues and suggestions to the GitHub page. +* Please report issues and suggestions to the GitHub page. * Any kind of feedback is welcome. * Contributions are much appreciated. Contact me first for bigger changes. From 2940bdca6094814f6eb868dd1726889f540222ec Mon Sep 17 00:00:00 2001 From: Moritz Bruder Date: Wed, 2 Nov 2022 23:34:10 +0100 Subject: [PATCH 7/7] Clean up ColModInfo functions * Rename functions to clearly state purpose. * Update documentation. * Refactor some uses. --- src/Text/Layout/Table.hs | 9 ++-- src/Text/Layout/Table/Pandoc.hs | 2 +- .../Layout/Table/Primitives/ColumnModifier.hs | 51 +++++++++++-------- 3 files changed, 36 insertions(+), 26 deletions(-) diff --git a/src/Text/Layout/Table.hs b/src/Text/Layout/Table.hs index 3dde99f..1233e81 100644 --- a/src/Text/Layout/Table.hs +++ b/src/Text/Layout/Table.hs @@ -151,7 +151,8 @@ module Text.Layout.Table , columnModifier , AlignInfo , widthAI - , deriveColModInfos + , deriveColModInfosFromGrid + , deriveColModInfosFromColumns , deriveAlignInfo , OccSpec @@ -227,7 +228,7 @@ gridB specs = fst . gridBWithCMIs specs gridBWithCMIs :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> ([Row b], [ColModInfo]) gridBWithCMIs specs tab = (zipWith4 columnModifier positions cms cMIs <$> tab, cMIs) where - cMIs = deriveColModInfos' specs tab + cMIs = deriveColModInfosFromGrid specs tab positions = map position specs cms = map cutMark specs @@ -391,7 +392,7 @@ tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = _ -> let attachRowHeader grps = map (\(hSpec, (grp, r)) -> (Just (hSpec, r), grp)) . headerContents $ zipHeader (rowG []) grps rowHeader - singleColCMI = listToMaybe . deriveColModInfos [(expand, noAlign)] . map pure + singleColCMI = Just . deriveColModInfoFromColumnLA (expand, noAlign) in ( attachRowHeader , singleColCMI . map snd $ headerContents rowHeader @@ -436,7 +437,7 @@ tableLinesBWithCMIs TableSpec { tableStyle = TableStyle { .. }, .. } = cMSs = map cutMark colSpecs posSpecs = map position colSpecs - cMIs = fitHeaderIntoCMIs $ deriveColModInfosFromColumns' colSpecs $ transposeRowGroups rowGroups + cMIs = fitHeaderIntoCMIs $ deriveColModInfosFromColumns colSpecs $ transposeRowGroups rowGroups rowMods = zipWith3 (\p cm cmi -> (emptyFromCMI cmi, columnModifier p cm cmi)) posSpecs cMSs cMIs rowBody :: RowGroup a -> [[b]] diff --git a/src/Text/Layout/Table/Pandoc.hs b/src/Text/Layout/Table/Pandoc.hs index 5afa22a..b448470 100644 --- a/src/Text/Layout/Table/Pandoc.hs +++ b/src/Text/Layout/Table/Pandoc.hs @@ -46,7 +46,7 @@ pandocPipeTableLines specs h tab = fmap (intercalate "|" . ("" :) . (++ [""])) $ consHeaderRow . (vSeparators :) $ zipWith ($) cmfs <$> tab where cmfs = zipWith (\spec cmi -> columnModifier (position spec) (cutMark spec) cmi) specs cmis - cmis = zipWith (ensureWidthCMI 2) posSpecs $ fitHeaderIntoCMIs $ deriveColModInfos' specs tab + cmis = zipWith (ensureWidthCMI 2) posSpecs $ fitHeaderIntoCMIs $ deriveColModInfosFromGrid specs tab posSpecs = fmap position specs diff --git a/src/Text/Layout/Table/Primitives/ColumnModifier.hs b/src/Text/Layout/Table/Primitives/ColumnModifier.hs index fc7d602..2bd7144 100644 --- a/src/Text/Layout/Table/Primitives/ColumnModifier.hs +++ b/src/Text/Layout/Table/Primitives/ColumnModifier.hs @@ -17,9 +17,9 @@ import Text.Layout.Table.Spec.Util import Text.Layout.Table.StringBuilder -- | Specifies how a column should be modified. Values of this type are derived --- in a traversal over the input columns by using 'deriveColModInfos'. Finally, --- 'columnModifier' will interpret them and apply the appropriate modification --- function to the cells of the column. +-- in a traversal over the input columns by using 'deriveColModInfosFromGrid'. +-- Finally, 'columnModifier' will interpret them and apply the appropriate +-- modification function to the cells of the column. data ColModInfo = FillAligned OccSpec AlignInfo | FillTo Int @@ -94,25 +94,27 @@ columnModifier pos cms colModInfo = case colModInfo of FitTo lim mT -> maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT --- | Derive the 'ColModInfo' for each column of a list of rows by using the --- corresponding specifications. See 'deriveColModInfoFromColumn' for details. -deriveColModInfos :: Cell a => [(LenSpec, AlignSpec)] -> [Row a] -> [ColModInfo] -deriveColModInfos specs = deriveColModInfosFromColumns specs . transpose - -deriveColModInfos' :: Cell a => [ColSpec] -> [Row a] -> [ColModInfo] -deriveColModInfos' = deriveColModInfos . fmap (lenSpec &&& alignSpec) - -deriveColModInfosFromColumns :: (Foldable col, Cell a) => [(LenSpec, AlignSpec)] -> [col a] -> [ColModInfo] -deriveColModInfosFromColumns specs = zipWith ($) (fmap deriveColModInfoFromColumn specs) - -- | Generate the 'AlignInfo' of a cell by using the 'OccSpec'. deriveAlignInfo :: Cell a => OccSpec -> a -> AlignInfo deriveAlignInfo occSpec = measureAlignment (predicate occSpec) +unpackColSpecs :: [ColSpec] -> [(LenSpec, AlignSpec)] +unpackColSpecs = fmap $ lenSpec &&& alignSpec + +-- | Derive the 'ColModInfo' for each column of a list of rows by using the +-- corresponding specifications. +deriveColModInfosFromGridLA :: Cell a => [(LenSpec, AlignSpec)] -> [Row a] -> [ColModInfo] +deriveColModInfosFromGridLA specs = deriveColModInfosFromColumnsLA specs . transpose + +-- | Derive the 'ColModInfo' for each column of a list of rows by using the +-- corresponding 'ColSpec'. +deriveColModInfosFromGrid :: Cell a => [ColSpec] -> [Row a] -> [ColModInfo] +deriveColModInfosFromGrid = deriveColModInfosFromGridLA . unpackColSpecs + -- | Derive the 'ColModInfo' of a single column by using the 'LenSpec' and the -- 'AlignSpec'. -deriveColModInfoFromColumn :: (Foldable col, Cell a) => (LenSpec, AlignSpec) -> col a -> ColModInfo -deriveColModInfoFromColumn (lenS, alignS) = case alignS of +deriveColModInfoFromColumnLA :: (Foldable col, Cell a) => (LenSpec, AlignSpec) -> col a -> ColModInfo +deriveColModInfoFromColumnLA (lenS, alignS) = case alignS of NoAlign -> let expandFun = FillTo fixedFun i = const $ FitTo i Nothing measureMaximumWidth = getMax . foldMap (Max . visibleLength) @@ -147,18 +149,25 @@ deriveColModInfoFromColumn (lenS, alignS) = case alignS of ExpandBetween i j -> expandBetween' i j in interpretLenSpec . measureMaximumWidth -deriveColModInfosFromColumns' :: (Foldable col, Cell a) => [ColSpec] -> [col a] -> [ColModInfo] -deriveColModInfosFromColumns' = deriveColModInfosFromColumns . fmap (lenSpec &&& alignSpec) +-- | Derive the 'ColModInfo' for each column of a list of columns by using the +-- corresponding specifications. +deriveColModInfosFromColumnsLA :: (Foldable col, Cell a) => [(LenSpec, AlignSpec)] -> [col a] -> [ColModInfo] +deriveColModInfosFromColumnsLA specs = zipWith ($) (fmap deriveColModInfoFromColumnLA specs) + +-- | Derive the 'ColModInfo' for each column of a list of columns by using the +-- corresponding 'ColSpec'. +deriveColModInfosFromColumns :: (Foldable col, Cell a) => [ColSpec] -> [col a] -> [ColModInfo] +deriveColModInfosFromColumns = deriveColModInfosFromColumnsLA . unpackColSpecs -- | Derive the 'ColModInfo' and generate functions without any intermediate -- steps. -deriveColMods +deriveColumnModifiers :: (Cell a, StringBuilder b) => [ColSpec] -> [Row a] -> [a -> b] -deriveColMods specs tab = +deriveColumnModifiers specs tab = zipWith (uncurry columnModifier) (map (position &&& cutMark) specs) cmis where - cmis = deriveColModInfos' specs tab + cmis = deriveColModInfosFromGrid specs tab