table-layout 0.8.0.5 → 0.9.0.0
raw patch · 35 files changed
+1204/−725 lines, 35 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +35/−0
- src/Test.hs +0/−2
- src/Text/Layout/Table.hs +44/−347
- src/Text/Layout/Table/Cell.hs +259/−0
- src/Text/Layout/Table/Cell/Formatted.hs +51/−0
- src/Text/Layout/Table/Internal.hs +0/−40
- src/Text/Layout/Table/Justify.hs +63/−23
- src/Text/Layout/Table/Pandoc.hs +51/−0
- src/Text/Layout/Table/Position.hs +0/−13
- src/Text/Layout/Table/Position/Internal.hs +0/−48
- src/Text/Layout/Table/Primitives/AlignInfo.hs +24/−0
- src/Text/Layout/Table/Primitives/AlignSpec.hs +0/−9
- src/Text/Layout/Table/Primitives/AlignSpec/Internal.hs +0/−36
- src/Text/Layout/Table/Primitives/Basic.hs +6/−39
- src/Text/Layout/Table/Primitives/Column.hs +0/−32
- src/Text/Layout/Table/Primitives/ColumnModifier.hs +141/−0
- src/Text/Layout/Table/Primitives/Header.hs +13/−0
- src/Text/Layout/Table/Primitives/LenSpec.hs +0/−9
- src/Text/Layout/Table/Primitives/LenSpec/Internal.hs +0/−35
- src/Text/Layout/Table/Primitives/Occurence.hs +0/−26
- src/Text/Layout/Table/Primitives/Table.hs +40/−0
- src/Text/Layout/Table/Spec/AlignSpec.hs +36/−0
- src/Text/Layout/Table/Spec/ColSpec.hs +33/−0
- src/Text/Layout/Table/Spec/CutMark.hs +37/−0
- src/Text/Layout/Table/Spec/HeaderColSpec.hs +20/−0
- src/Text/Layout/Table/Spec/HeaderSpec.hs +22/−0
- src/Text/Layout/Table/Spec/LenSpec.hs +35/−0
- src/Text/Layout/Table/Spec/OccSpec.hs +30/−0
- src/Text/Layout/Table/Spec/Position.hs +48/−0
- src/Text/Layout/Table/Spec/RowGroup.hs +18/−0
- src/Text/Layout/Table/Spec/Util.hs +7/−0
- src/Text/Layout/Table/StringBuilder.hs +34/−0
- src/Text/Layout/Table/Vertical.hs +6/−6
- table-layout.cabal +73/−39
- test-suite/TestSpec.hs +78/−21
+ CHANGELOG.md view
@@ -0,0 +1,35 @@+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).++## [Unreleased]+++## [0.9.0.0] - 2020-04-10++### Added++- Add `Text.Layout.Table.Cell.Formatted`. A `Cell` instance is provided that+ enables formatting text correctly with inline text formatting commands.+- Add helpers to generate tables for Pandoc in the module+ `Text.Layout.Table.Pandoc`.+- Add `Cell` type class: This enables using different input string types.+- Add `StringBuilder` type class. This enables generating output in different+ ways.+- Add test case for left-biased trim.++### Changed++- Change input type of a lot of functions to use the `Cell` type class. This+ might break some code but will require only a type annotation to fix.+- Rework and simplify formatting functions with `Cell` and `StringBuilder`. This+ includes improvements in test coverage.+- Reorganize module structure:+ * Modules of types used for specification do now start with+ `Text.Layout.Table.Spec.`.+ * Move a lot of the code in `Text.Layout.Table` into sub-modules.++### Fixed++- Fix an error with text justification for lines that contain only one word and+ add a test case. (#6)+- Fix an error where cut marks where applied wrongly on the right side.+
src/Test.hs view
@@ -1,7 +1,5 @@ module Main where -import Control.Monad- import Text.Layout.Table main :: IO ()
src/Text/Layout/Table.hs view
@@ -62,7 +62,7 @@ -- ** Headers , HeaderColSpec , headerColumn- , Header+ , HeaderSpec , fullH , titlesH @@ -111,25 +111,31 @@ -- TODO AlignSpec: multiple alignment points - useful? -- TODO RowGroup: optional: vertical group labels -- TODO RowGroup: optional: provide extra layout for a RowGroup--- TODO ColModInfo: provide a special version of ensureWidthOfCMI to force header visibility -- TODO ColSpec: add some kind of combinator to construct ColSpec values (e.g. via Monoid, see optparse-applicative) -import qualified Control.Arrow as A import Data.List-import Data.Maybe-import Data.Semigroup import Data.Default.Class-import Data.Default.Instances.Base ()+import Data.Default.Instances.Base () +import Text.Layout.Table.Cell import Text.Layout.Table.Justify-import Text.Layout.Table.Style-import Text.Layout.Table.Position.Internal-import Text.Layout.Table.Primitives.AlignSpec.Internal+import Text.Layout.Table.Primitives.AlignInfo import Text.Layout.Table.Primitives.Basic-import Text.Layout.Table.Primitives.Column-import Text.Layout.Table.Primitives.LenSpec.Internal-import Text.Layout.Table.Primitives.Occurence-import Text.Layout.Table.Internal+import Text.Layout.Table.Primitives.ColumnModifier+import Text.Layout.Table.Primitives.Header+import Text.Layout.Table.Primitives.Table+import Text.Layout.Table.Spec.AlignSpec+import Text.Layout.Table.Spec.ColSpec+import Text.Layout.Table.Spec.CutMark+import Text.Layout.Table.Spec.HeaderColSpec+import Text.Layout.Table.Spec.HeaderSpec+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.Util+import Text.Layout.Table.StringBuilder+import Text.Layout.Table.Style import Text.Layout.Table.Vertical -------------------------------------------------------------------------------@@ -154,301 +160,20 @@ fixedLeftCol i = fixedCol i left ---------------------------------------------------------------------------------- Single-cell layout functions.------------------------------------------------------------------------------------ | Assume the given length is greater or equal than the length of the 'String'--- passed. Pads the given 'String' accordingly using the position specification.------ >>> pad left 10 "foo"--- "foo "----pad :: Position o -> Int -> String -> String-pad p = case p of- Start -> fillRight- Center -> fillCenter- End -> fillLeft---- | If the given text is too long, the 'String' will be shortened according to--- 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.."----trimOrPad :: Position o -> CutMark -> Int -> String -> String-trimOrPad p = case p of- Start -> fitRightWith- Center -> fitCenterWith- End -> fitLeftWith---- | 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 that the given 'String' fits the 'AlignInfo'. Thus:------ > ai <> deriveAlignInfo s = ai----align :: OccSpec -> AlignInfo -> String -> String-align oS (AlignInfo l r) s = case splitAtOcc oS s of- (ls, rs) -> fillLeft l ls ++ case rs of- -- No alignment character found.- [] -> spaces r- _ -> fillRight r rs---- | 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 _ _ _ = ""-alignFixed _ cms 1 _ _ s@(_ : (_ : _)) = applyMarkLeftWith cms " "-alignFixed p cms i oS ai@(AlignInfo l r) s =- let n = l + r - i- in case splitAtOcc oS s of- (ls, rs) -> case p of- Start ->- let remRight = r - n- in if remRight < 0- then fitRight (l + remRight) $ fillLeft l ls- else fitRight (l + remRight) $ fillLeft l ls ++ rs- End ->- let remLeft = l - n- in if remLeft < 0- then fitLeft (r + remLeft) $ fillRight r rs- else fitLeft (r + remLeft) $ ls ++ fillRight r rs- Center ->- {-- This is really complicated, maybe there can be found- something better.- - First case l > r:- - l- |<----'----->|- |<-----------x----->|- |--.-->|- r- c1 = (l + r) div 2- |- |<---'--->|<---.--->|- . |- . c2 = c1 + (l + r) mod 2- .- . d2 = d1 + i mod 2- . |- |<-.->|<-'-->|- |- d1 = i div 2- - |<----.----->|- i- - needed length on the left side:- l - c1 + d1- - needed length on the right side:- d2 - (l - c1)- - Second case l < r:- - - l- |<--'-->|- |<------x---------->|- |<----.---->|- r- c1 = (l + r) div 2- |- |<---'--->|<---.--->|- . |- . c2 = c1 + (l + r) mod 2- .- . d2 = d1 + i mod 2- . |- |<-.->|<-'-->|- |- d1 = i div 2- - |<----.----->|- i- - needed length on the left side:- d1 - (r - c2)- - needed length on the right side:- (c1 - l) + d2- -}- let (c, remC) = (l + r) `divMod` 2- (d, remD) = i `divMod` 2- d2 = d + remD- c2 = c + remC- -- Note: widthL and widthR can be negative if there is no- -- width left and we need to further trim into the other- -- side.- (widthL, widthR) = if l > c- then (l - c2 + d, d2 - (l - c2))- else (d - (r - c), (c2 - l) + d2)- lenL = length ls- lenR = length rs-- toCutLfromR = negate $ min 0 widthL- toCutRfromL = max 0 $ negate widthR- (markL, funL) = if lenL > widthL- then ( applyMarkLeft- , take (widthL - toCutRfromL) . drop (lenL - widthL)- )- else ( id- , fillLeft (widthL - toCutRfromL) . take (lenL - toCutRfromL)- )- (markR, funR) = if lenR > widthR- then (applyMarkRight, take widthR)- else (id , fillRight widthR)- in markL $ markR $ funL ls ++ drop toCutLfromR (funR rs)- where- fitRight = fitRightWith cms- fitLeft = fitLeftWith cms- applyMarkRight = applyMarkRightWith cms- applyMarkLeft = applyMarkLeftWith cms---- | 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))---- | Private show function.-showCMI :: ColModInfo -> String-showCMI cmi = case cmi of- FillAligned oS ai -> "FillAligned .. " ++ showAI ai- FillTo i -> "FillTo " ++ show i- FitTo i _ -> "FitTo " ++ show i ++ ".."---- | Get the exact width of a 'ColModInfo' after applying it with--- 'columnModifier'.-widthCMI :: ColModInfo -> Int-widthCMI cmi = case cmi of- FillAligned _ ai -> widthAI ai- FillTo maxLen -> maxLen- FitTo lim _ -> lim---- | Remove alignment from a 'ColModInfo'. This is used to change alignment of--- 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--- not limited.-ensureWidthCMI :: Int -> Position H -> ColModInfo -> ColModInfo-ensureWidthCMI w pos cmi = case cmi of- FillAligned oS ai@(AlignInfo lw rw) ->- let neededW = w - widthAI ai- in if neededW <= 0- then cmi- else FillAligned oS $ case pos of- Start -> AlignInfo lw (rw + neededW)- End -> AlignInfo (lw + neededW) rw- Center -> let (q, r) = neededW `divMod` 2 - in AlignInfo (q + lw) (q + rw + r)- FillTo maxLen -> FillTo (max maxLen w)- _ -> cmi---- | Ensures that the given 'String' will fit into the modified columns.-ensureWidthOfCMI :: String -> Position H -> ColModInfo -> ColModInfo-ensureWidthOfCMI = ensureWidthCMI . length---- | Generates a function which modifies a given cell according to--- 'Text.Layout.Table.Position.Position', 'CutMark' and 'ColModInfo'. This is--- used to modify a single cell of column to bring all cells of column to the--- same width.-columnModifier :: Position H -> CutMark -> ColModInfo -> (String -> String)-columnModifier pos cms lenInfo = case lenInfo of- FillAligned oS ai -> align oS ai- FillTo maxLen -> pad pos maxLen- FitTo lim mT ->- maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT---- TODO factor out--- | Specifies the length before and after an alignment position (including the--- alignment character).-data AlignInfo = AlignInfo Int Int---- | Private show function.-showAI :: AlignInfo -> String-showAI (AlignInfo l r) = "AlignInfo " ++ show l ++ " " ++ show r---- | The column width when using the 'AlignInfo'.-widthAI :: AlignInfo -> Int-widthAI (AlignInfo l r) = l + r---- | Produce an 'AlignInfo' that is wide enough to hold inputs of both given--- 'AlignInfo's.-instance Semigroup AlignInfo where- AlignInfo ll lr <> AlignInfo rl rr = AlignInfo (max ll rl) (max lr rr)--instance Monoid AlignInfo where- mempty = AlignInfo 0 0---- | 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- fSel (lenSpec, alignSpec) = case alignSpec of- NoAlign -> let fitTo i = const $ FitTo i Nothing- expandUntil f i max = if f (max <= i)- then FillTo max- else fitTo i max- fun = case lenSpec of- Expand -> FillTo- Fixed i -> fitTo i- ExpandUntil i -> expandUntil id i- FixedUntil i -> expandUntil not i- in fun . maximum . map length- AlignOcc oS -> let fitToAligned i = FitTo i . Just . (,) oS- fillAligned = FillAligned oS- expandUntil f i ai = if f (widthAI ai <= i)- then fillAligned ai- else fitToAligned i ai- fun = case lenSpec of- Expand -> fillAligned- Fixed i -> fitToAligned i- ExpandUntil i -> expandUntil id i- FixedUntil i -> expandUntil not i- in fun . foldMap (deriveAlignInfo oS)---- | 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--------------------------------------------------------------------------------- -- Basic layout ------------------------------------------------------------------------------- -- | Modifies cells according to the column specification.-grid :: [ColSpec] -> [Row String] -> [Row String]-grid specs tab = zipWith ($) cmfs <$> tab- where- -- | 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+grid :: Cell a => [ColSpec] -> [Row a] -> [Row String]+grid specs tab = zipWith ($) (deriveColMods specs tab) <$> tab -- | Behaves like 'grid' but produces lines by joining with whitespace.-gridLines :: [ColSpec] -> [Row String] -> [String]+gridLines :: Cell a => [ColSpec] -> [Row a] -> [String] gridLines specs = fmap unwords . grid specs -- | Behaves like 'gridLines' but produces a string by joining with the newline -- character.-gridString :: [ColSpec] -> [Row String] -> String+gridString :: Cell a => [ColSpec] -> [Row a] -> String gridString specs = concatLines . gridLines specs -------------------------------------------------------------------------------@@ -472,38 +197,22 @@ -- | Create a 'RowGroup' by aligning the columns vertically. The position is -- specified for each column.-colsG :: [Position V] -> [Col String] -> RowGroup+colsG :: Monoid a => [Position V] -> [Col a] -> RowGroup a colsG ps = rowsG . colsAsRows ps -- | Create a 'RowGroup' by aligning the columns vertically. Each column uses -- the same vertical positioning.-colsAllG :: Position V -> [Col String] -> RowGroup+colsAllG :: Monoid a => Position V -> [Col a] -> RowGroup a colsAllG p = rowsG . colsAsRowsAll p --- | Specifies a header.-data Header- = Header [HeaderColSpec] [String]- | NoHeader---- | By the default the header is not shown.-instance Default Header where- def = NoHeader---- | Specify a header column for every title.-fullH :: [HeaderColSpec] -> [String] -> Header-fullH = Header---- | Use titles with the default header column specification.-titlesH :: [String] -> Header-titlesH = fullH $ repeat def- -- | 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.-tableLines :: [ColSpec] -- ^ Layout specification of columns+tableLines :: Cell a+ => [ColSpec] -- ^ Layout specification of columns -> TableStyle -- ^ Visual table style- -> Header -- ^ Optional header details- -> [RowGroup] -- ^ Rows which form a cell together+ -> HeaderSpec -- ^ Optional header details+ -> [RowGroup a] -- ^ Rows which form a cell together -> [String] tableLines specs TableStyle { .. } header rowGroups = topLine : addHeaderLines (rowGroupLines ++ [bottomLine])@@ -511,20 +220,9 @@ -- Helpers for horizontal lines that will put layout characters arround and -- in between a row of the pre-formatted grid. - -- | Draw a horizontal line that will use the delimiters around 'cols'- -- appropriately and visually separate by 'hSpace'.- hLineDetail hSpace delimL delimM delimR cols- = intercalate [hSpace] $ [delimL] : intersperse [delimM] cols ++ [[delimR]]-- -- | A simplified version of 'hLineDetail' that will use the same delimiter- -- for everything.- hLine hSpace delim- = hLineDetail hSpace delim delim delim- -- | Generate columns filled with 'sym'. fakeColumns sym- = map (`replicate` sym) colWidths-+ = map (`replicateCharB` sym) colWidths -- Horizontal seperator lines that occur in a table. topLine = hLineDetail realTopH realTopL realTopC realTopR $ fakeColumns realTopH@@ -533,29 +231,28 @@ headerSepLine = hLineDetail headerSepH headerSepLC headerSepC headerSepRC $ fakeColumns headerSepH -- Vertical content lines- rowGroupLines = intercalate [groupSepLine] $ map (map (hLine ' ' groupV) . applyRowMods . rows) rowGroups+ rowGroupLines =+ intercalate [groupSepLine] $ map (map (hLineContent groupV) . applyRowMods . rows) rowGroups -- Optional values for the header (addHeaderLines, fitHeaderIntoCMIs, realTopH, realTopL, realTopC, realTopR) = case header of- Header headerColSpecs hTitles- ->- let headerLine = hLine ' ' headerV (zipWith ($) headerRowMods hTitles)- headerRowMods = zipWith3 (\(HeaderColSpec pos optCutMark) cutMark ->- columnModifier pos $ fromMaybe cutMark optCutMark- )+ HeaderHS headerColSpecs hTitles+ ->+ let headerLine = hLineContent headerV (zipWith ($) headerRowMods hTitles)+ headerRowMods = zipWith3 headerCellModifier headerColSpecs cMSs- (map unalignedCMI cMIs)+ cMIs in ( (headerLine :) . (headerSepLine :)- , zipWith ($) $ zipWith ($) (map ensureWidthOfCMI hTitles) posSpecs+ , fitTitlesCMI hTitles posSpecs , headerTopH , headerTopL , headerTopC , headerTopR )- NoHeader ->+ NoneHS -> ( id , id , groupTopH@@ -568,15 +265,15 @@ posSpecs = map position specs applyRowMods = map (zipWith ($) rowMods) rowMods = zipWith3 columnModifier posSpecs cMSs cMIs- cMIs = fitHeaderIntoCMIs $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs)- $ concatMap rows rowGroups+ cMIs = fitHeaderIntoCMIs $ deriveColModInfos' specs $ concatMap rows rowGroups colWidths = map widthCMI cMIs -- | Does the same as 'tableLines', but concatenates lines.-tableString :: [ColSpec] -- ^ Layout specification of columns+tableString :: Cell a+ => [ColSpec] -- ^ Layout specification of columns -> TableStyle -- ^ Visual table style- -> Header -- ^ Optional header details- -> [RowGroup] -- ^ Rows which form a cell together+ -> HeaderSpec -- ^ Optional header details+ -> [RowGroup a] -- ^ Rows which form a cell together -> String tableString specs style header rowGroups = concatLines $ tableLines specs style header rowGroups
+ src/Text/Layout/Table/Cell.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE FlexibleInstances #-}+module Text.Layout.Table.Cell where++import Text.Layout.Table.Primitives.AlignInfo+import Text.Layout.Table.Spec.CutMark+import Text.Layout.Table.Spec.OccSpec+import Text.Layout.Table.Spec.Position+import Text.Layout.Table.StringBuilder++-- | Types that can be shortened, measured for visible characters, and turned+-- into a 'StringBuilder'.+class Cell a where+ -- Preprocessing functions:++ -- | Drop a number of characters from the left side. Treats negative numbers+ -- as zero.+ dropLeft :: Int -> a -> a+ dropLeft n = dropBoth n 0++ -- | Drop a number of characters from the right side. Treats negative+ -- numbers as zero.+ dropRight :: Int -> a -> a+ dropRight = dropBoth 0++ -- | Drop characters from both sides. Treats negative numbers as zero.+ dropBoth :: Int -> Int -> a -> a+ dropBoth l r = dropRight r . dropLeft l++ -- | Returns the length of the visible characters as displayed on the+ -- output medium.+ visibleLength :: a -> Int++ -- | Measure the preceeding and following characters for a position where+ -- the predicate matches.+ measureAlignment :: (Char -> Bool) -> a -> AlignInfo++ -- | Insert the contents into a 'StringBuilder'.+ buildCell :: StringBuilder b => a -> b++ {-# MINIMAL visibleLength, measureAlignment, buildCell, (dropBoth | (dropLeft, dropRight)) #-}++instance Cell String where+ dropLeft = drop+ dropRight n = reverse . drop n . reverse+ visibleLength = length+ measureAlignment p xs = case break p xs of+ (ls, rs) -> AlignInfo (length ls) $ case rs of+ [] -> Nothing+ _ : rs' -> Just $ length rs'++ buildCell = stringB++remSpacesB :: (Cell a, StringBuilder b) => Int -> a -> b+remSpacesB n c = remSpacesB' n $ visibleLength c++remSpacesB' :: StringBuilder b => Int -> Int -> b+remSpacesB' n k = spacesB $ n - k++-- | Fill the right side with spaces if necessary.+fillRight :: (Cell a, StringBuilder b) => Int -> a -> b+fillRight n c = buildCell c <> remSpacesB n c++-- | Fill both sides with spaces if necessary.+fillCenter :: (Cell a, StringBuilder b) => Int -> a -> b+fillCenter n c = spacesB q <> buildCell c <> spacesB (q + r)+ where+ missing = n - visibleLength c+ (q, r) = missing `divMod` 2++-- | Fill the left side with spaces if necessary.+fillLeft :: (Cell a, StringBuilder b) => Int -> a -> b+fillLeft n c = remSpacesB n c <> buildCell c++-- | Assume the given length is greater or equal than the length of the cell+-- passed. Pads the given cell accordingly using the position specification.+--+-- >>> pad left 10 "foo" :: String+-- "foo "+--+pad :: (Cell a, StringBuilder b) => Position o -> Int -> a -> b+pad p = case p of+ Start -> fillRight+ Center -> fillCenter+ End -> fillLeft++-- | If the given text is too long, the 'String' will be shortened according to+-- 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." :: String+-- "A longer.."+--+trimOrPad :: (Cell a, StringBuilder b) => Position o -> CutMark -> Int -> a -> b+trimOrPad p cm n c = case compare (visibleLength c) n of+ LT -> pad p n c+ EQ -> buildCell c+ GT -> trim p cm n c++-- | Trim a cell based on the position. Preconditions that require to be met+-- (otherwise the function will produce garbage):+-- prop> visibleLength c > n+trim :: (Cell a, StringBuilder b) => Position o -> CutMark -> Int -> a -> b+trim p cm n c = case p of+ Start -> buildCell (dropRight (cutLen + rightLen) c) <> buildCell (rightMark cm)+ Center -> case cutLen `divMod` 2 of+ (0, 1) -> buildCell (leftMark cm) <> buildCell (dropLeft (1 + leftLen) c)+ (q, r) -> if n > leftLen + rightLen+ then buildCell (leftMark cm) <> buildCell (dropBoth (leftLen + q + r) (rightLen + q) c)+ <> buildCell (rightMark cm)+ else case n `divMod` 2 of+ (qn, rn) -> buildCell (take qn $ leftMark cm)+ <> buildCell (drop (rightLen - qn - rn) $ rightMark cm)+ End -> buildCell (leftMark cm) <> buildCell (dropLeft (leftLen + cutLen) c)+ where+ leftLen = length $ leftMark cm+ rightLen = length $ rightMark cm++ cutLen = visibleLength c - n++-- | Align a cell 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"] :: [String]+-- [" 1.5 "," 30 "," .25 "]+--+-- This function assumes that the given 'String' fits the 'AlignInfo'. Thus:+--+-- prop> ai <> deriveAlignInfo s = ai+--+align :: (Cell a, StringBuilder b) => OccSpec -> AlignInfo -> a -> b+align oS (AlignInfo ln optRN) c = case measureAlignment (predicate oS) c of+ AlignInfo lk optRK -> remSpacesB' ln lk <> buildCell c <> remSpacesB' (maybe 0 succ optRN) (maybe 0 succ optRK)++data CutAction+ = FillCA Int+ | CutCA Int+ | NoneCA+ deriving (Eq, Show)++surplusSpace :: CutAction -> Int+surplusSpace ca = case ca of+ CutCA n -> negate n+ FillCA n -> n+ _ -> 0++determineCutAction :: Int -> Int -> CutAction+determineCutAction requiredW actualW = case compare requiredW actualW of+ LT -> CutCA $ actualW - requiredW+ EQ -> NoneCA+ GT -> FillCA $ requiredW - actualW++data CutInfo+ -- | Apply a cut action to each side.+ = SidesCI CutAction CutAction+ -- | Apply a mark to a whitespace string pointing to the left.+ | MarkLeftCI+ -- | Apply a mark to a whitespace string pointing to the right.+ | MarkRightCI+ deriving (Eq, Show)++-- | Compares the view range, that represents the visible part, with the cell+-- range, which is the position of the cell relative to the alignment, and+-- determines the actions that should be performed.+determineCuts :: Int -> Int -> Int -> Int -> CutInfo+determineCuts vl vr cl cr+ | vr <= cl = MarkRightCI+ | cr <= vl = MarkLeftCI+ | otherwise = SidesCI (determineCutAction cl vl) (determineCutAction vr cr)++-- | If the amount to be cut is bigger than the cell length then any missing+-- amount is taken away from any remaining padding.+spacesAfterCut :: StringBuilder b => CutAction -> Int -> Int -> b+spacesAfterCut ca cellLen cutAmount = spacesB $ s + min r 0+ where+ s = surplusSpace ca+ r = cellLen - cutAmount++applyCutInfo+ :: (Cell a, StringBuilder b)+ => CutInfo+ -> CutMark+ -> Int+ -> Int+ -> a+ -> b+applyCutInfo ci cm availSpace cellLen c = case ci of+ -- The cuts might interfere with each other. Properly distribute available+ -- length between both cut marks.+ SidesCI (CutCA lCut) (CutCA rCut) ->+ let (q, r) = availSpace `divMod` 2+ in applyLeftMark q+ <> buildCell (dropBoth (lCut + leftLen) (rCut + rightLen) c)+ <> applyRightMark (q + r)+ -- The left cut might need some of the right padding.+ SidesCI (CutCA lCut) rCA ->+ applyLeftMark availSpace+ <> buildCell (dropLeft (lCut + leftLen) c)+ <> spacesAfterCut rCA cellLen (lCut + leftLen)+ -- The right cut might need some of the left padding.+ SidesCI lCA (CutCA rCut) ->+ spacesAfterCut lCA cellLen (rCut + rightLen)+ <> buildCell (dropRight (rCut + rightLen) c)+ <> applyRightMark availSpace+ -- Filtered out all cuts at this point.+ SidesCI lCA rCA ->+ let spacesB' = spacesB . surplusSpace+ in spacesB' lCA <> buildCell c <> spacesB' rCA+ MarkRightCI ->+ spacesB (max 0 $ availSpace - leftLen) <> applyRightMark availSpace+ MarkLeftCI ->+ applyLeftMark availSpace <> spacesB (max 0 $ availSpace - rightLen)+ where+ leftLen = length $ leftMark cm+ rightLen = length $ rightMark cm++ applyLeftMark k = buildCell $ take k $ leftMark cm+ applyRightMark k = buildCell $ drop (rightLen - k) $ rightMark cm++-- | Given a position, the available width, and the length of an alignment+-- (left and right side, separator is implied) compute a range for the view.+-- The lower bound is inclusive and the upper bound exclusive.+viewRange :: Position o -> Int -> Int -> Int -> (Int, Int)+viewRange p availSpace l r = case p of+ Start -> (0, availSpace)+ Center -> let (cq, cr) = (l + r + 1 - availSpace) `divMod` 2+ start = cq + cr+ in (start, start + availSpace)+ End -> let end = l + r + 1+ in (end - availSpace, end)++-- | Given the maximum left alignment and the alignment of the cell create a+-- range that describes the position of the cell. The lower bound is inclusive+-- and the upper bound exclusive.+cellRange :: Int -> AlignInfo -> (Int, Int)+cellRange lMax cellAlignInfo@(AlignInfo l _) = (cl, cl + widthAI cellAlignInfo)+ where+ cl = lMax - l++-- | Aligns a cell using a fixed width, fitting it to the width by either+-- filling or cutting while respecting the alignment.+alignFixed+ :: (Cell a, StringBuilder b)+ => Position o+ -> CutMark+ -> Int+ -> OccSpec+ -> AlignInfo+ -> a+ -> b+alignFixed p cm n oS (AlignInfo lMax optRMax) c = case optRMax of+ Nothing -> trimOrPad p cm n c+ Just rMax -> let (vl, vr) = viewRange p n lMax rMax+ (cl, cr) = cellRange lMax $ measureAlignment (predicate oS) c+ cutInfo = determineCuts vl vr cl cr+ cellLen = cr - cl+ in applyCutInfo cutInfo cm n cellLen c+
+ src/Text/Layout/Table/Cell/Formatted.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveFunctor #-}+-- | Provides formatting to an instance of 'Cell'. For example, in a unix+-- terminal one could use the following:+--+-- >>> buildCell (formatted "\ESC[31m" "Hello World!" "\ESC[0m") :: String+-- Hello World!+--+-- The text then appears in dull red.+module Text.Layout.Table.Cell.Formatted+ ( Formatted+ , formatted+ , plain+ ) where++import Data.String++import Text.Layout.Table.Cell+import Text.Layout.Table.StringBuilder++data Formatted a+ = Formatted+ { prefix :: String+ , content :: a+ , suffix :: String+ } deriving Functor++-- | Create a value from content that is kept plain without any formatting.+plain :: a -> Formatted a+plain x = Formatted "" x ""++-- | Create a formatted value with formatting directives that are applied to+-- the whole value. The actual formatting has to be done by the backend.+formatted+ :: String -- ^ Prefix text directives for formatting.+ -> a -- ^ The content to be formatted.+ -> String -- ^ Suffix text directives for formatting.+ -> Formatted a+formatted = Formatted++instance IsString a => IsString (Formatted a) where+ fromString = plain . fromString++instance Cell a => Cell (Formatted a) where+ dropLeft i = fmap $ dropLeft i+ dropRight i = fmap $ dropRight i+ dropBoth l r = fmap $ dropBoth l r+ visibleLength = visibleLength . content+ measureAlignment p = measureAlignment p . content++ -- | Surrounds the content with the directives.+ buildCell h = stringB (prefix h) <> buildCell (content h) <> stringB (suffix h)
− src/Text/Layout/Table/Internal.hs
@@ -1,40 +0,0 @@-module Text.Layout.Table.Internal where--import Data.Default.Class-import Data.Default.Instances.Base--import Text.Layout.Table.Position-import Text.Layout.Table.Primitives.Basic---- | Groups rows together which should not be visually seperated from each other.-newtype RowGroup- = RowGroup- { rows :: [[String]]- }---- | Group the given rows together.-rowsG :: [Row String] -> RowGroup-rowsG = RowGroup---- | Make a group of a single row.-rowG :: Row String -> RowGroup-rowG = RowGroup . (: [])---- | 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.-headerColumn :: Position H -> Maybe CutMark -> HeaderColSpec-headerColumn = HeaderColSpec---- | Header columns are usually centered.-instance Default HeaderColSpec where- def = headerColumn center def---- | An alias for lists, conceptually for values with a horizontal arrangement.-type Row a = [a]---- | An alias for lists, conceptually for values with a vertical arrangement.-type Col a = [a]
src/Text/Layout/Table/Justify.hs view
@@ -1,10 +1,13 @@ -- | Produce justified text, which is spread over multiple rows. For a simple -- cut, 'chunksOf' from the `split` package is best suited. {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-} module Text.Layout.Table.Justify ( -- * Text justification justify , justifyText+ , fitWords+ , concatPadLine -- * Helpers , dimorphicSummands@@ -12,13 +15,7 @@ , mixedDimorphicSummandsBy ) where -import Control.Arrow-import Data.List--import Text.Layout.Table.Internal import Text.Layout.Table.Primitives.Basic-import Text.Layout.Table.Position.Internal-import Text.Layout.Table.Vertical -- | Uses 'words' to split the text into words and justifies it with 'justify'. --@@ -32,23 +29,69 @@ -- Every line, except the last one, gets equally filled with spaces between the -- words as far as possible. justify :: Int -> [String] -> [String]-justify width = mapInit pad (\(_, _, line) -> unwords line) . gather 0 0 []+justify width = mapInit (concatPadLine width) (unwords . lineWords) . fitWords width++-- | Intermediate representation for a line of words.+data Line+ = Line+ { lineLength :: Int -- ^ The length of the current line with a single space as separator between the words.+ , lineWordCount :: Int -- ^ The number of words on the current line.+ , lineWords :: [String] -- ^ The actual words of the line.+ } deriving Show++-- | Join the words on a line together by filling it with spaces in between.+concatPadLine+ :: Int -- ^ The maximum length for lines.+ -> Line -- ^ The 'Line'.+ -> String -- The padded and concatenated line.+concatPadLine width Line {..} = case lineWords of+ [word] -> word+ _ -> unwords $ if lineLength < width+ then let fillAmount = width - lineLength+ gapCount = pred lineWordCount+ spaceSeps = mixedDimorphicSpaces fillAmount gapCount ++ [""]+ in zipWith (++) lineWords spaceSeps+ else lineWords++-- | Fit as much words on a line as possible. Produce a list of the length of+-- the line with one space between the words, the word count and the words.+--+-- Cutting below word boundaries is not yet supported.+fitWords+ :: Int -- ^ The number of characters available per line.+ -> [String] -- ^ The words to join with whitespaces.+ -> [Line] -- ^ The list of line information.+fitWords width = --gather 0 0 []+ finishFitState . foldr fitStep (FitState 0 0 [] []) where- pad (len, wCount, line) = unwords $ if len < width- then zipWith (++) line $ mixedDimorphicSpaces (width - len) (pred wCount) ++ [""]- else line+ fitStep word s@FitState {..} =+ let wLen = length word+ newLineLen = fitStateLineLen + 1 + wLen+ reinit f = FitState wLen 1 [word] $ f fitStateLines+ in if | null fitStateWords -> reinit id+ | newLineLen <= width -> FitState newLineLen (succ fitStateWordCount) (word : fitStateWords) fitStateLines+ | otherwise -> reinit (finishLine s :) - gather lineLen wCount line ws = case ws of - [] | null line -> []- | otherwise -> [(lineLen, wCount, reverse line)]- w : ws' ->- let wLen = length w- newLineLen = lineLen + 1 + wLen- reinit = gather wLen 1 [w] ws'- in if | null line -> reinit- | newLineLen <= width -> gather newLineLen (succ wCount) (w : line) ws'- | otherwise -> (lineLen, wCount, reverse line) : reinit+-- | State used while fitting words on a line.+data FitState+ = FitState+ { fitStateLineLen :: Int+ , fitStateWordCount :: Int+ , fitStateWords :: [String]+ , fitStateLines :: [Line]+ } +-- | Completes the current line.+finishLine :: FitState -> Line+finishLine FitState {..} = Line fitStateLineLen fitStateWordCount $ reverse fitStateWords++finishFitState :: FitState -> [Line]+finishFitState s@FitState {..} = finishLines fitStateLines+ where+ finishLines = case fitStateWordCount of+ 0 -> id+ _ -> (finishLine s :)+ -- | Map inits with the first function and the last one with the last function. mapInit :: (a -> b) -> (a -> b) -> [a] -> [b] mapInit _ _ [] = []@@ -56,9 +99,6 @@ where go y [] = [g y] go y (y' : ys) = f y : go y' ys--dimorphicSpaces :: Int -> Int -> [String]-dimorphicSpaces = dimorphicSummandsBy spaces -- | Spread out spaces with different widths more evenly (in comparison to -- 'dimorphicSpaces').
+ src/Text/Layout/Table/Pandoc.hs view
@@ -0,0 +1,51 @@+-- | Render tables that can be used in <https://pandoc.org/ Pandoc>. In+-- particular, this supports the+-- <https://pandoc.org/MANUAL.html#tables pipe_tables> extension.+module Text.Layout.Table.Pandoc where++import Data.List++import Text.Layout.Table.Primitives.ColumnModifier+import Text.Layout.Table.Primitives.Header+import Text.Layout.Table.Spec.ColSpec+import Text.Layout.Table.Spec.HeaderSpec+import Text.Layout.Table.Spec.Position+import Text.Layout.Table.Spec.Util++-- | Generate a table that is readable but also serves as input to pandoc.+--+-- >>> mapM_ putStrLn $ pandocPipeTableLines [def, numCol] (titlesH ["text", "numeric value"]) [["a", "1.5"], ["b", "6.60000"]]+-- |text|numberic value|+-- |:---|-------------:|+-- |a | 1.5 |+-- |b | 6.60000|+pandocPipeTableLines+ :: [ColSpec]+ -> HeaderSpec+ -> [Row String]+ -> [String]+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++ posSpecs = fmap position specs++ (fitHeaderIntoCMIs, consHeaderRow) = case h of+ NoneHS -> (id, id)+ HeaderHS headerSpecs titles ->+ ( fitTitlesCMI titles posSpecs+ , (zipWith4 headerCellModifier headerSpecs (cutMark <$> specs) cmis titles :)+ )++ vSeparators = zipWith (\pos cmi -> applyPandocPositionMarker pos $ replicate (widthCMI cmi) '-') posSpecs cmis++applyPandocPositionMarker :: Position H -> String -> String+applyPandocPositionMarker p = case p of+ Start -> markLeft+ Center -> markRight . markLeft+ End -> markRight+ where+ markLeft = (':' :) . drop 1+ markRight = reverse . (':' :) . drop 1 . reverse
− src/Text/Layout/Table/Position.hs
@@ -1,13 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module Text.Layout.Table.Position- ( Position- , H- , V- , left- , right- , center- , top- , bottom- ) where--import Text.Layout.Table.Position.Internal
− src/Text/Layout/Table/Position/Internal.hs
@@ -1,48 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE EmptyDataDecls #-}-module Text.Layout.Table.Position.Internal where--import Data.Default.Class---- | Specifies a position relative from a beginning.-data Position orientation- = Start- | Center- | End- deriving Eq--instance Show (Position H) where- show p = case p of- Start -> "left"- Center -> "center"- End -> "right"--instance Show (Position V) where- show p = case p of- Start -> "top"- Center -> "center"- End -> "bottom"--instance Default (Position orientation) where- def = Start---- | Horizontal orientation.-data H---- | Vertical orientation.-data V--left :: Position H-left = Start--right :: Position H-right = End--center :: Position orientation-center = Center--top :: Position V-top = Start--bottom :: Position V-bottom = End
+ src/Text/Layout/Table/Primitives/AlignInfo.hs view
@@ -0,0 +1,24 @@+module Text.Layout.Table.Primitives.AlignInfo where++import Data.Foldable (asum)++-- | Specifies the length before and after an alignment position (excluding the+-- alignment character).+data AlignInfo = AlignInfo Int (Maybe Int)++-- | Private show function.+showAI :: AlignInfo -> String+showAI (AlignInfo l optR) = "AlignInfo " ++ show l ++ " " ++ showsPrec 11 optR ""++-- | The column width when using the 'AlignInfo'.+widthAI :: AlignInfo -> Int+widthAI (AlignInfo l optR) = l + maybe 0 succ optR++-- | Produce an 'AlignInfo' that is wide enough to hold inputs of both given+-- 'AlignInfo's.+instance Semigroup AlignInfo where+ AlignInfo ll lOptR <> AlignInfo rl rOptR =+ AlignInfo (max ll rl) (asum [max <$> lOptR <*> rOptR, lOptR, rOptR])++instance Monoid AlignInfo where+ mempty = AlignInfo 0 Nothing
− src/Text/Layout/Table/Primitives/AlignSpec.hs
@@ -1,9 +0,0 @@-module Text.Layout.Table.Primitives.AlignSpec- ( AlignSpec- , noAlign- , occSpecAlign- , predAlign- , charAlign- ) where--import Text.Layout.Table.Primitives.AlignSpec.Internal
− src/Text/Layout/Table/Primitives/AlignSpec/Internal.hs
@@ -1,36 +0,0 @@-module Text.Layout.Table.Primitives.AlignSpec.Internal- ( AlignSpec(..)- , noAlign- , occSpecAlign- , predAlign- , charAlign- ) where--import Data.Default.Class--import Text.Layout.Table.Primitives.Occurence---- | Determines whether a column will align at a specific letter.-data AlignSpec- = AlignOcc OccSpec- | NoAlign---- | No alignment is the default.-instance Default AlignSpec where- def = noAlign---- | Don't align text.-noAlign :: AlignSpec-noAlign = NoAlign---- | Construct an 'AlignSpec' by giving an occurence specification.-occSpecAlign :: OccSpec -> AlignSpec-occSpecAlign = AlignOcc---- | Align at the first match of a predicate.-predAlign :: (Char -> Bool) -> AlignSpec-predAlign = occSpecAlign . predOccSpec---- | Align text at the first occurence of a given 'Char'.-charAlign :: Char -> AlignSpec-charAlign = predAlign . (==)
src/Text/Layout/Table/Primitives/Basic.hs view
@@ -1,14 +1,8 @@ -- | This module contains primitive modifiers for lists and 'String's to be -- filled or fitted to a specific length. module Text.Layout.Table.Primitives.Basic- ( -- * Cut marks- CutMark- , doubleCutMark- , singleCutMark- , noCutMark-- -- * String-related tools- , spaces+ ( -- * String-related tools+ spaces , concatLines -- ** Filling@@ -32,39 +26,12 @@ , fillEnd , fillBoth' , fillBoth- )- where+ ) where --- TODO rename cut marks (they are too long)+import Text.Layout.Table.Spec.CutMark -import Data.Default.Class import Data.List --- | 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.-data CutMark- = CutMark- { leftMark :: String- , rightMark :: String- }---- | A single ellipsis unicode character is used to show cut marks.-instance Default CutMark where- def = singleCutMark "…"---- | Specify two different cut marks, one for cuts on the left and one for cuts--- on the right.-doubleCutMark :: String -> String -> CutMark-doubleCutMark l r = CutMark l (reverse r)---- | Use the cut mark on both sides by reversing it on the other.-singleCutMark :: String -> CutMark-singleCutMark l = doubleCutMark l (reverse l)---- | Don't show any cut mark when text is cut.-noCutMark :: CutMark-noCutMark = singleCutMark ""- spaces :: Int -> String spaces = flip replicate ' ' @@ -144,11 +111,11 @@ -- | Applies a 'CutMark' to the left of a 'String', while preserving the length. applyMarkLeftWith :: CutMark -> String -> String-applyMarkLeftWith cms = applyMarkLeftBy leftMark cms+applyMarkLeftWith = applyMarkLeftBy leftMark -- | Applies a 'CutMark' to the right of a 'String', while preserving the length. applyMarkRightWith :: CutMark -> String -> String-applyMarkRightWith cms = reverse . applyMarkLeftBy rightMark cms . reverse+applyMarkRightWith cms = reverse . applyMarkLeftBy (reverse . rightMark) cms . reverse applyMarkLeftBy :: (a -> String) -> a -> String -> String applyMarkLeftBy f v = zipWith ($) $ map const (f v) ++ repeat id
− src/Text/Layout/Table/Primitives/Column.hs
@@ -1,32 +0,0 @@-module Text.Layout.Table.Primitives.Column- ( ColSpec- , lenSpec- , position- , alignSpec- , cutMark- , column- ) where--import Data.Default.Class--import Text.Layout.Table.Position-import Text.Layout.Table.Primitives.AlignSpec-import Text.Layout.Table.Primitives.Basic-import Text.Layout.Table.Primitives.LenSpec----- | Specifies the layout of a column.-data ColSpec- = ColSpec- { lenSpec :: LenSpec- , position :: Position H- , alignSpec :: AlignSpec- , cutMark :: CutMark- }--instance Default ColSpec where- def = column def def def def---- | Smart constructor to specify a column.-column :: LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec-column = ColSpec
+ src/Text/Layout/Table/Primitives/ColumnModifier.hs view
@@ -0,0 +1,141 @@+module Text.Layout.Table.Primitives.ColumnModifier where++import Control.Arrow ((&&&))+import Data.List++import Text.Layout.Table.Cell+import Text.Layout.Table.Primitives.AlignInfo+import Text.Layout.Table.Spec.AlignSpec+import Text.Layout.Table.Spec.ColSpec+import Text.Layout.Table.Spec.CutMark+import Text.Layout.Table.Spec.LenSpec+import Text.Layout.Table.Spec.OccSpec+import Text.Layout.Table.Spec.Position+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.+data ColModInfo+ = FillAligned OccSpec AlignInfo+ | FillTo Int+ | FitTo Int (Maybe (OccSpec, AlignInfo))++-- | Private show function.+showCMI :: ColModInfo -> String+showCMI cmi = case cmi of+ FillAligned _ ai -> "FillAligned .. " ++ showAI ai+ FillTo i -> "FillTo " ++ show i+ FitTo i _ -> "FitTo " ++ show i ++ ".."++-- | Get the exact width of a 'ColModInfo' after applying it with+-- 'columnModifier'.+widthCMI :: ColModInfo -> Int+widthCMI cmi = case cmi of+ FillAligned _ ai -> widthAI ai+ FillTo maxLen -> maxLen+ FitTo lim _ -> lim++-- | Remove alignment from a 'ColModInfo'. This is used to change alignment of+-- 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+-- not limited.+ensureWidthCMI :: Int -> Position H -> ColModInfo -> ColModInfo+ensureWidthCMI w pos cmi = case cmi of+ FillAligned oS ai@(AlignInfo lw optRW)+ ->+ let neededW = w - widthAI ai+ in if neededW <= 0+ then cmi+ else FillAligned oS $ case pos of+ Start -> case optRW of+ Just rw -> AlignInfo lw $ Just (rw + neededW)+ Nothing -> AlignInfo (lw + neededW) optRW+ End -> AlignInfo (lw + neededW) optRW+ Center -> case optRW of+ Just _ -> let (q, r) = w `divMod` 2 + -- Calculate a new distribution.+ in AlignInfo q $ Just (q + r)+ Nothing -> AlignInfo (lw + neededW) optRW+ FillTo maxLen -> FillTo (max maxLen w)+ _ -> cmi++-- | Ensures that the given 'String' will fit into the modified columns.+ensureWidthOfCMI :: String -> Position H -> ColModInfo -> ColModInfo+ensureWidthOfCMI = ensureWidthCMI . visibleLength++-- | Fit titles of a header column into the derived 'ColModInfo'.+fitTitlesCMI :: [String] -> [Position H] -> [ColModInfo] -> [ColModInfo]+fitTitlesCMI = zipWith3 ensureWidthOfCMI++-- | Generates a function which modifies a given cell according to+-- 'Text.Layout.Table.Position.Position', 'CutMark' and 'ColModInfo'. This is+-- used to modify a single cell of a column to bring all cells of a column to+-- the same width.+columnModifier+ :: (Cell a, StringBuilder b)+ => Position H+ -> CutMark+ -> ColModInfo+ -> (a -> b)+columnModifier pos cms colModInfo = case colModInfo of+ FillAligned oS ai -> align oS ai+ FillTo maxLen -> pad pos maxLen+ FitTo lim mT ->+ maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT++-- | Derive the 'ColModInfo' by using layout specifications and the actual cells+-- of a column. This function only needs to know about 'LenSpec' and 'AlignInfo'.+deriveColModInfos :: Cell a => [(LenSpec, AlignSpec)] -> [Row a] -> [ColModInfo]+deriveColModInfos specs = zipWith ($) (fmap fSel specs) . transpose+ where+ fSel (lenS, alignS) = case alignS of+ NoAlign -> let fitTo i = const $ FitTo i Nothing+ expandUntil' f i max' = if f (max' <= i)+ then FillTo max'+ else fitTo i max'+ fun = case lenS of+ Expand -> FillTo+ Fixed i -> fitTo i+ ExpandUntil i -> expandUntil' id i+ FixedUntil i -> expandUntil' not i+ in fun . maximum . map visibleLength+ AlignOcc oS -> let fitToAligned i = FitTo i . Just . (,) oS+ fillAligned = FillAligned oS+ expandUntil' f i ai = if f (widthAI ai <= i)+ then fillAligned ai+ else fitToAligned i ai+ fun = case lenS of+ Expand -> fillAligned+ Fixed i -> fitToAligned i+ ExpandUntil i -> expandUntil' id i+ FixedUntil i -> expandUntil' not i+ in fun . foldMap (deriveAlignInfo oS)++deriveColModInfos' :: Cell a => [ColSpec] -> [Row a] -> [ColModInfo]+deriveColModInfos' = deriveColModInfos . fmap (lenSpec &&& alignSpec)++-- | Derive the 'ColModInfo' and generate functions without any intermediate+-- steps.+deriveColMods+ :: (Cell a, StringBuilder b)+ => [ColSpec]+ -> [Row a]+ -> [a -> b]+deriveColMods specs tab =+ zipWith (uncurry columnModifier) (map (position &&& cutMark) specs) cmis+ where+ cmis = deriveColModInfos' specs tab++-- | Generate the 'AlignInfo' of a cell by using the 'OccSpec'.+deriveAlignInfo :: Cell a => OccSpec -> a -> AlignInfo+deriveAlignInfo occSpec = measureAlignment (predicate occSpec)+
+ src/Text/Layout/Table/Primitives/Header.hs view
@@ -0,0 +1,13 @@+module Text.Layout.Table.Primitives.Header where++import Data.Maybe++import Text.Layout.Table.Primitives.ColumnModifier+import Text.Layout.Table.Spec.CutMark+import Text.Layout.Table.Spec.HeaderColSpec++-- | Combine a 'HeaderColSpec' and existing 'ColModInfo's to format header cells.+headerCellModifier :: HeaderColSpec -> CutMark -> ColModInfo -> (String -> String)+headerCellModifier (HeaderColSpec pos optCutMark) cutMark cmi =+ columnModifier pos (fromMaybe cutMark optCutMark) (unalignedCMI cmi)+
− src/Text/Layout/Table/Primitives/LenSpec.hs
@@ -1,9 +0,0 @@-module Text.Layout.Table.Primitives.LenSpec- ( LenSpec- , expand- , fixed- , expandUntil- , fixedUntil- ) where--import Text.Layout.Table.Primitives.LenSpec.Internal
− src/Text/Layout/Table/Primitives/LenSpec/Internal.hs
@@ -1,35 +0,0 @@-module Text.Layout.Table.Primitives.LenSpec.Internal- ( LenSpec (..)- , expand- , fixed- , expandUntil- , fixedUntil- ) where--import Data.Default.Class---- | Determines how long a column will be.-data LenSpec- = Expand- | Fixed Int- | ExpandUntil Int- | FixedUntil Int--instance Default LenSpec where- def = expand---- | Allows columns to use as much space as needed.-expand :: LenSpec-expand = Expand---- | Fixes column length to a specific width.-fixed :: Int -> LenSpec-fixed = Fixed---- | The column will expand as long as it is smaller as the given width.-expandUntil :: Int -> LenSpec-expandUntil = ExpandUntil---- | The column will be at least as wide as the given width.-fixedUntil :: Int -> LenSpec-fixedUntil = FixedUntil
− src/Text/Layout/Table/Primitives/Occurence.hs
@@ -1,26 +0,0 @@-module Text.Layout.Table.Primitives.Occurence- ( OccSpec- , predOccSpec- , splitAtOcc- ) where--import Control.Arrow---- | Specifies an occurence of a letter.-data OccSpec = OccSpec (Char -> Bool) Int---- | Construct an occurence specification by using a predicate.-predOccSpec :: (Char -> Bool) -> OccSpec-predOccSpec p = OccSpec p 0---- | Use an occurence specification to split a 'String'.-splitAtOcc :: OccSpec -> String -> (String, String)-splitAtOcc (OccSpec p occ) = first reverse . go 0 []- where- go n ls xs = case xs of- [] -> (ls, [])- x : xs' -> if p x- then if n == occ- then (ls, xs)- else go (succ n) (x : ls) xs'- else go n (x : ls) xs'
+ src/Text/Layout/Table/Primitives/Table.hs view
@@ -0,0 +1,40 @@+-- | This module provides primitives for generating tables. Tables are generated+-- line by line thus the functions in this module produce+module Text.Layout.Table.Primitives.Table where++import Data.List++import Text.Layout.Table.StringBuilder+import Text.Layout.Table.Spec.Util+++-- | Draw a horizontal line that will use the delimiters around the+-- appropriately and visually separate by 'hSpace'.+hLineDetail+ :: StringBuilder b+ => Char -- ^ The space character that is used as padding.+ -> Char -- ^ The delimiter that is used on the left side.+ -> Char -- ^ The delimiter that is used in between cells.+ -> Char -- ^ The delimiter that is sued on the right side.+ -> Row b -- ^ A row of builders.+ -> b -- ^ The formatted line as a 'StringBuilder'.+hLineDetail hSpace delimL delimM delimR cells =+ mconcat $ intersperse (charB hSpace) $ charB delimL : intersperse (charB delimM) cells ++ [charB delimR]++-- | A simplified version of 'hLineDetail' that will use the same delimiter+-- for everything.+hLine+ :: StringBuilder b+ => Char -- ^ The space character that is used as padding.+ -> Char -- ^ The delimiter that is used for everything.+ -> Row b -- ^ A row of builders.+ -> b -- ^ The formatted line as a 'StringBuilder'.+hLine hSpace delim = hLineDetail hSpace delim delim delim++-- | Render a line with actual content.+hLineContent+ :: StringBuilder b+ => Char -- ^ The delimiter that is used for everything.+ -> Row b -- ^ A row of builders.+ -> b+hLineContent = hLine ' '
+ src/Text/Layout/Table/Spec/AlignSpec.hs view
@@ -0,0 +1,36 @@+module Text.Layout.Table.Spec.AlignSpec+ ( AlignSpec(..)+ , noAlign+ , occSpecAlign+ , predAlign+ , charAlign+ ) where++import Data.Default.Class++import Text.Layout.Table.Spec.OccSpec++-- | Determines whether a column will align at a specific letter.+data AlignSpec+ = AlignOcc OccSpec+ | NoAlign++-- | No alignment is the default.+instance Default AlignSpec where+ def = noAlign++-- | Don't align text.+noAlign :: AlignSpec+noAlign = NoAlign++-- | Construct an 'AlignSpec' by giving an occurence specification.+occSpecAlign :: OccSpec -> AlignSpec+occSpecAlign = AlignOcc++-- | Align at the first match of a predicate.+predAlign :: (Char -> Bool) -> AlignSpec+predAlign = occSpecAlign . predOccSpec++-- | Align text at the first occurence of a given 'Char'.+charAlign :: Char -> AlignSpec+charAlign = predAlign . (==)
+ src/Text/Layout/Table/Spec/ColSpec.hs view
@@ -0,0 +1,33 @@+module Text.Layout.Table.Spec.ColSpec+ ( ColSpec+ , lenSpec+ , position+ , alignSpec+ , cutMark+ , column+ ) where++import Data.Default.Class++import Text.Layout.Table.Primitives.Basic ()+import Text.Layout.Table.Spec.CutMark+import Text.Layout.Table.Spec.AlignSpec+import Text.Layout.Table.Spec.LenSpec+import Text.Layout.Table.Spec.Position+++-- | Specifies the layout of a column.+data ColSpec+ = ColSpec+ { lenSpec :: LenSpec+ , position :: Position H+ , alignSpec :: AlignSpec+ , cutMark :: CutMark+ }++instance Default ColSpec where+ def = column def def def def++-- | Smart constructor to specify a column.+column :: LenSpec -> Position H -> AlignSpec -> CutMark -> ColSpec+column = ColSpec
+ src/Text/Layout/Table/Spec/CutMark.hs view
@@ -0,0 +1,37 @@+-- TODO rename cut marks (they are too long)+module Text.Layout.Table.Spec.CutMark+ ( CutMark+ , doubleCutMark+ , singleCutMark+ , noCutMark+ , leftMark+ , rightMark+ ) where++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.+data CutMark+ = CutMark+ { leftMark :: String+ , rightMark :: String+ }++-- | A single ellipsis unicode character is used to show cut marks.+instance Default CutMark where+ def = singleCutMark "…"++-- | Specify two different cut marks, one for cuts on the left and one for cuts+-- on the right.+doubleCutMark :: String -> String -> CutMark+doubleCutMark = CutMark++-- | Use the cut mark on both sides by reversing it on the other.+singleCutMark :: String -> CutMark+singleCutMark l = doubleCutMark l (reverse l)++-- | Don't show any cut mark when text is cut.+noCutMark :: CutMark+noCutMark = singleCutMark ""+
+ src/Text/Layout/Table/Spec/HeaderColSpec.hs view
@@ -0,0 +1,20 @@+module Text.Layout.Table.Spec.HeaderColSpec where++import Data.Default.Class+import Data.Default.Instances.Base ()++import Text.Layout.Table.Spec.Position+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.+headerColumn :: Position H -> Maybe CutMark -> HeaderColSpec+headerColumn = HeaderColSpec++-- | Header columns are usually centered.+instance Default HeaderColSpec where+ def = headerColumn center def
+ src/Text/Layout/Table/Spec/HeaderSpec.hs view
@@ -0,0 +1,22 @@+module Text.Layout.Table.Spec.HeaderSpec where++import Data.Default.Class++import Text.Layout.Table.Spec.HeaderColSpec++-- | Specifies a header.+data HeaderSpec+ = HeaderHS [HeaderColSpec] [String]+ | NoneHS++-- | By the default the header is not shown.+instance Default HeaderSpec where+ def = NoneHS++-- | Specify a header column for every title.+fullH :: [HeaderColSpec] -> [String] -> HeaderSpec+fullH = HeaderHS++-- | Use titles with the default header column specification.+titlesH :: [String] -> HeaderSpec+titlesH = fullH $ repeat def
+ src/Text/Layout/Table/Spec/LenSpec.hs view
@@ -0,0 +1,35 @@+module Text.Layout.Table.Spec.LenSpec+ ( LenSpec (..)+ , expand+ , fixed+ , expandUntil+ , fixedUntil+ ) where++import Data.Default.Class++-- | Determines how long a column will be.+data LenSpec+ = Expand+ | Fixed Int+ | ExpandUntil Int+ | FixedUntil Int++instance Default LenSpec where+ def = expand++-- | Allows columns to use as much space as needed.+expand :: LenSpec+expand = Expand++-- | Fixes column length to a specific width.+fixed :: Int -> LenSpec+fixed = Fixed++-- | The column will expand as long as it is smaller as the given width.+expandUntil :: Int -> LenSpec+expandUntil = ExpandUntil++-- | The column will be at least as wide as the given width.+fixedUntil :: Int -> LenSpec+fixedUntil = FixedUntil
+ src/Text/Layout/Table/Spec/OccSpec.hs view
@@ -0,0 +1,30 @@+module Text.Layout.Table.Spec.OccSpec+ ( OccSpec+ , predOccSpec+ , splitAtOcc+ , predicate+ ) where++import Control.Arrow++-- | Specifies an occurence of a letter.+data OccSpec = OccSpec (Char -> Bool) Int++predicate :: OccSpec -> (Char -> Bool)+predicate (OccSpec p _) = p++-- | Construct an occurence specification by using a predicate.+predOccSpec :: (Char -> Bool) -> OccSpec+predOccSpec p = OccSpec p 0++-- | Use an occurence specification to split a 'String'.+splitAtOcc :: OccSpec -> String -> (String, String)+splitAtOcc (OccSpec p occ) = first reverse . go 0 []+ where+ go n ls xs = case xs of+ [] -> (ls, [])+ x : xs' -> if p x+ then if n == occ+ then (ls, xs)+ else go (succ n) (x : ls) xs'+ else go n (x : ls) xs'
+ src/Text/Layout/Table/Spec/Position.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+module Text.Layout.Table.Spec.Position where++import Data.Default.Class++-- | Specifies a position relative from a beginning.+data Position orientation+ = Start+ | Center+ | End+ deriving Eq++instance Show (Position H) where+ show p = case p of+ Start -> "left"+ Center -> "center"+ End -> "right"++instance Show (Position V) where+ show p = case p of+ Start -> "top"+ Center -> "center"+ End -> "bottom"++instance Default (Position orientation) where+ def = Start++-- | Horizontal orientation.+data H++-- | Vertical orientation.+data V++left :: Position H+left = Start++right :: Position H+right = End++center :: Position orientation+center = Center++top :: Position V+top = Start++bottom :: Position V+bottom = End
+ src/Text/Layout/Table/Spec/RowGroup.hs view
@@ -0,0 +1,18 @@+module Text.Layout.Table.Spec.RowGroup where++import Text.Layout.Table.Spec.Util++-- | Groups rows together which should not be visually seperated from each other.+newtype RowGroup a+ = RowGroup+ { rows :: [Row a]+ }++-- | Group the given rows together.+rowsG :: [Row a] -> RowGroup a+rowsG = RowGroup++-- | Make a group of a single row.+rowG :: Row a -> RowGroup a+rowG = RowGroup . (: [])+
+ src/Text/Layout/Table/Spec/Util.hs view
@@ -0,0 +1,7 @@+module Text.Layout.Table.Spec.Util where++-- | An alias for lists, conceptually for values with a horizontal arrangement.+type Row a = [a]++-- | An alias for lists, conceptually for values with a vertical arrangement.+type Col a = [a]
+ src/Text/Layout/Table/StringBuilder.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleInstances #-}+module Text.Layout.Table.StringBuilder where++import Data.Semigroup++-- | A type that is used to construct parts of a table.+class Monoid a => StringBuilder a where+ -- | Create a builder with a 'String'.+ stringB :: String -> a++ -- | Create a builder with a single 'Char'.+ charB :: Char -> a++ -- | Create a builder with several 'Char's.+ replicateCharB :: Int -> Char -> a+ replicateCharB i c = stimesMonoid i (charB c)++ {-# MINIMAL stringB, charB #-}++-- | Create a builder that contains /k/ spaces. Negative numbers are treated as+-- zero.+spacesB :: StringBuilder a => Int -> a+spacesB k = replicateCharB k ' '++instance StringBuilder String where+ stringB = id+ charB = (: [])+ replicateCharB = replicate++instance StringBuilder (Endo String) where+ stringB = diff+ charB = Endo . (:)+ replicateCharB i c = Endo $ \s -> foldr ($) s $ replicate i (c :) +
src/Text/Layout/Table/Vertical.hs view
@@ -10,8 +10,8 @@ import Data.List -import Text.Layout.Table.Internal-import Text.Layout.Table.Position.Internal+import Text.Layout.Table.Spec.Position+import Text.Layout.Table.Spec.Util import Text.Layout.Table.Primitives.Basic {- | Merges multiple columns together to a valid grid without holes. For example:@@ -21,8 +21,8 @@ The result is intended to be used with a grid layout function like 'Text.Layout.Table.grid'. -}-colsAsRowsAll :: Position V -> [Col [a]] -> [Row [a]]-colsAsRowsAll ps = transpose . vPadAll [] ps+colsAsRowsAll :: Monoid a => Position V -> [Col a] -> [Row a]+colsAsRowsAll ps = transpose . vPadAll mempty ps {- | Works like 'colsAsRowsAll' but every position can be specified on its own:@@ -30,8 +30,8 @@ >>> colsAsRows [top, center, bottom] [["a1"], ["b1", "b2", "b3"], ["c3"]] [["a1","b1",""],["","b2",""],["","b3","c3"]] -}-colsAsRows :: [Position V] -> [Col [a]] -> [Row [a]]-colsAsRows ps = transpose . vPad [] ps+colsAsRows :: Monoid a => [Position V] -> [Col a] -> [Row a]+colsAsRows ps = transpose . vPad mempty ps -- | Fill all columns to the same length by aligning at the given position. vPadAll :: a -> Position V -> [Col a] -> [Col a]
table-layout.cabal view
@@ -6,7 +6,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.8.0.5+version: 0.9.0.0 synopsis: Layout text as grid or table. @@ -40,7 +40,7 @@ build-type: Simple -- Extra files to be distributed with the package, such as examples or a -- README.-extra-source-files: README.md+extra-source-files: README.md, CHANGELOG.md -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10@@ -52,22 +52,33 @@ library exposed-modules: Text.Layout.Table,+ Text.Layout.Table.Cell,+ Text.Layout.Table.Cell.Formatted, Text.Layout.Table.Justify, Text.Layout.Table.Style,- Text.Layout.Table.Position, - Text.Layout.Table.Primitives.Basic, - Text.Layout.Table.Primitives.AlignSpec, - Text.Layout.Table.Primitives.Column,- Text.Layout.Table.Primitives.LenSpec,- Text.Layout.Table.Primitives.Occurence,- Text.Layout.Table.Internal,- Text.Layout.Table.Vertical- - other-modules: - Text.Layout.Table.Primitives.AlignSpec.Internal,- Text.Layout.Table.Primitives.LenSpec.Internal,- Text.Layout.Table.Position.Internal+ Text.Layout.Table.Vertical,+ Text.Layout.Table.StringBuilder,+ Text.Layout.Table.Pandoc, ++ -- Will be moved into another package in the future.+ Text.Layout.Table.Primitives.AlignInfo,+ Text.Layout.Table.Primitives.Basic,+ Text.Layout.Table.Primitives.ColumnModifier,+ Text.Layout.Table.Primitives.Header,+ Text.Layout.Table.Primitives.Table,+ Text.Layout.Table.Spec.AlignSpec,+ Text.Layout.Table.Spec.ColSpec,+ Text.Layout.Table.Spec.CutMark,+ Text.Layout.Table.Spec.HeaderColSpec,+ Text.Layout.Table.Spec.HeaderSpec,+ Text.Layout.Table.Spec.LenSpec,+ Text.Layout.Table.Spec.OccSpec,+ Text.Layout.Table.Spec.Position,+ Text.Layout.Table.Spec.RowGroup,+ Text.Layout.Table.Spec.Util+ other-modules:+ -- LANGUAGE extensions used by modules in this package. other-extensions: RecordWildCards,@@ -77,7 +88,7 @@ MultiWayIf -- Other library packages from which modules are imported.- build-depends: base >=4.8 && <4.13,+ build-depends: base >=4.9 && <4.14, data-default-class >=0.1.1 && < 0.2, data-default-instances-base ==0.1.* @@ -88,31 +99,42 @@ executable table-layout-test-styles main-is: Test.hs- build-depends: base >=4.8 && <4.13,+ build-depends: base >=4.9 && <4.14, data-default-class >=0.1.1 && < 0.2, data-default-instances-base ==0.1.* hs-source-dirs: src other-modules: Text.Layout.Table,- Text.Layout.Table.Internal,+ Text.Layout.Table.Cell,+ Text.Layout.Table.Cell.Formatted, Text.Layout.Table.Justify,- Text.Layout.Table.Position,- Text.Layout.Table.Position.Internal,- Text.Layout.Table.Primitives.AlignSpec,- Text.Layout.Table.Primitives.AlignSpec.Internal,+ Text.Layout.Table.Style,+ Text.Layout.Table.Vertical++ Text.Layout.Table.Primitives.AlignInfo, Text.Layout.Table.Primitives.Basic,- Text.Layout.Table.Primitives.Column,- Text.Layout.Table.Primitives.LenSpec,- Text.Layout.Table.Primitives.LenSpec.Internal,- Text.Layout.Table.Primitives.Occurence,- Text.Layout.Table.Style Text.Layout.Table.Vertical+ Text.Layout.Table.Primitives.ColumnModifier,+ Text.Layout.Table.Primitives.Header,+ Text.Layout.Table.Primitives.Table,+ Text.Layout.Table.StringBuilder, + Text.Layout.Table.Spec.AlignSpec,+ Text.Layout.Table.Spec.ColSpec,+ Text.Layout.Table.Spec.CutMark,+ Text.Layout.Table.Spec.HeaderColSpec,+ Text.Layout.Table.Spec.HeaderSpec,+ Text.Layout.Table.Spec.LenSpec,+ Text.Layout.Table.Spec.OccSpec,+ Text.Layout.Table.Spec.Position,+ Text.Layout.Table.Spec.RowGroup,+ Text.Layout.Table.Spec.Util+ default-language: Haskell2010 test-suite table-layout-tests type: exitcode-stdio-1.0 hs-source-dirs: test-suite, src main-is: Spec.hs- build-depends: base >=4.8 && <4.13,+ build-depends: base >=4.9 && <4.14, QuickCheck >=2.8 && < 2.14, HUnit >=1.3, data-default-class >=0.1.1 && < 0.2,@@ -120,19 +142,31 @@ hspec other-modules: TestSpec,- Text.Layout.Table,- Text.Layout.Table.Internal,++ Text.Layout.Table++ Text.Layout.Table.Cell,+ Text.Layout.Table.Cell.Formatted, Text.Layout.Table.Justify,- Text.Layout.Table.Position,- Text.Layout.Table.Position.Internal,- Text.Layout.Table.Primitives.AlignSpec,- Text.Layout.Table.Primitives.AlignSpec.Internal,- Text.Layout.Table.Primitives.Basic,- Text.Layout.Table.Primitives.Column,- Text.Layout.Table.Primitives.LenSpec,- Text.Layout.Table.Primitives.LenSpec.Internal,- Text.Layout.Table.Primitives.Occurence, Text.Layout.Table.Style, Text.Layout.Table.Vertical++ Text.Layout.Table.Primitives.AlignInfo,+ Text.Layout.Table.Primitives.Basic,+ Text.Layout.Table.Primitives.ColumnModifier,+ Text.Layout.Table.Primitives.Header,+ Text.Layout.Table.Primitives.Table,+ Text.Layout.Table.StringBuilder,++ Text.Layout.Table.Spec.AlignSpec,+ Text.Layout.Table.Spec.ColSpec,+ Text.Layout.Table.Spec.CutMark,+ Text.Layout.Table.Spec.HeaderColSpec,+ Text.Layout.Table.Spec.HeaderSpec,+ Text.Layout.Table.Spec.LenSpec,+ Text.Layout.Table.Spec.OccSpec,+ Text.Layout.Table.Spec.Position,+ Text.Layout.Table.Spec.RowGroup,+ Text.Layout.Table.Spec.Util default-language: Haskell2010
test-suite/TestSpec.hs view
@@ -2,23 +2,25 @@ ( spec ) where +-- TODO idempotency of fitting CMIs+ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck-import Test.HUnit import Text.Layout.Table-import Text.Layout.Table.Primitives.Occurence+import Text.Layout.Table.Cell (determineCuts, CutInfo(..), determineCutAction, CutAction(..), applyCutInfo, viewRange)+import Text.Layout.Table.Spec.OccSpec import Text.Layout.Table.Primitives.Basic spec :: Spec spec = do describe "fill" $ do- describe "fillLeft" $ do+ describe "fillLeft" $ it "ex1" $ fillLeft 4 "ab" `shouldBe` " ab"- describe "fillRight" $ do+ describe "fillRight" $ it "ex1" $ fillRight 4 "ab" `shouldBe` "ab "- describe "fillCenter" $ do+ describe "fillCenter" $ it "ex1" $ fillCenter 4 "ab" `shouldBe` " ab " describe "mark" $ do@@ -42,15 +44,17 @@ -- it "ensureWidthCMI" $ describe "pad" $ do- prop "left" $ propPadLeft- prop "right" $ propPadRight- prop "center" $ propPadCenter+ prop "left" propPadLeft+ prop "right" propPadRight+ prop "center" propPadCenter describe "trimOrPad" $ do- prop "pad" $ forAll hposG $ \p s (Positive (Small n)) -> length s > n || trimOrPad p noCutMark n s == pad p n s+ prop "pad" $ forAll hposG $ \p s (Positive (Small n)) ->+ length (s :: String) > n || trimOrPad p noCutMark n s == (pad p n s :: String) it "left" $ trimOrPad left customCM 5 "1234567890" `shouldBe` "12..>" it "right" $ trimOrPad right customCM 5 "1234567890" `shouldBe` "<..90" it "center" $ trimOrPad center customCM 8 "1234567890" `shouldBe` "<..56..>"+ it "center one sided" $ trimOrPad center customCM 9 "1234567890" `shouldBe` "<..567890" describe "align" $ do let ai = deriveAlignInfo occS "abc:42"@@ -58,6 +62,58 @@ it "ex2" $ align occS ai "x" `shouldBe` " x " it "ex3" $ align occS ai ":x" `shouldBe` " :x " + describe "determineCuts" $ do+ describe "cases" $ do+ it "view entails the cell" $ determineCuts 0 8 2 6 `shouldBe` SidesCI (FillCA 2) (FillCA 2)+ it "cell entails the view" $ determineCuts 2 6 0 8 `shouldBe` SidesCI (CutCA 2) (CutCA 2)+ it "disjunct and view left" $ determineCuts 0 2 4 6 `shouldBe` MarkRightCI+ it "disjunct and view right" $ determineCuts 4 6 0 2 `shouldBe` MarkLeftCI+ it "one side cut and view left" $ determineCuts 0 4 2 6 `shouldBe` SidesCI (FillCA 2) (CutCA 2)+ it "one side cut and view right" $ determineCuts 2 6 0 4 `shouldBe` SidesCI (CutCA 2) (FillCA 2)++ describe "bound tests" $ do+ it "disjunct and view right" $ determineCuts 1 2 0 1 `shouldBe` MarkLeftCI+ it "disjunct and view left" $ determineCuts 0 1 1 2 `shouldBe` MarkRightCI++ describe "determineCutAction" $ do+ it "actual width has less than required" $ determineCutAction 8 4 `shouldBe` FillCA 4+ it "actual width has exactly the required amount" $ determineCutAction 8 8 `shouldBe` NoneCA+ it "actual width has more than required" $ determineCutAction 4 6 `shouldBe` CutCA 2++ describe "applyCutInfo" $ do+ let apply ci = applyCutInfo ci customCM 5 11 "abcde:12345" :: String+ apply2 ci s = applyCutInfo ci customCM 5 (length s) s :: String+ apply3 ci n s = applyCutInfo ci customCM n (length s) s :: String+ -- "<...>"+ it "double cut" $ apply (SidesCI (CutCA 3) (CutCA 3)) `shouldBe` "<...>"+ it "left cut" $ apply (SidesCI (CutCA 6) NoneCA) `shouldBe` "<..45"+ it "left cut and pad" $ apply (SidesCI (CutCA 7) (FillCA 1)) `shouldBe` "<..5 "+ it "right cut" $ apply (SidesCI NoneCA (CutCA 6)) `shouldBe` "ab..>"+ it "right cut and pad" $ apply (SidesCI (FillCA 1) (CutCA 7)) `shouldBe` " a..>"+ it "double pad" $ apply2 (SidesCI (FillCA 1) (FillCA 1)) "abc" `shouldBe` " abc "+ it "no action" $ apply2 (SidesCI NoneCA NoneCA) "abcde" `shouldBe` "abcde"+ it "mark right 1" $ apply3 MarkRightCI 1 "" `shouldBe` ">"+ it "mark right 2" $ apply3 MarkRightCI 2 "" `shouldBe` ".>"+ it "mark right 3" $ apply3 MarkRightCI 4 "a" `shouldBe` " ..>"+ it "mark left 1" $ apply3 MarkLeftCI 1 "" `shouldBe` "<"+ it "mark left 2" $ apply3 MarkLeftCI 2 "" `shouldBe` "<."+ it "mark left 3" $ apply3 MarkLeftCI 4 "a" `shouldBe` "<.. "++ describe "viewRange" $ do+ -- " : "+ -- " "+ it "left" $ viewRange left 4 5 5 `shouldBe` (0, 4)+ -- " : "+ -- " "+ -- 01234567891+ it "right" $ viewRange right 4 5 5 `shouldBe` (7, 11)+ -- " : "+ -- " " (left-biased centering)+ -- " " (right-biased-centering)+ -- (l + r + 1 - n) / 2 = (5 + 5 + 1 - 4) / 2 = 7 / 2 = 3 rem 1+ it "center" $ viewRange center 4 5 5 `shouldBe` (4, 8)++ describe "alignFixed" $ do -- 5 spaces on each side. let ai = deriveAlignInfo occS " : "@@ -68,7 +124,9 @@ it "left 2" $ alignFixed' left 6 "abcd:42" `shouldBe` " ab..>" it "left 3" $ alignFixed' left 5 "32" `shouldBe` " 32"-+ -- " : "+ -- "ab:1234"+ -- "<..34 " it "right 1" $ alignFixed' right 6 "ab:1234" `shouldBe` "<..34 " it "right 2" $ alignFixed' right 6 "ab:12" `shouldBe` "<.. " -- ensure left-biased centering:@@ -89,29 +147,29 @@ -- TODO add test cases for all combinations of lengths -- (i.e.: i mod 2 = 1, i mod 2 = 0, l + r mod 2 = 0, l + r mod 2 = 1) - prop "alignFixed length" $ forAll hposG $ \p s (Positive (Small n)) -> length (alignFixed' p n s) `shouldBe` n+ prop "alignFixed length" $ forAll hposG $ \p s (Positive (Small n)) ->+ length (alignFixed' p n (s :: String) :: String) `shouldBe` n++ describe "text justification" $+ it "justify" $ justify 3 ["not", "now"] `shouldBe` ["not", "now"] where customCM = doubleCutMark "<.." "..>" occS = predOccSpec (== ':') hposG = elements [left, center, right]- noWS = (/= ' ') propPadLeft :: String -> Positive (Small Int) -> Bool propPadLeft s (Positive (Small n)) = let len = length s padded = pad left n s- in if len < n- then take len padded == s && all (== ' ') (drop len padded)- else True+ in len >= n || (take len padded == s && all (== ' ') (drop len padded)) propPadRight :: String -> Positive (Small Int) -> Bool propPadRight s (Positive (Small n)) = let len = length s padded = pad right n s- in if len < n- then drop (n - len) padded == s && all (== ' ') (take (n - len) padded)- else True+ in len >= n || (drop (n - len) padded == s+ && all (== ' ') (take (n - len) padded)) propPadCenter :: String -> Positive (Small Int) -> Bool propPadCenter s (Positive (Small n)) =@@ -119,6 +177,5 @@ padded = pad center n s (q, r) = (n - len) `divMod` 2 trimLeft = drop q padded- in if len < n- then all (== ' ') (take q padded) && take len trimLeft == s && (drop len trimLeft) == replicate (q + r) ' '- else True+ in len >= n || (all (== ' ') (take q padded) && take len trimLeft == s+ && drop len trimLeft == replicate (q + r) ' ')