summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormuesli4 <>2017-05-19 09:08:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-05-19 09:08:00 (GMT)
commite4ade9b92b49431258968602eaf72b437682cd89 (patch)
tree65a5494a186996224cab6ecb5ffb7257cc30c064
parent0ed8bc03307e59e3b41c5e95009dcd859b29ca84 (diff)
version 0.8.0.0HEAD0.8.0.0master
-rw-r--r--README.md34
-rw-r--r--src/Text/Layout/Table.hs132
-rw-r--r--src/Text/Layout/Table/Justify.hs20
-rw-r--r--table-layout.cabal2
4 files changed, 90 insertions, 98 deletions
diff --git a/README.md b/README.md
index 10143f7..95f2ceb 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
# table-layout
-This package can be used to render character-based table layouts, which should be displayed with monospace fonts.
+This package can be used to render character-based table layouts which should be displayed with monospace fonts.
## Purpose
@@ -51,7 +51,7 @@ A good way to use this would be the [ansi-terminal package][], provided you are
### Table layout
-Grids are fine, but sometimes we want to explicitly display a table, e.g. as output in a database application. This is where ```tableString``` comes in handy:
+Grids are fine, but sometimes we want to explicitly display a table, e.g., as output in a database application. This is where ```tableString``` comes in handy:
``` hs
putStrLn $ tableString [def , numCol]
@@ -61,7 +61,7 @@ putStrLn $ tableString [def , numCol]
, rowG ["Jane", "162.2"]
]
```
-A row group is a group of rows which form one cell, meaning that each line of a group is not visually seperated from the other ones. In addition we specify the style and an optional header (which is not used by default). This will yield the following result:
+A row group is a group of rows which form one cell. This means that each line of a group is not visually seperated from the other ones. In addition we specify the style and an optional header (which is not used by default). This will yield the following result:
```
╭──────┬────────╮
@@ -83,7 +83,7 @@ putStrLn $ tableString [fixedLeftCol 10, column (fixed 10) center dotAlign def]
, rowG ["Short text", "100200.5"]
]
```
-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.
+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.
```
┌────────────┬────────────┐
│ Text │ Number │
@@ -100,9 +100,9 @@ let txt = "Lorem ipsum ..."
in putStrLn $ tableString [fixedLeftCol 50, numCol]
asciiS
(titlesH ["Text", "Length"])
- [colsAllG center [ justifyText 50 txt
- , [show $ length txt]
- ]
+ [ colsAllG center [ justifyText 50 txt
+ , [show $ length txt]
+ ]
]
```
`colsAllG` will merge the given columns into a row group with the given positioning:
@@ -110,19 +110,21 @@ in putStrLn $ tableString [fixedLeftCol 50, numCol]
+----------------------------------------------------+--------+
| Text | Length |
+----------------------------------------------------+--------+
-| Lorem ipsum dolor sit amet, consetetur sadipscing | |
-| elitr, sed diam nonumy eirmod tempor invidunt ut | |
-| labore et dolore magna aliquyam erat, sed diam | |
-| voluptua. At vero eos et accusam et justo duo | 295 |
-| dolores et ea rebum. Stet clita kasd gubergren, no | |
-| sea takimata sanctus est Lorem ipsum dolor sit | |
-| amet. | |
+| Lorem ipsum dolor sit amet, consectetur adipisici | |
+| elit, sed eiusmod tempor incidunt ut labore et | |
+| dolore magna aliqua. Ut enim ad minim veniam, quis | |
+| nostrud exercitation ullamco laboris nisi ut | |
+| aliquid ex ea commodi consequat. Quis aute iure | 429 |
+| reprehenderit in voluptate velit esse cillum | |
+| dolore eu fugiat nulla pariatur. Excepteur sint | |
+| obcaecat cupiditat non proident, sunt in culpa qui | |
+| 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.
-## Suggestions
+## Get in contact
-Feel free to contact me, I'm always happy about some feedback!
+Please report issues and suggestions to the GitHub page. I'm always open for feedback (good and bad).
[ansi-terminal package]: http://hackage.haskell.org/package/ansi-terminal
diff --git a/src/Text/Layout/Table.hs b/src/Text/Layout/Table.hs
index 7e37e90..2b9c76f 100644
--- a/src/Text/Layout/Table.hs
+++ b/src/Text/Layout/Table.hs
@@ -84,15 +84,6 @@ module Text.Layout.Table
, bottom
, V
- -- * Deprecated functions
- , layoutToCells
- , layoutToLines
- , layoutToString
- , layoutTableToLines
- , layoutTableToString
-
-
-
-- * Table styles
, module Text.Layout.Table.Style
@@ -166,7 +157,7 @@ fixedLeftCol i = fixedCol i left
-------------------------------------------------------------------------------
-- | Assume the given length is greater or equal than the length of the 'String'
--- passed. Pads the given 'String' accordingly, using the position specification.
+-- passed. Pads the given 'String' accordingly using the position specification.
--
-- >>> pad left 10 "foo"
-- "foo "
@@ -178,8 +169,8 @@ pad p = case p of
End -> fillLeft
-- | If the given text is too long, the 'String' will be shortened according to
--- the position specification, also adds some dots to indicate that the column
--- has been trimmed in length, otherwise behaves like 'pad'.
+-- the position specification. Adds cut marks to indicate that the column has
+-- been trimmed in length, otherwise it behaves like 'pad'.
--
-- >>> trimOrPad left (singleCutMark "..") 10 "A longer text."
-- "A longer.."
@@ -190,11 +181,14 @@ trimOrPad p = case p of
Center -> fitCenterWith
End -> fitLeftWith
--- | Align a column by first finding the position to pad with and then padding
--- the missing lengths to the maximum value. If no such position is found, it
--- will align it such that it gets aligned before that position.
+-- | Align a 'String' by first locating the position to align with and then
+-- padding on both sides. If no such position is found, it will align it such
+-- that it gets aligned before that position.
+--
+-- >>> let { os = predOccSpec (== '.') ; ai = deriveAlignInfo os "iiii.fff" } in align os ai <$> ["1.5", "30", ".25"]
+-- [" 1.5 "," 30 "," .25 "]
--
--- This function assumes:
+-- This function assumes that the given 'String' fits the 'AlignInfo'. Thus:
--
-- > ai <> deriveAlignInfo s = ai
--
@@ -205,7 +199,7 @@ align oS (AlignInfo l r) s = case splitAtOcc oS s of
[] -> spaces r
_ -> fillRight r rs
--- | Aligns a column using a fixed width, fitting it to the width by either
+-- | Aligns a 'String' using a fixed width, fitting it to the width by either
-- filling or cutting while respecting the alignment.
alignFixed :: Position o -> CutMark -> Int -> OccSpec -> AlignInfo -> String -> String
alignFixed _ cms 0 _ _ _ = ""
@@ -318,7 +312,10 @@ alignFixed p cms i oS ai@(AlignInfo l r) s =
applyMarkRight = applyMarkRightWith cms
applyMarkLeft = applyMarkLeftWith cms
--- | Specifies how a column should be modified.
+-- | 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.
data ColModInfo = FillAligned OccSpec AlignInfo
| FillTo Int
| FitTo Int (Maybe (OccSpec, AlignInfo))
@@ -330,7 +327,8 @@ showCMI cmi = case cmi of
FillTo i -> "FillTo " ++ show i
FitTo i _ -> "FitTo " ++ show i ++ ".."
--- | Get the exact width after the modification.
+-- | Get the exact width of a 'ColModInfo' after applying it with
+-- 'columnModifier'.
widthCMI :: ColModInfo -> Int
widthCMI cmi = case cmi of
FillAligned _ ai -> widthAI ai
@@ -338,14 +336,14 @@ widthCMI cmi = case cmi of
FitTo lim _ -> lim
-- | Remove alignment from a 'ColModInfo'. This is used to change alignment of
--- headers, while using the combined width information.
+-- headers while using the combined width information.
unalignedCMI :: ColModInfo -> ColModInfo
unalignedCMI cmi = case cmi of
FillAligned _ ai -> FillTo $ widthAI ai
FitTo i _ -> FitTo i Nothing
_ -> cmi
--- | Ensures that the modification provides a minimum width, but only if it is
+-- | Ensures that the modification provides a minimum width but only if it is
-- not limited.
ensureWidthCMI :: Int -> Position H -> ColModInfo -> ColModInfo
ensureWidthCMI w pos cmi = case cmi of
@@ -375,7 +373,8 @@ columnModifier pos cms lenInfo = case lenInfo of
maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT
-- TODO factor out
--- | Specifies the length before and after a letter.
+-- | Specifies the length before and after an alignment position (including the
+-- alignment character).
data AlignInfo = AlignInfo Int Int
-- | Private show function.
@@ -386,14 +385,14 @@ showAI (AlignInfo l r) = "AlignInfo " ++ show l ++ " " ++ show r
widthAI :: AlignInfo -> Int
widthAI (AlignInfo l r) = l + r
--- | Since determining a maximum in two directions is not possible, a 'Monoid'
--- instance is provided.
+-- | Produce an 'AlignInfo' that is wide enough to hold inputs of both given
+-- 'AlignInfo's.
instance Monoid AlignInfo where
mempty = AlignInfo 0 0
mappend (AlignInfo ll lr) (AlignInfo rl rr) = AlignInfo (max ll rl) (max lr rr)
--- | Derive the 'ColModInfo' by using layout specifications and looking at the
--- cells.
+-- | Derive the 'ColModInfo' by using layout specifications and the actual cells
+-- of a column.
deriveColModInfos :: [(LenSpec, AlignSpec)] -> [Row String] -> [ColModInfo]
deriveColModInfos specs = zipWith ($) (fmap fSel specs) . transpose
where
@@ -420,9 +419,10 @@ deriveColModInfos specs = zipWith ($) (fmap fSel specs) . transpose
FixedUntil i -> expandUntil not i
in fun . foldMap (deriveAlignInfo oS)
--- | Generate the 'AlignInfo' of a cell using the 'OccSpec'.
+-- | Generate the 'AlignInfo' of a cell by using the 'OccSpec'.
deriveAlignInfo :: OccSpec -> String -> AlignInfo
-deriveAlignInfo occSpec s = AlignInfo <$> length . fst <*> length . snd $ splitAtOcc occSpec s
+deriveAlignInfo occSpec s =
+ AlignInfo <$> length . fst <*> length . snd $ splitAtOcc occSpec s
-------------------------------------------------------------------------------
-- Basic layout
@@ -430,12 +430,11 @@ deriveAlignInfo occSpec s = AlignInfo <$> length . fst <*> length . snd $ splitA
-- | Modifies cells according to the column specification.
grid :: [ColSpec] -> [Row String] -> [Row String]
-grid specs tab = zipWith apply tab
- . repeat
- . zipWith (uncurry columnModifier) (map (position A.&&& cutMark) specs)
- $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs) tab
+grid specs tab = zipWith ($) cmfs <$> tab
where
- apply = zipWith $ flip ($)
+ -- | The column modification function for each column.
+ cmfs = zipWith (uncurry columnModifier) (map (position A.&&& cutMark) specs) cmis
+ cmis = deriveColModInfos (map (lenSpec A.&&& alignSpec) specs) tab
-- | Behaves like 'grid' but produces lines by joining with whitespace.
gridLines :: [ColSpec] -> [Row String] -> [String]
@@ -446,18 +445,6 @@ gridLines specs = fmap unwords . grid specs
gridString :: [ColSpec] -> [Row String] -> String
gridString specs = concatLines . gridLines specs
-{-# DEPRECATED layoutToCells "Use grid instead." #-}
-layoutToCells :: [Row String] -> [ColSpec] -> [Row String]
-layoutToCells = flip grid
-
-{-# DEPRECATED layoutToLines "Use gridLines instead." #-}
-layoutToLines :: [Row String] -> [ColSpec] -> [String]
-layoutToLines = flip gridLines
-
-{-# DEPRECATED layoutToString "Use gridString instead." #-}
-layoutToString :: [Row String] -> [ColSpec] -> String
-layoutToString = flip gridString
-
-------------------------------------------------------------------------------
-- Grid modification functions
-------------------------------------------------------------------------------
@@ -477,13 +464,13 @@ checkeredCells f g = zipWith altLines $ cycle [[f, g], [g, f]]
-- Advanced layout
-------------------------------------------------------------------------------
--- | Uses the columns to create a row group, using the given vertical
--- positionings.
+-- | Create a 'RowGroup' by aligning the columns vertically. The position is
+-- specified for each column.
colsG :: [Position V] -> [Col String] -> RowGroup
colsG ps = rowsG . colsAsRows ps
--- | Uses the columns to create a row group, using the given vertical
--- positioning.
+-- | Create a 'RowGroup' by aligning the columns vertically. Each column uses
+-- the same vertical positioning.
colsAllG :: Position V -> [Col String] -> RowGroup
colsAllG p = rowsG . colsAsRowsAll p
@@ -503,23 +490,24 @@ fullH = Header
titlesH :: [String] -> Header
titlesH = fullH $ repeat def
--- | Layouts a good-looking table with a optional header. Note that specifying
+-- | Layouts a good-looking table with an optional header. Note that specifying
-- fewer layout specifications than columns or vice versa will result in not
--- showing them.
+-- showing the redundant ones.
tableLines :: [ColSpec] -- ^ Layout specification of columns
-> TableStyle -- ^ Visual table style
-> Header -- ^ Optional header details
-> [RowGroup] -- ^ Rows which form a cell together
-> [String]
-tableLines specs (TableStyle { .. }) header rGs =
+tableLines specs TableStyle { .. } header rGs =
topLine : addHeaderLines (rowGroupLines ++ [bottomLine])
where
-- Helpers for horizontal lines
- hLine hS d = hLineDetail hS d d d
- hLineDetail hS dL d dR cols = intercalate [hS] $ [dL] : intersperse [d] cols ++ [[dR]]
+ hLine hS d = hLineDetail hS d d d
+ hLineDetail hS dL d dR cols
+ = intercalate [hS] $ [dL] : intersperse [d] cols ++ [[dR]]
-- Spacers consisting of columns of seperator elements.
- genHSpacers c = map (flip replicate c) colWidths
+ genHSpacers c = map (`replicate` c) colWidths
-- Horizontal seperator lines
topLine = hLineDetail realTopH realTopL realTopC realTopR $ genHSpacers realTopH
@@ -531,9 +519,10 @@ tableLines specs (TableStyle { .. }) header rGs =
rowGroupLines = intercalate [groupSepLine] $ map (map (hLine ' ' groupV) . applyRowMods . rows) rGs
-- Optional values for the header
- (addHeaderLines, fitHeaderIntoCMIs, realTopH, realTopL, realTopC, realTopR) = case header of
+ (addHeaderLines, fitHeaderIntoCMIs, realTopH, realTopL, realTopC, realTopR)
+ = case header of
Header headerColSpecs hTitles ->
- let headerLine = hLine ' ' headerV (zipApply hTitles headerRowMods)
+ let headerLine = hLine ' ' headerV (zipWith ($) headerRowMods hTitles)
headerRowMods = zipWith3 (\(HeaderColSpec pos optCutMark) cutMark ->
columnModifier pos $ fromMaybe cutMark optCutMark
)
@@ -557,14 +546,13 @@ tableLines specs (TableStyle { .. }) header rGs =
, groupTopR
)
- cMSs = map cutMark specs
- posSpecs = map position specs
- applyRowMods xss = zipWith zipApply xss $ repeat rowMods
- rowMods = zipWith3 columnModifier posSpecs cMSs cMIs
- cMIs = fitHeaderIntoCMIs $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs)
+ cMSs = map cutMark specs
+ posSpecs = map position specs
+ applyRowMods = map (zipWith ($) rowMods)
+ rowMods = zipWith3 columnModifier posSpecs cMSs cMIs
+ cMIs = fitHeaderIntoCMIs $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs)
$ concatMap rows rGs
- colWidths = map widthCMI cMIs
- zipApply = zipWith $ flip ($)
+ colWidths = map widthCMI cMIs
-- | Does the same as 'tableLines', but concatenates lines.
tableString :: [ColSpec] -- ^ Layout specification of columns
@@ -574,22 +562,6 @@ tableString :: [ColSpec] -- ^ Layout specification of columns
-> String
tableString specs style header rGs = concatLines $ tableLines specs style header rGs
-{-# DEPRECATED layoutTableToLines "Use tableLines instead." #-}
-layoutTableToLines :: [RowGroup]
- -> Header
- -> [ColSpec]
- -> TableStyle
- -> [String]
-layoutTableToLines rGs header specs style = tableLines specs style header rGs
-
-{-# DEPRECATED layoutTableToString "Use tableString instead." #-}
-layoutTableToString :: [RowGroup]
- -> Header
- -> [ColSpec]
- -> TableStyle
- -> String
-layoutTableToString rGs optHeaderInfo specs = concatLines . layoutTableToLines rGs optHeaderInfo specs
-
-------------------------------------------------------------------------------
-- Text justification
-------------------------------------------------------------------------------
diff --git a/src/Text/Layout/Table/Justify.hs b/src/Text/Layout/Table/Justify.hs
index 723983d..1d87879 100644
--- a/src/Text/Layout/Table/Justify.hs
+++ b/src/Text/Layout/Table/Justify.hs
@@ -9,6 +9,7 @@ module Text.Layout.Table.Justify
-- * Helpers
, dimorphicSummands
, dimorphicSummandsBy
+ , mixedDimorphicSummandsBy
) where
import Control.Arrow
@@ -34,7 +35,7 @@ justify :: Int -> [String] -> [String]
justify width = mapInit pad (\(_, _, line) -> unwords line) . gather 0 0 []
where
pad (len, wCount, line) = unwords $ if len < width
- then zipWith (++) line $ dimorphicSpaces (width - len) (pred wCount) ++ [""]
+ then zipWith (++) line $ mixedDimorphicSpaces (width - len) (pred wCount) ++ [""]
else line
gather lineLen wCount line ws = case ws of
@@ -59,6 +60,11 @@ mapInit f g (x : xs) = go x xs
dimorphicSpaces :: Int -> Int -> [String]
dimorphicSpaces = dimorphicSummandsBy spaces
+-- | Spread out spaces with different widths more evenly (in comparison to
+-- 'dimorphicSpaces').
+mixedDimorphicSpaces :: Int -> Int -> [String]
+mixedDimorphicSpaces = mixedDimorphicSummandsBy spaces
+
-- | Splits a given number into summands of 2 different values, where the
-- first one is exactly one bigger than the second one. Splitting 40 spaces
-- into 9 almost equal parts would result in:
@@ -76,3 +82,15 @@ dimorphicSummandsBy f n splits = replicate r largeS ++ replicate (splits - r) sm
(q, r) = n `divMod` splits
largeS = f $ succ q
smallS = f q
+
+-- | Spread out summands evenly mixed as far as possible.
+mixedDimorphicSummandsBy :: (Int -> a) -> Int -> Int -> [a]
+mixedDimorphicSummandsBy f n splits = go r (splits - r)
+ where
+ go 0 s = replicate s smallS
+ go l 0 = replicate l largeS
+ go l s = largeS : smallS : go (pred l) (pred s)
+
+ (q, r) = n `divMod` splits
+ largeS = f $ succ q
+ smallS = f q
diff --git a/table-layout.cabal b/table-layout.cabal
index 37817ca..90c6c50 100644
--- a/table-layout.cabal
+++ b/table-layout.cabal
@@ -6,7 +6,7 @@ name: table-layout
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
-version: 0.7.0.0
+version: 0.8.0.0
synopsis: Layout text as grid or table.