table-layout 0.4.0.1 → 0.5.0.0
raw patch · 14 files changed
+398/−206 lines, 14 filesdep +HUnitdep +QuickCheckdep +hspecdep ~basedep ~data-default-class
Dependencies added: HUnit, QuickCheck, hspec
Dependency ranges changed: base, data-default-class
Files
- src/Text/Layout/Table.hs +149/−127
- src/Text/Layout/Table/Internal.hs +5/−19
- src/Text/Layout/Table/Justify.hs +3/−1
- src/Text/Layout/Table/Position.hs +11/−29
- src/Text/Layout/Table/Position/Internal.hs +30/−0
- src/Text/Layout/Table/Primitives/AlignSpec.hs +9/−0
- src/Text/Layout/Table/Primitives/AlignSpec/Internal.hs +34/−0
- src/Text/Layout/Table/Primitives/Basic.hs +26/−23
- src/Text/Layout/Table/Primitives/Column.hs +31/−0
- src/Text/Layout/Table/Primitives/LenSpec.hs +9/−0
- src/Text/Layout/Table/Primitives/LenSpec/Internal.hs +31/−0
- src/Text/Layout/Table/Primitives/Occurence.hs +26/−0
- table-layout.cabal +33/−7
- test-suite/Spec.hs +1/−0
src/Text/Layout/Table.hs view
@@ -4,7 +4,7 @@ -- text and fancy tables with styling support. -- -- == Some examples--- Layouting text as a plain grid:+-- Layouting text as a plain grid (given a list of rows): -- -- >>> putStrLn $ layoutToString [["a", "b"], ["c", "d"]] (repeat def) -- a b@@ -12,7 +12,7 @@ -- -- Fancy table without header: ----- >>> putStrLn $ layoutTableToString [rowGroup [["Jack", "184.74"]], rowGroup [["Jane", "162.2"]]] Nothing [def , numL] unicodeRoundS+-- >>> putStrLn $ layoutTableToString [rowGroup [["Jack", "184.74"]], rowGroup [["Jane", "162.2"]]] def [def , numCol] unicodeRoundS -- ╭──────┬────────╮ -- │ Jack │ 184.74 │ -- ├──────┼────────┤@@ -25,12 +25,7 @@ -- , rowGroup [["Short text", "100200.5"]] -- ] -- (Just (["Title", "Length"], repeat def))--- [ fixedLeftL 20--- , ColSpec (fixed 10)--- center--- dotAlign--- ellipsisCutMark--- ]+-- [fixedLeftCol 20, column (fixed 10) center dotAlign ellipsisCutMark] -- unicodeRoundS -- ╭──────────────────────┬────────────╮ -- │ Title │ Length │@@ -43,36 +38,42 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE MultiWayIf #-} module Text.Layout.Table- ( -- * Layout types and combinators- -- $layout- ColSpec+ ( -- * Layout combinators+ -- | Specify how a column is rendered with the combinators in this+ -- section. Sensible default values are provided with 'def'.++ module Data.Default.Class++ -- ** Columns+ , ColSpec , column , numCol , fixedCol , fixedLeftCol+ -- ** Length of columns , LenSpec , expand , fixed , expandUntil , fixedUntil+ -- ** Positional alignment , Position , H , left , right , center+ -- ** Alignment of cells at characters , AlignSpec , noAlign , charAlign , predAlign , dotAlign- , isAligned- , OccSpec- , CutMarkSpec- , ellipsisCutMark+ -- ** Cut marks+ , CutMark , noCutMark , singleCutMark- , cutMark- , module Data.Default.Class+ , doubleCutMark+ , ellipsisCutMark -- * Basic grid and table layout , layoutToCells@@ -112,6 +113,7 @@ , alignFixed -- * Column modifaction primitives+ -- | Render your own kind of tables with the following functions. , ColModInfo , widthCMI , unalignedCMI@@ -122,6 +124,7 @@ , widthAI , deriveColModInfos , deriveAlignInfo+ , OccSpec ) where -- TODO AlignSpec: multiple alignment points - useful?@@ -129,7 +132,7 @@ -- 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)--- TODO OccSpec: expose smart constructors+-- TODO move functions not related to direct end-user into Primitives import qualified Control.Arrow as A import Data.List@@ -138,73 +141,30 @@ import Text.Layout.Table.Justify import Text.Layout.Table.Style-import Text.Layout.Table.Position+import Text.Layout.Table.Position.Internal+import Text.Layout.Table.Primitives.AlignSpec.Internal 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 ------------------------------------------------------------------------------- -- Layout types and combinators --------------------------------------------------------------------------------{- $layout- Specify the layout of columns.--} -column :: LenSpec -> Position H -> AlignSpec -> CutMarkSpec -> ColSpec-column = ColSpec--instance Default ColSpec where- def = column def def def def---- | 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---- | Don't align text.-noAlign :: AlignSpec-noAlign = NoAlign--predAlign :: (Char -> Bool) -> AlignSpec-predAlign p = AlignPred $ OccSpec p 0--charAlign :: Char -> AlignSpec-charAlign = predAlign . (==)---- | Align all text at the first dot from left.+-- | Align all text at the first dot from the left. This is most useful for+-- floating point numbers. dotAlign :: AlignSpec dotAlign = charAlign '.' -isAligned :: AlignSpec -> Bool-isAligned as = case as of- NoAlign -> False- _ -> True---- | No alignment is the default.-instance Default AlignSpec where- def = noAlign--instance Default LenSpec where- def = Expand-- -- | Numbers are positioned on the right and aligned on the floating point dot. numCol :: ColSpec-numCol = ColSpec def right dotAlign def+numCol = column def right dotAlign def -- | Fixes the column length and positions according to the given 'Position'. fixedCol :: Int -> Position H -> ColSpec-fixedCol l pS = ColSpec (Fixed l) pS def def+fixedCol l pS = column (Fixed l) pS def def -- | Fixes the column length and positions on the left. fixedLeftCol :: Int -> ColSpec@@ -233,7 +193,7 @@ -- >>> trimOrPad left (singleCutMark "..") 10 "A longer text." -- "A longer.." ---trimOrPad :: Position o -> CutMarkSpec -> Int -> String -> String+trimOrPad :: Position o -> CutMark -> Int -> String -> String trimOrPad p = case p of Start -> fitRightWith Center -> fitCenterWith@@ -256,50 +216,112 @@ -- | Aligns a column using a fixed width, fitting it to the width by either -- filling or cutting while respecting the alignment.-alignFixed :: Position o -> CutMarkSpec -> Int -> OccSpec -> AlignInfo -> String -> String+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 if n <= 0- then pad p i $ align oS ai s- else case splitAtOcc oS s of+ 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 fillLeft l ls ++ fitRight remRight rs+ 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 remLeft ls ++ fillRight r rs+ else fitLeft (r + remLeft) $ ls ++ fillRight r rs Center ->- let (q, rem) = n `divMod` 2- remLeft = l - q- remRight = r - q - rem- in if | remLeft < 0 -> fitLeft (remRight + remLeft) $ fitRight remRight rs- | remRight < 0 -> fitRight (remLeft + remRight) $ fitLeft remLeft ls- | remLeft == 0 -> applyMarkLeftWith cms $ fitRight remRight rs- | remRight == 0 -> applyMarkRight $ fitLeft remLeft ls- | otherwise -> fitRight (remRight + remLeft) $ fitLeft remLeft ls ++ rs+ {-+ 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 (applyMarkLeftWith cms, 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 -splitAtOcc :: OccSpec -> String -> (String, String)-splitAtOcc (OccSpec p occ) = A.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'- -- | Specifies how a column should be modified. data ColModInfo = FillAligned OccSpec AlignInfo | FillTo Int@@ -341,12 +363,12 @@ ensureWidthOfCMI = ensureWidthCMI . length -- | Generates a function which modifies a given 'String' according to--- 'Position H', 'CutMarkSpec' and 'ColModInfo'.-columnModifier :: Position H -> CutMarkSpec -> ColModInfo -> (String -> String)+-- 'Text.Layout.Table.Position.Position', 'CutMark' and 'ColModInfo'.+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 ->+ FitTo lim mT -> maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT -- TODO factor out@@ -369,27 +391,27 @@ 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- AlignPred 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)+ 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 using the 'OccSpec'.@@ -404,16 +426,16 @@ layoutToCells :: [[String]] -> [ColSpec] -> [[String]] layoutToCells tab specs = zipWith apply tab . repeat- . zipWith (uncurry columnModifier) (map (position A.&&& cutMarkSpec) specs)+ . zipWith (uncurry columnModifier) (map (position A.&&& cutMark) specs) $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs) tab where apply = zipWith $ flip ($) --- | Behaves like 'layoutCells' but produces lines by joining with whitespace.+-- | Behaves like 'layoutToCells' but produces lines by joining with whitespace. layoutToLines :: [[String]] -> [ColSpec] -> [String] layoutToLines tab specs = map unwords $ layoutToCells tab specs --- | Behaves like 'layoutCells' but produces a 'String' by joining with the+-- | Behaves like 'layoutToCells' but produces a 'String' by joining with the -- newline character. layoutToString :: [[String]] -> [ColSpec] -> String layoutToString tab specs = intercalate "\n" $ layoutToLines tab specs@@ -445,7 +467,7 @@ instance Default HeaderColSpec where def = headerColumn center Nothing -headerColumn :: Position H -> Maybe CutMarkSpec -> HeaderColSpec+headerColumn :: Position H -> Maybe CutMark -> HeaderColSpec headerColumn = HeaderColSpec -- | Layouts a good-looking table with a optional header. Note that specifying@@ -479,8 +501,8 @@ (addHeaderLines, fitHeaderIntoCMIs, realTopH, realTopL, realTopC, realTopR) = case optHeaderInfo of Just (h, headerColSpecs) -> let headerLine = vLine ' ' headerV (zipApply h headerRowMods)- headerRowMods = zipWith3 (\(HeaderColSpec pos optCutMarkSpec) cutMarkSpec ->- columnModifier pos $ fromMaybe cutMarkSpec optCutMarkSpec+ headerRowMods = zipWith3 (\(HeaderColSpec pos optCutMark) cutMark ->+ columnModifier pos $ fromMaybe cutMark optCutMark ) headerColSpecs cMSs@@ -502,7 +524,7 @@ , groupTopR ) - cMSs = map cutMarkSpec specs+ cMSs = map cutMark specs posSpecs = map position specs applyRowMods xss = zipWith zipApply xss $ repeat rowMods rowMods = zipWith3 columnModifier posSpecs cMSs cMIs
src/Text/Layout/Table/Internal.hs view
@@ -1,30 +1,16 @@ module Text.Layout.Table.Internal where +import Data.Default.Class+ import Text.Layout.Table.Position import Text.Layout.Table.Primitives.Basic --- | Specifies the layout of a column.-data ColSpec = ColSpec- { lenSpec :: LenSpec- , position :: Position H- , alignSpec :: AlignSpec- , cutMarkSpec :: CutMarkSpec- }---- | Determines how long a column will be.-data LenSpec = Expand | Fixed Int | ExpandUntil Int | FixedUntil Int---- | Determines whether a column will align at a specific letter.-data AlignSpec = AlignPred OccSpec | NoAlign---- | Specifies an occurence of a letter.-data OccSpec = OccSpec (Char -> Bool) Int- -- | Groups rows together, which are not seperated from each other. data RowGroup = RowGroup { rows :: [[String]] } -- | Specifies how a header is layout, by omitting the cut mark it will use the--- one specified in the 'ColSpec' like the other cells in that column.-data HeaderColSpec = HeaderColSpec (Position H) (Maybe CutMarkSpec)+-- one specified in the 'Text.Layout.Primitives.Column.ColSpec' like the other+-- cells in that column.+data HeaderColSpec = HeaderColSpec (Position H) (Maybe CutMark)
src/Text/Layout/Table/Justify.hs view
@@ -18,7 +18,7 @@ import Data.List import Text.Layout.Table.Primitives.Basic-import Text.Layout.Table.Position+import Text.Layout.Table.Position.Internal -- | Justifies texts and presents the resulting lines in a grid structure (each -- text in one column).@@ -37,6 +37,8 @@ >>> columnsAsGrid top [justifyText 10 "This text will not fit on one line.", ["42", "23"]] [["This text","42"],["will not","23"],["fit on one",""],["line.",""]] +The result is intended to be used with 'Text.Layout.Table.layoutToCells' or with+'Text.Layout.Table.rowGroup'. -} columnsAsGrid :: Position V -> [[[a]]] -> [[[a]]] columnsAsGrid vPos = transpose . vpadCols vPos []
src/Text/Layout/Table/Position.hs view
@@ -1,31 +1,13 @@ {-# LANGUAGE PatternSynonyms #-}-module Text.Layout.Table.Position where--import Data.Default.Class---- | Specifies a position relative from a beginning.-data Position orientation = Start | Center | End deriving Show--instance Default (Position o) where- def = Start---- | Horizontal orientation.-data H---- | Vertical orientation-data V--left :: Position H-left = Start--right :: Position H-right = End--center :: Position o-center = Center--top :: Position V-top = Start+module Text.Layout.Table.Position+ ( Position+ , H+ , V+ , left+ , right+ , center+ , top+ , bottom+ ) where -bottom :: Position V-bottom = End+import Text.Layout.Table.Position.Internal
+ src/Text/Layout/Table/Position/Internal.hs view
@@ -0,0 +1,30 @@+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 Show++instance Default (Position o) 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/AlignSpec.hs view
@@ -0,0 +1,9 @@+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 view
@@ -0,0 +1,34 @@+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
@@ -2,26 +2,31 @@ -- filled or fitted to a specific length. module Text.Layout.Table.Primitives.Basic ( -- * Cut marks- CutMarkSpec- , cutMark+ CutMark+ , doubleCutMark , singleCutMark , noCutMark , ellipsisCutMark -- * String-related tools , spaces++ -- ** Filling , fillLeft' , fillLeft , fillRight , fillCenter' , fillCenter+ -- ** Fitting , fitRightWith , fitLeftWith , fitCenterWith+ -- ** Applying cut marks , applyMarkLeftWith , applyMarkRightWith -- * List-related tools+ -- ** Filling , fillStart' , fillStart , fillEnd@@ -34,31 +39,29 @@ -- | 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 CutMarkSpec = CutMarkSpec+data CutMark = CutMark { leftMark :: String , rightMark :: String } -instance Default CutMarkSpec where+instance Default CutMark where def = ellipsisCutMark -instance Show CutMarkSpec where- show (CutMarkSpec l r) = "cutMark " ++ show l ++ ' ' : show (reverse r)---- | Display custom characters on a cut.-cutMark :: String -> String -> CutMarkSpec-cutMark l r = CutMarkSpec l (reverse r)+-- | 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 same cut mark for left and right.-singleCutMark :: String -> CutMarkSpec-singleCutMark l = cutMark l (reverse l)+-- | Use the cut mark on both sides by reversing it on the other.+singleCutMark :: String -> CutMark+singleCutMark l = doubleCutMark l (reverse l) --- | Don't use a cut mark.-noCutMark :: CutMarkSpec+-- | Don't show any cut mark when text is cut.+noCutMark :: CutMark noCutMark = singleCutMark "" -- | A single unicode character showing three dots is used as cut mark.-ellipsisCutMark :: CutMarkSpec+ellipsisCutMark :: CutMark ellipsisCutMark = singleCutMark "…" spaces :: Int -> String@@ -104,7 +107,7 @@ fillCenter = fillBoth ' ' -- | Fits to the given length by either trimming or filling it to the right.-fitRightWith :: CutMarkSpec -> Int -> String -> String+fitRightWith :: CutMark -> Int -> String -> String fitRightWith cms i s = if length s <= i then fillRight i s@@ -112,7 +115,7 @@ --take i $ take (i - mLen) s ++ take mLen m -- | Fits to the given length by either trimming or filling it to the right.-fitLeftWith :: CutMarkSpec -> Int -> String -> String+fitLeftWith :: CutMark -> Int -> String -> String fitLeftWith cms i s = if lenS <= i then fillLeft' i lenS s@@ -122,7 +125,7 @@ -- | Fits to the given length by either trimming or filling it on both sides, -- but when only 1 character should be trimmed it will trim left.-fitCenterWith :: CutMarkSpec -> Int -> String -> String+fitCenterWith :: CutMark -> Int -> String -> String fitCenterWith cms i s = if diff >= 0 then fillCenter' i lenS s@@ -135,12 +138,12 @@ halfLenS = lenS `div` 2 (halfI, r) = i `divMod` 2 --- | Applies a 'CutMarkSpec' to the left of a 'String', while preserving the length.-applyMarkLeftWith :: CutMarkSpec -> String -> String+-- | Applies a 'CutMark' to the left of a 'String', while preserving the length.+applyMarkLeftWith :: CutMark -> String -> String applyMarkLeftWith cms = applyMarkLeftBy leftMark cms --- | Applies a 'CutMarkSpec' to the right of a 'String', while preserving the length.-applyMarkRightWith :: CutMarkSpec -> String -> String+-- | Applies a 'CutMark' to the right of a 'String', while preserving the length.+applyMarkRightWith :: CutMark -> String -> String applyMarkRightWith cms = reverse . applyMarkLeftBy rightMark cms . reverse applyMarkLeftBy :: (a -> String) -> a -> String -> String
+ src/Text/Layout/Table/Primitives/Column.hs view
@@ -0,0 +1,31 @@+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/LenSpec.hs view
@@ -0,0 +1,9 @@+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 view
@@ -0,0 +1,31 @@+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 view
@@ -0,0 +1,26 @@+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'
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.4.0.1+version: 0.5.0.0 synopsis: Layout text as grid or table. @@ -51,17 +51,28 @@ library- -- Modules exported by the library.- exposed-modules: Text.Layout.Table, Text.Layout.Table.Justify, Text.Layout.Table.Style, Text.Layout.Table.Position, Text.Layout.Table.Primitives.Basic, Text.Layout.Table.Internal+ exposed-modules: Text.Layout.Table,+ 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 - -- Modules included in this library but not exported.- -- other-modules: + other-modules: + Text.Layout.Table.Primitives.AlignSpec.Internal,+ Text.Layout.Table.Primitives.LenSpec.Internal,+ Text.Layout.Table.Position.Internal+ -- LANGUAGE extensions used by modules in this package. other-extensions: RecordWildCards, MultiWayIf -- Other library packages from which modules are imported.- build-depends: base >=4.8 && <4.9, data-default-class ==0.0.1+ build-depends: base >=4.8 && <4.9, data-default-class >=0.0.1 && < 0.1 -- Directories containing source files. hs-source-dirs: src@@ -71,7 +82,22 @@ executable table-layout-test-styles main-is: Test.hs- build-depends: base >=4.8 && <4.9, data-default-class ==0.0.1+ build-depends: base >=4.8 && <4.9, data-default-class >=0.0.1 && < 0.1 hs-source-dirs: src other-modules: Text.Layout.Table+ 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,+ --Cabal,+ QuickCheck >=2.8 && < 2.9,+ HUnit ==1.3.*,+ data-default-class >=0.0.1 && < 0.1,+ hspec++ other-modules: Text.Layout.Table, Text.Layout.Table.Primitives.Basic+ default-language: Haskell2010
+ test-suite/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}