table-layout 0.3.0.0 → 0.4.0.0
raw patch · 8 files changed
+363/−295 lines, 8 filesdep +data-default-class
Dependencies added: data-default-class
Files
- src/Test.hs +17/−21
- src/Text/Layout/Table.hs +122/−129
- src/Text/Layout/Table/Internal.hs +30/−0
- src/Text/Layout/Table/Justify.hs +12/−16
- src/Text/Layout/Table/Position.hs +31/−0
- src/Text/Layout/Table/PrimMod.hs +0/−125
- src/Text/Layout/Table/Primitives/Basic.hs +147/−0
- table-layout.cabal +4/−4
src/Test.hs view
@@ -6,35 +6,28 @@ main :: IO () main = putStrLn $ layoutTableToString rowGroups- (Just (["Layout", "Result"], repeat centerHL))- [ LayoutSpec (ExpandUntil 30) LeftPos (charAlign ':') ellipsisCutMark- , LayoutSpec Expand CenterPos noAlign noCutMark+ (Just (["Layout", "Result"], repeat def))+ [ column (expandUntil 30) left (charAlign ':') ellipsisCutMark+ , column expand center noAlign noCutMark ] unicodeRoundS where rowGroups = flip concatMap styles $ \style ->- flip map layouts $ \layout ->- rowGroup $ columnsAsGrid CenterVPos [ explain layout- , genTable layout style- ]- genTable l s = layoutTableToLines [ rowGroup [ [longText, smallNum, "foo"]+ flip map columTs $ \(cSpec, is) ->+ rowGroup $ columnsAsGrid center [ is+ , genTable cSpec style+ ]+ genTable c s = layoutTableToLines [ rowGroup [ [longText, smallNum, "foo"] , [shortText, bigNum, "bar"] ] ]- (Just (["Some text", "Some numbers", "X"], repeat centerHL))- (repeat l)+ (Just (["Some text", "Some numbers", "X"], repeat def))+ (repeat c) s longText = "This is long text" shortText = "Short" bigNum = "200300400500600.2" smallNum = "4.20000000"- explain l = case l of- LayoutSpec lenSpec posSpec alignSpec cutMarkSpec ->- [ "length: " ++ show lenSpec- , "position: " ++ show posSpec- , "alignment: " ++ if isAligned alignSpec then "at some point" else "not aligned"- , "cut mark: " ++ show cutMarkSpec- ] styles = [ asciiRoundS , unicodeS , unicodeRoundS@@ -42,8 +35,11 @@ , unicodeBoldStripedS , unicodeBoldHeaderS ]- layouts = [ LayoutSpec l p a ellipsisCutMark- | l <- [Expand, Fixed 10, ExpandUntil 10, FixedUntil 10]- , p <- [LeftPos, RightPos, CenterPos]- , a <- [noAlign, dotAlign]+ columTs = [ ( column l p a ellipsisCutMark+ , ["len spec: " ++ dL, "position: " ++ pL, "alignment: " ++ aL]+ )+ | (l, dL) <- zip [expand, fixed 10, expandUntil 10, fixedUntil 10]+ ["expand", "fixed 10", "expand until 10", "fixed until 10"]+ , (p, pL) <- zip [left, right, center] ["left", "right", "center"]+ , (a, aL) <- zip [noAlign, dotAlign] ["no align", "align at '.'"] ]
src/Text/Layout/Table.hs view
@@ -6,13 +6,13 @@ -- == Some examples -- Layouting text as a plain grid: ----- >>> putStrLn $ layoutToString [["a", "b"], ["c", "d"]] (repeat defaultL)+-- >>> putStrLn $ layoutToString [["a", "b"], ["c", "d"]] (repeat def) -- a b -- c d -- -- Fancy table without header: ----- >>> putStrLn $ layoutTableToString [rowGroup [["Jack", "184.74"]], rowGroup [["Jane", "162.2"]]] Nothing [defaultL, numL] unicodeRoundS+-- >>> putStrLn $ layoutTableToString [rowGroup [["Jack", "184.74"]], rowGroup [["Jane", "162.2"]]] Nothing [def , numL] unicodeRoundS -- ╭──────┬────────╮ -- │ Jack │ 184.74 │ -- ├──────┼────────┤@@ -24,10 +24,10 @@ -- >>> putStrLn $ layoutTableToString [ rowGroup [["A very long text", "0.42000000"]] -- , rowGroup [["Short text", "100200.5"]] -- ]--- (Just (["Title", "Length"], repeat centerHL))+-- (Just (["Title", "Length"], repeat def)) -- [ fixedLeftL 20--- , LayoutSpec (Fixed 10)--- CenterPos+-- , ColSpec (fixed 10)+-- center -- dotAlign -- ellipsisCutMark -- ]@@ -45,13 +45,21 @@ module Text.Layout.Table ( -- * Layout types and combinators -- $layout- LayoutSpec(..)- , defaultL- , numL- , fixedL- , fixedLeftL- , LenSpec(..)- , PosSpec(..)+ ColSpec+ , column+ , numCol+ , fixedCol+ , fixedLeftCol+ , LenSpec+ , expand+ , fixed+ , expandUntil+ , fixedUntil+ , Position+ , H+ , left+ , right+ , center , AlignSpec , noAlign , charAlign@@ -60,11 +68,11 @@ , isAligned , OccSpec , CutMarkSpec- , defaultCutMark , ellipsisCutMark , noCutMark , singleCutMark , cutMark+ , module Data.Default.Class -- * Basic grid and table layout , layoutToCells@@ -78,9 +86,8 @@ -- * Advanced table layout , RowGroup , rowGroup- , HeaderLayoutSpec(..)- , centerHL- , leftHL+ , HeaderColSpec+ , headerColumn , layoutTableToLines , layoutTableToString @@ -88,8 +95,10 @@ -- $justify , justify , justifyText- , VertPosSpec(..) , columnsAsGrid+ , top+ , bottom+ , V , justifyTextsAsGrid , justifyWordListsAsGrid @@ -103,13 +112,13 @@ , alignFixed -- * Column modifaction primitives- , ColModInfo(..)+ , ColModInfo , widthCMI , unalignedCMI , ensureWidthCMI , ensureWidthOfCMI , columnModifier- , AlignInfo(..)+ , AlignInfo , widthAI , deriveColModInfos , deriveAlignInfo@@ -119,44 +128,49 @@ -- 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 LayoutSpec: add some kind of combinator to construct LayoutSpec values (e.g. via Monoid, see optparse-applicative)+-- TODO ColSpec: add some kind of combinator to construct ColSpec values (e.g. via Monoid, see optparse-applicative)+-- TODO OccSpec: expose smart constructors -import Control.Arrow-import Data.List-import Data.Maybe+import qualified Control.Arrow as A+import Data.List+import Data.Maybe+import Data.Default.Class -import Text.Layout.Table.PrimMod-import Text.Layout.Table.Justify-import Text.Layout.Table.Style+import Text.Layout.Table.Justify+import Text.Layout.Table.Style+import Text.Layout.Table.Position+import Text.Layout.Table.Primitives.Basic+import Text.Layout.Table.Internal ------------------------------------------------------------------------------- -- Layout types and combinators ------------------------------------------------------------------------------- {- $layout- Specify the layout of columns. Layout combinators have a 'L' as postfix.+ Specify the layout of columns. -} --- | Determines the layout of a column.-data LayoutSpec = LayoutSpec- { lenSpec :: LenSpec- , posSpec :: PosSpec- , alignSpec :: AlignSpec- , cutMarkSpec :: CutMarkSpec- }+column :: LenSpec -> Position H -> AlignSpec -> CutMarkSpec -> ColSpec+column = ColSpec --- | Determines how long a column will be.-data LenSpec = Expand | Fixed Int | ExpandUntil Int | FixedUntil Int deriving Show+instance Default ColSpec where+ def = column def def def def --- | Determines how a column will be positioned. Note that on an odd number of--- space, centering is left-biased.-data PosSpec = LeftPos | RightPos | CenterPos deriving Show+-- | Allows columns to use as much space as needed.+expand :: LenSpec+expand = Expand --- | Determines whether a column will align at a specific letter.-data AlignSpec = AlignPred OccSpec | NoAlign+-- | Fixes column length to a specific width.+fixed :: Int -> LenSpec+fixed = Fixed --- | Specifies an occurence of a letter.-data OccSpec = OccSpec (Char -> Bool) Int+-- | 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@@ -167,7 +181,7 @@ charAlign :: Char -> AlignSpec charAlign = predAlign . (==) --- | Align all text at the dot.+-- | Align all text at the first dot from left. dotAlign :: AlignSpec dotAlign = charAlign '.' @@ -176,37 +190,25 @@ NoAlign -> False _ -> True --- | Use the same cut mark for left and right.-singleCutMark :: String -> CutMarkSpec-singleCutMark l = cutMark l (reverse l)+-- | No alignment is the default.+instance Default AlignSpec where+ def = noAlign --- | Default cut mark used when cutting off text.-defaultCutMark :: CutMarkSpec-defaultCutMark = singleCutMark ".."+instance Default LenSpec where+ def = Expand --- | Don't use a cut mark.-noCutMark :: CutMarkSpec-noCutMark = singleCutMark "" --- | A single unicode character showing three dots is used as cut mark.-ellipsisCutMark :: CutMarkSpec-ellipsisCutMark = singleCutMark "…"---- | The default layout will allow maximum expand and is positioned on the left.-defaultL :: LayoutSpec-defaultL = LayoutSpec Expand LeftPos NoAlign defaultCutMark- -- | Numbers are positioned on the right and aligned on the floating point dot.-numL :: LayoutSpec-numL = LayoutSpec Expand RightPos dotAlign defaultCutMark+numCol :: ColSpec+numCol = ColSpec def right dotAlign def --- | Fixes the column length and positions according to the given 'PosSpec'.-fixedL :: Int -> PosSpec -> LayoutSpec-fixedL l pS = LayoutSpec (Fixed l) pS NoAlign defaultCutMark+-- | 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 -- | Fixes the column length and positions on the left.-fixedLeftL :: Int -> LayoutSpec-fixedLeftL i = fixedL i LeftPos+fixedLeftCol :: Int -> ColSpec+fixedLeftCol i = fixedCol i left ------------------------------------------------------------------------------- -- Single-cell layout functions.@@ -215,27 +217,27 @@ -- | 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 LeftPos 10 "foo"+-- >>> pad left 10 "foo" -- "foo " ---pad :: PosSpec -> Int -> String -> String+pad :: Position o -> Int -> String -> String pad p = case p of- LeftPos -> fillRight- RightPos -> fillLeft- CenterPos -> fillCenter+ Start -> fillRight+ Center -> fillCenter+ End -> fillLeft -- | If the given text is too long, the 'String' will be shortened according to -- the position specification, also adds some dots to indicate that the column -- has been trimmed in length, otherwise behaves like 'pad'. ----- >>> trimOrPad LeftPos (singleCutMark "..") 10 "A longer text."+-- >>> trimOrPad left (singleCutMark "..") 10 "A longer text." -- "A longer.." ---trimOrPad :: PosSpec -> CutMarkSpec -> Int -> String -> String+trimOrPad :: Position o -> CutMarkSpec -> Int -> String -> String trimOrPad p = case p of- LeftPos -> fitRightWith- RightPos -> fitLeftWith- CenterPos -> fitCenterWith+ Start -> fitRightWith+ Center -> fitLeftWith+ End -> fitCenterWith -- | Align a column by first finding the position to pad with and then padding -- the missing lengths to the maximum value. If no such position is found, it@@ -254,7 +256,7 @@ -- | Aligns a column using a fixed width, fitting it to the width by either -- filling or cutting while respecting the alignment.-alignFixed :: PosSpec -> CutMarkSpec -> Int -> OccSpec -> AlignInfo -> String -> String+alignFixed :: Position o -> CutMarkSpec -> Int -> OccSpec -> AlignInfo -> String -> String alignFixed _ cms 0 _ _ _ = "" alignFixed _ cms 1 _ _ s@(_ : (_ : _)) = applyMarkLeftWith cms " " alignFixed p cms i oS ai@(AlignInfo l r) s =@@ -263,17 +265,17 @@ then pad p i $ align oS ai s else case splitAtOcc oS s of (ls, rs) -> case p of- LeftPos ->+ Start -> let remRight = r - n in if remRight < 0 then fitRight (l + remRight) $ fillLeft l ls else fillLeft l ls ++ fitRight remRight rs- RightPos ->+ End -> let remLeft = l - n in if remLeft < 0 then fitLeft (r + remLeft) $ fillRight r rs else fitLeft remLeft ls ++ fillRight r rs- CenterPos ->+ Center -> let (q, rem) = n `divMod` 2 remLeft = l - q remRight = r - q - rem@@ -288,7 +290,7 @@ applyMarkRight = applyMarkRightWith cms splitAtOcc :: OccSpec -> String -> (String, String)-splitAtOcc (OccSpec p occ) = first reverse . go 0 []+splitAtOcc (OccSpec p occ) = A.first reverse . go 0 [] where go n ls xs = case xs of [] -> (ls, [])@@ -320,35 +322,36 @@ -- | Ensures that the modification provides a minimum width, but only if it is -- not limited.-ensureWidthCMI :: Int -> PosSpec -> ColModInfo -> ColModInfo-ensureWidthCMI w posSpec cmi = case cmi of+ensureWidthCMI :: Int -> Position H -> ColModInfo -> ColModInfo+ensureWidthCMI w pos cmi = case cmi of FillAligned oS ai@(AlignInfo lw rw) -> let neededW = widthAI ai - w in if neededW >= 0 then cmi- else FillAligned oS $ case posSpec of- LeftPos -> AlignInfo lw (rw + neededW)- RightPos -> AlignInfo (lw + neededW) rw- CenterPos -> let (q, r) = neededW `divMod` 2 + 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 -> PosSpec -> ColModInfo -> ColModInfo+ensureWidthOfCMI :: String -> Position H -> ColModInfo -> ColModInfo ensureWidthOfCMI = ensureWidthCMI . length -- | Generates a function which modifies a given 'String' according to--- 'PosSpec', 'CutMarkSpec' and 'ColModInfo'.-columnModifier :: PosSpec -> CutMarkSpec -> ColModInfo -> (String -> String)-columnModifier posSpec cms lenInfo = case lenInfo of+-- 'Position H', 'CutMarkSpec' and 'ColModInfo'.+columnModifier :: Position H -> CutMarkSpec -> ColModInfo -> (String -> String)+columnModifier pos cms lenInfo = case lenInfo of FillAligned oS ai -> align oS ai- FillTo maxLen -> pad posSpec maxLen+ FillTo maxLen -> pad pos maxLen FitTo lim mT ->- maybe (trimOrPad posSpec cms lim) (uncurry $ alignFixed posSpec cms lim) mT+ maybe (trimOrPad pos cms lim) (uncurry $ alignFixed pos cms lim) mT +-- TODO factor out -- | Specifies the length before and after a letter.-data AlignInfo = AlignInfo Int Int deriving Show+data AlignInfo = AlignInfo Int Int -- | The column width when using the 'AlignInfo'. widthAI :: AlignInfo -> Int@@ -397,22 +400,22 @@ -- Basic layout ------------------------------------------------------------------------------- --- | Modifies cells according to the given 'LayoutSpec'.-layoutToCells :: [[String]] -> [LayoutSpec] -> [[String]]+-- | Modifies cells according to the given 'ColSpec'.+layoutToCells :: [[String]] -> [ColSpec] -> [[String]] layoutToCells tab specs = zipWith apply tab . repeat- . zipWith (uncurry columnModifier) (map (posSpec &&& cutMarkSpec) specs)- $ deriveColModInfos (map (lenSpec &&& alignSpec) specs) tab+ . zipWith (uncurry columnModifier) (map (position A.&&& cutMarkSpec) specs)+ $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs) tab where apply = zipWith $ flip ($) -- | Behaves like 'layoutCells' but produces lines by joining with whitespace.-layoutToLines :: [[String]] -> [LayoutSpec] -> [String]+layoutToLines :: [[String]] -> [ColSpec] -> [String] layoutToLines tab specs = map unwords $ layoutToCells tab specs -- | Behaves like 'layoutCells' but produces a 'String' by joining with the -- newline character.-layoutToString :: [[String]] -> [LayoutSpec] -> String+layoutToString :: [[String]] -> [ColSpec] -> String layoutToString tab specs = intercalate "\n" $ layoutToLines tab specs -------------------------------------------------------------------------------@@ -434,34 +437,24 @@ -- Advanced layout ------------------------------------------------------------------------------- --- | Groups rows together, which are not seperated from each other.-data RowGroup = RowGroup- { rows :: [[String]] - }- -- | Construct a row group from a list of rows. rowGroup :: [[String]] -> RowGroup rowGroup = RowGroup --- | Specifies how a header is layout, by omitting the cut mark it will use the--- one specified in the 'LayoutSpec' like the other cells in that column.-data HeaderLayoutSpec = HeaderLayoutSpec PosSpec (Maybe CutMarkSpec)---- | A centered header layout.-centerHL :: HeaderLayoutSpec-centerHL = HeaderLayoutSpec CenterPos Nothing+-- | Header columns are usually centered.+instance Default HeaderColSpec where+ def = headerColumn center Nothing --- | A left-positioned header layout.-leftHL :: HeaderLayoutSpec-leftHL = HeaderLayoutSpec LeftPos Nothing+headerColumn :: Position H -> Maybe CutMarkSpec -> HeaderColSpec+headerColumn = HeaderColSpec -- | Layouts a good-looking table with a optional header. Note that specifying -- fewer layout specifications than columns or vice versa will result in not -- showing them.-layoutTableToLines :: [RowGroup] -- ^ Groups- -> Maybe ([String], [HeaderLayoutSpec]) -- ^ Optional header details- -> [LayoutSpec] -- ^ Layout specification of columns- -> TableStyle -- ^ Visual table style+layoutTableToLines :: [RowGroup] -- ^ Groups+ -> Maybe ([String], [HeaderColSpec]) -- ^ Optional header details+ -> [ColSpec] -- ^ Layout specification of columns+ -> TableStyle -- ^ Visual table style -> [String] layoutTableToLines rGs optHeaderInfo specs (TableStyle { .. }) = topLine : addHeaderLines (rowGroupLines ++ [bottomLine])@@ -484,12 +477,12 @@ -- Optional values for the header (addHeaderLines, fitHeaderIntoCMIs, realTopH, realTopL, realTopC, realTopR) = case optHeaderInfo of- Just (h, headerLayoutSpecs) ->+ Just (h, headerColSpecs) -> let headerLine = vLine ' ' headerV (zipApply h headerRowMods)- headerRowMods = zipWith3 (\(HeaderLayoutSpec posSpec optCutMarkSpec) cutMarkSpec ->- columnModifier posSpec $ fromMaybe cutMarkSpec optCutMarkSpec+ headerRowMods = zipWith3 (\(HeaderColSpec pos optCutMarkSpec) cutMarkSpec ->+ columnModifier pos $ fromMaybe cutMarkSpec optCutMarkSpec )- headerLayoutSpecs+ headerColSpecs cMSs (map unalignedCMI cMIs) in@@ -510,17 +503,17 @@ ) cMSs = map cutMarkSpec specs- posSpecs = map posSpec specs+ posSpecs = map position specs applyRowMods xss = zipWith zipApply xss $ repeat rowMods rowMods = zipWith3 columnModifier posSpecs cMSs cMIs- cMIs = fitHeaderIntoCMIs $ deriveColModInfos (map (lenSpec &&& alignSpec) specs)+ cMIs = fitHeaderIntoCMIs $ deriveColModInfos (map (lenSpec A.&&& alignSpec) specs) $ concatMap rows rGs colWidths = map widthCMI cMIs zipApply = zipWith $ flip ($) layoutTableToString :: [RowGroup]- -> Maybe ([String], [HeaderLayoutSpec])- -> [LayoutSpec]+ -> Maybe ([String], [HeaderColSpec])+ -> [ColSpec] -> TableStyle -> String layoutTableToString rGs optHeaderInfo specs = intercalate "\n" . layoutTableToLines rGs optHeaderInfo specs
+ src/Text/Layout/Table/Internal.hs view
@@ -0,0 +1,30 @@+module Text.Layout.Table.Internal where++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)
src/Text/Layout/Table/Justify.hs view
@@ -10,7 +10,6 @@ , dimorphicSummands , dimorphicSummandsBy -- * Vertical alignment of whole columns- , VertPosSpec(..) , columnsAsGrid , vpadCols ) where@@ -18,7 +17,8 @@ import Control.Arrow import Data.List -import Text.Layout.Table.PrimMod+import Text.Layout.Table.Primitives.Basic+import Text.Layout.Table.Position -- | Justifies texts and presents the resulting lines in a grid structure (each -- text in one column).@@ -29,31 +29,27 @@ -- structure (each list of words in one column). This is useful if you don't -- want to split just at whitespaces. justifyWordListsAsGrid :: [(Int, [String])] -> [[String]]-justifyWordListsAsGrid = columnsAsGrid TopVPos . fmap (uncurry justify)--data VertPosSpec = TopVPos- | CenterVPos- | BottomVPos+justifyWordListsAsGrid = columnsAsGrid top . fmap (uncurry justify) {- | Merges multiple columns together and merges them to a valid grid without holes. The following example clarifies this: ->>> columnsAsGrid TopVPos [justifyText 10 "This text will not fit on one line.", ["42", "23"]]+>>> columnsAsGrid top [justifyText 10 "This text will not fit on one line.", ["42", "23"]] [["This text","42"],["will not","23"],["fit on one",""],["line.",""]] -}-columnsAsGrid :: VertPosSpec -> [[[a]]] -> [[[a]]]-columnsAsGrid vPosSpec = transpose . vpadCols vPosSpec []+columnsAsGrid :: Position V -> [[[a]]] -> [[[a]]]+columnsAsGrid vPos = transpose . vpadCols vPos [] -- | Fill all sublists to the same length.-vpadCols :: VertPosSpec -> a -> [[a]] -> [[a]]-vpadCols vPosSpec x l = fmap fillToMax l+vpadCols :: Position V -> a -> [[a]] -> [[a]]+vpadCols vPos x l = fmap fillToMax l where fillToMax = fillTo $ maximum $ 0 : fmap length l- fillTo = let f = case vPosSpec of- TopVPos -> fillEnd- CenterVPos -> fillBoth- BottomVPos -> fillStart+ fillTo = let f = case vPos of+ Start -> fillEnd+ Center -> fillBoth+ End -> fillStart in f x -- | Uses 'words' to split the text into words and justifies it with 'justify'.
+ src/Text/Layout/Table/Position.hs view
@@ -0,0 +1,31 @@+{-# 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++bottom :: Position V+bottom = End
− src/Text/Layout/Table/PrimMod.hs
@@ -1,125 +0,0 @@--- | This module contains primitive modifiers for lists and 'String's to be--- filled or fitted to a specific length.-module Text.Layout.Table.PrimMod- ( -- * String-related tools- CutMarkSpec- , cutMark- , spaces- , fillLeft'- , fillLeft- , fillRight- , fillCenter'- , fillCenter- , fitRightWith- , fitLeftWith- , fitCenterWith- , applyMarkLeftWith- , applyMarkRightWith-- -- * List-related tools- , fillStart'- , fillStart- , fillEnd- , fillBoth'- , fillBoth- )- where---- | 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- { leftMark :: String- , rightMark :: String- }--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)--spaces :: Int -> String-spaces = flip replicate ' '--fillStart' :: a -> Int -> Int -> [a] -> [a]-fillStart' x i lenL l = replicate (i - lenL) x ++ l--fillStart :: a -> Int -> [a] -> [a]-fillStart x i l = fillStart' x i (length l) l--fillEnd :: a -> Int -> [a] -> [a]-fillEnd x i l = take i $ l ++ repeat x--fillBoth' :: a -> Int -> Int -> [a] -> [a]-fillBoth' x i lenL l = - -- Puts more on the beginning if odd.- filler q ++ l ++ filler (q + r)- where- filler = flip replicate x- missing = i - lenL- (q, r) = missing `divMod` 2--fillBoth :: a -> Int -> [a] -> [a]-fillBoth x i l = fillBoth' x i (length l) l--fillLeft' :: Int -> Int -> String -> String-fillLeft' = fillStart' ' '---- | Fill on the left until the 'String' has the desired length.-fillLeft :: Int -> String -> String-fillLeft = fillStart ' '---- | Fill on the right until the 'String' has the desired length.-fillRight :: Int -> String -> String-fillRight = fillEnd ' '--fillCenter' :: Int -> Int -> String -> String-fillCenter' = fillBoth' ' '---- | Fill on both sides equally until the 'String' has the desired length.-fillCenter :: Int -> String -> String-fillCenter = fillBoth ' '---- | Fits to the given length by either trimming or filling it to the right.-fitRightWith :: CutMarkSpec -> Int -> String -> String-fitRightWith cms i s =- if length s <= i- then fillRight i s- else applyMarkRightWith cms $ take i s- --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 cms i s =- if lenS <= i- then fillLeft' i lenS s- else applyMarkLeftWith cms $ drop (lenS - i) s- where- lenS = length s---- | 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 cms i s = - if diff >= 0- then fillCenter' i lenS s- else case splitAt halfLenS s of- (ls, rs) -> addMarks $ drop (halfLenS - halfI) ls ++ take (halfI + r) rs- where- addMarks = applyMarkLeftWith cms . if diff == (-1) then id else applyMarkRightWith cms- diff = i - lenS- lenS = length s- 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-applyMarkLeftWith cms = applyMarkLeftBy leftMark cms---- | Applies a 'CutMarkSpec' to the right of a 'String', while preserving the length.-applyMarkRightWith :: CutMarkSpec -> String -> String-applyMarkRightWith cms = reverse . applyMarkLeftBy rightMark cms . reverse--applyMarkLeftBy :: (a -> String) -> a -> String -> String-applyMarkLeftBy f v = zipWith ($) $ map const (f v) ++ repeat id
+ src/Text/Layout/Table/Primitives/Basic.hs view
@@ -0,0 +1,147 @@+-- | 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+ CutMarkSpec+ , cutMark+ , singleCutMark+ , noCutMark+ , ellipsisCutMark++ -- * String-related tools+ , spaces+ , fillLeft'+ , fillLeft+ , fillRight+ , fillCenter'+ , fillCenter+ , fitRightWith+ , fitLeftWith+ , fitCenterWith+ , applyMarkLeftWith+ , applyMarkRightWith++ -- * List-related tools+ , fillStart'+ , fillStart+ , fillEnd+ , fillBoth'+ , fillBoth+ )+ 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 CutMarkSpec = CutMarkSpec+ { leftMark :: String+ , rightMark :: String+ }++instance Default CutMarkSpec 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)++-- | Use the same cut mark for left and right.+singleCutMark :: String -> CutMarkSpec+singleCutMark l = cutMark l (reverse l)++-- | Don't use a cut mark.+noCutMark :: CutMarkSpec+noCutMark = singleCutMark ""++-- | A single unicode character showing three dots is used as cut mark.+ellipsisCutMark :: CutMarkSpec+ellipsisCutMark = singleCutMark "…"++spaces :: Int -> String+spaces = flip replicate ' '++fillStart' :: a -> Int -> Int -> [a] -> [a]+fillStart' x i lenL l = replicate (i - lenL) x ++ l++fillStart :: a -> Int -> [a] -> [a]+fillStart x i l = fillStart' x i (length l) l++fillEnd :: a -> Int -> [a] -> [a]+fillEnd x i l = take i $ l ++ repeat x++fillBoth' :: a -> Int -> Int -> [a] -> [a]+fillBoth' x i lenL l = + -- Puts more on the beginning if odd.+ filler q ++ l ++ filler (q + r)+ where+ filler = flip replicate x+ missing = i - lenL+ (q, r) = missing `divMod` 2++fillBoth :: a -> Int -> [a] -> [a]+fillBoth x i l = fillBoth' x i (length l) l++fillLeft' :: Int -> Int -> String -> String+fillLeft' = fillStart' ' '++-- | Fill on the left until the 'String' has the desired length.+fillLeft :: Int -> String -> String+fillLeft = fillStart ' '++-- | Fill on the right until the 'String' has the desired length.+fillRight :: Int -> String -> String+fillRight = fillEnd ' '++fillCenter' :: Int -> Int -> String -> String+fillCenter' = fillBoth' ' '++-- | Fill on both sides equally until the 'String' has the desired length.+fillCenter :: Int -> String -> String+fillCenter = fillBoth ' '++-- | Fits to the given length by either trimming or filling it to the right.+fitRightWith :: CutMarkSpec -> Int -> String -> String+fitRightWith cms i s =+ if length s <= i+ then fillRight i s+ else applyMarkRightWith cms $ take i s+ --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 cms i s =+ if lenS <= i+ then fillLeft' i lenS s+ else applyMarkLeftWith cms $ drop (lenS - i) s+ where+ lenS = length s++-- | 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 cms i s = + if diff >= 0+ then fillCenter' i lenS s+ else case splitAt halfLenS s of+ (ls, rs) -> addMarks $ drop (halfLenS - halfI) ls ++ take (halfI + r) rs+ where+ addMarks = applyMarkLeftWith cms . if diff == (-1) then id else applyMarkRightWith cms+ diff = i - lenS+ lenS = length s+ 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+applyMarkLeftWith cms = applyMarkLeftBy leftMark cms++-- | Applies a 'CutMarkSpec' to the right of a 'String', while preserving the length.+applyMarkRightWith :: CutMarkSpec -> String -> String+applyMarkRightWith cms = reverse . applyMarkLeftBy rightMark cms . reverse++applyMarkLeftBy :: (a -> String) -> a -> String -> String+applyMarkLeftBy f v = zipWith ($) $ map const (f v) ++ repeat id
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.3.0.0+version: 0.4.0.0 synopsis: Layout text as grid or table. @@ -52,7 +52,7 @@ library -- Modules exported by the library.- exposed-modules: Text.Layout.Table, Text.Layout.Table.Justify, Text.Layout.Table.PrimMod, Text.Layout.Table.Style+ 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 -- Modules included in this library but not exported. -- other-modules: @@ -61,7 +61,7 @@ other-extensions: RecordWildCards, MultiWayIf -- Other library packages from which modules are imported.- build-depends: base >=4.8 && <4.9+ build-depends: base >=4.8 && <4.9, data-default-class ==0.0.1 -- Directories containing source files. hs-source-dirs: src@@ -71,7 +71,7 @@ executable table-layout-test-styles main-is: Test.hs- build-depends: base >=4.8 && <4.9+ build-depends: base >=4.8 && <4.9, data-default-class ==0.0.1 hs-source-dirs: src other-modules: Text.Layout.Table default-language: Haskell2010