table-layout 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+134/−57 lines, 5 files
Files
- src/Test.hs +27/−12
- src/Text/Layout/Table.hs +42/−23
- src/Text/Layout/Table/Justify.hs +22/−9
- src/Text/Layout/Table/PrimMod.hs +37/−10
- table-layout.cabal +6/−3
src/Test.hs view
@@ -5,21 +5,36 @@ import Text.Layout.Table main :: IO ()-main = - forM_ styles $ \style ->- forM_ layouts $ \layout -> (putStrLn "" >>) $ (print layout >>) $ mapM_ putStrLn $- layoutTableToLines [ rowGroup [ [longText, smallNum]- , [shortText, bigNum]- ]- ]- (Just (["Some text", "Some numbers"], repeat centerHL))- [layout, layout]- style+main = putStrLn $ layoutTableToString rowGroups+ (Just (["Layout", "Result"], repeat centerHL))+ [ LayoutSpec (ExpandUntil 30) LeftPos (charAlign ':') ellipsisCutMark+ , LayoutSpec Expand CenterPos 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"]+ , [shortText, bigNum, "bar"]+ ]+ ]+ (Just (["Some text", "Some numbers", "X"], repeat centerHL))+ (repeat l)+ 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@@ -28,7 +43,7 @@ , unicodeBoldHeaderS ] layouts = [ LayoutSpec l p a ellipsisCutMark- | l <- [Expand, Fixed 10]+ | l <- [Expand, Fixed 10, ExpandUntil 10, FixedUntil 10] , p <- [LeftPos, RightPos, CenterPos]- , a <- [NoAlign, AlignAtChar $ OccSpec '.' 0]+ , a <- [noAlign, dotAlign] ]
src/Text/Layout/Table.hs view
@@ -29,7 +29,7 @@ -- , LayoutSpec (Fixed 10) -- CenterPos -- dotAlign--- shortCutMark+-- ellipsisCutMark -- ] -- unicodeRoundS -- ╭──────────────────────┬────────────╮@@ -52,9 +52,13 @@ , fixedLeftL , LenSpec(..) , PosSpec(..)- , AlignSpec(..)+ , AlignSpec+ , noAlign+ , charAlign+ , predAlign , dotAlign- , OccSpec(..)+ , isAligned+ , OccSpec , CutMarkSpec , defaultCutMark , ellipsisCutMark@@ -84,6 +88,7 @@ -- $justify , justify , justifyText+ , VertPosSpec(..) , columnsAsGrid , justifyTextsAsGrid , justifyWordListsAsGrid@@ -137,25 +142,40 @@ , posSpec :: PosSpec , alignSpec :: AlignSpec , cutMarkSpec :: CutMarkSpec- } deriving Show+ } -- | Determines how long a column will be.-data LenSpec = Expand | Fixed Int | ExpandUntil Int | FixedUntil Int deriving Show+data LenSpec = Expand | Fixed Int | ExpandUntil Int | FixedUntil Int deriving Show -- | 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 -- | Determines whether a column will align at a specific letter.-data AlignSpec = AlignAtChar OccSpec | NoAlign deriving Show+data AlignSpec = AlignPred OccSpec | NoAlign -- | Specifies an occurence of a letter.-data OccSpec = OccSpec Char Int deriving Show+data OccSpec = OccSpec (Char -> Bool) Int +-- | 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 dot. dotAlign :: AlignSpec-dotAlign = AlignAtChar $ OccSpec '.' 0+dotAlign = charAlign '.' +isAligned :: AlignSpec -> Bool+isAligned as = case as of+ NoAlign -> False+ _ -> True+ -- | Use the same cut mark for left and right. singleCutMark :: String -> CutMarkSpec singleCutMark l = cutMark l (reverse l)@@ -178,7 +198,7 @@ -- | Numbers are positioned on the right and aligned on the floating point dot. numL :: LayoutSpec-numL = LayoutSpec Expand RightPos (AlignAtChar $ OccSpec '.' 0) defaultCutMark+numL = LayoutSpec Expand RightPos dotAlign defaultCutMark -- | Fixes the column length and positions according to the given 'PosSpec'. fixedL :: Int -> PosSpec -> LayoutSpec@@ -268,11 +288,11 @@ applyMarkRight = applyMarkRightWith cms splitAtOcc :: OccSpec -> String -> (String, String)-splitAtOcc (OccSpec c occ) = first reverse . go 0 []+splitAtOcc (OccSpec p occ) = first reverse . go 0 [] where go n ls xs = case xs of [] -> (ls, [])- x : xs' -> if c == x+ x : xs' -> if p x then if n == occ then (ls, xs) else go (succ n) (x : ls) xs'@@ -282,7 +302,6 @@ data ColModInfo = FillAligned OccSpec AlignInfo | FillTo Int | FitTo Int (Maybe (OccSpec, AlignInfo))- deriving Show -- | Get the exact width after the modification. widthCMI :: ColModInfo -> Int@@ -357,17 +376,17 @@ ExpandUntil i -> expandUntil id i FixedUntil i -> expandUntil not i in fun . maximum . map length- AlignAtChar 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)+ 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) -- | Generate the 'AlignInfo' of a cell using the 'OccSpec'.
src/Text/Layout/Table/Justify.hs view
@@ -5,17 +5,21 @@ module Text.Layout.Table.Justify ( justifyTextsAsGrid , justifyWordListsAsGrid- , columnsAsGrid- , fillSameLength , justifyText , justify , dimorphicSummands , dimorphicSummandsBy+ -- * Vertical alignment of whole columns+ , VertPosSpec(..)+ , columnsAsGrid+ , vpadCols ) where import Control.Arrow import Data.List +import Text.Layout.Table.PrimMod+ -- | Justifies texts and presents the resulting lines in a grid structure (each -- text in one column). justifyTextsAsGrid :: [(Int, String)] -> [[String]]@@ -25,23 +29,32 @@ -- 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 . fmap (uncurry justify)+justifyWordListsAsGrid = columnsAsGrid TopVPos . fmap (uncurry justify) +data VertPosSpec = TopVPos+ | CenterVPos+ | BottomVPos+ {- | Merges multiple columns together and merges them to a valid grid without holes. The following example clarifies this: ->>> columnsAsGrid [justifyText 10 "This text will not fit on one line.", ["42", "23"]]+>>> columnsAsGrid TopVPos [justifyText 10 "This text will not fit on one line.", ["42", "23"]] [["This text","42"],["will not","23"],["fit on one",""],["line.",""]] -}-columnsAsGrid :: [[[a]]] -> [[[a]]]-columnsAsGrid = transpose . fillSameLength []+columnsAsGrid :: VertPosSpec -> [[[a]]] -> [[[a]]]+columnsAsGrid vPosSpec = transpose . vpadCols vPosSpec [] -- | Fill all sublists to the same length.-fillSameLength :: a -> [[a]] -> [[a]]-fillSameLength x l = fmap (fillTo $ maximum $ 0 : fmap length l) l+vpadCols :: VertPosSpec -> a -> [[a]] -> [[a]]+vpadCols vPosSpec x l = fmap fillToMax l where- fillTo i l = take i $ l ++ repeat x+ fillToMax = fillTo $ maximum $ 0 : fmap length l+ fillTo = let f = case vPosSpec of+ TopVPos -> fillEnd+ CenterVPos -> fillBoth+ BottomVPos -> fillStart+ in f x -- | Uses 'words' to split the text into words and justifies it with 'justify'. --
src/Text/Layout/Table/PrimMod.hs view
@@ -1,6 +1,8 @@--- | This module contains primitive modifiers for 'String's to be filled or fitted to a specific length.+-- | This module contains primitive modifiers for lists and 'String's to be+-- filled or fitted to a specific length. module Text.Layout.Table.PrimMod- ( CutMarkSpec+ ( -- * String-related tools+ CutMarkSpec , cutMark , spaces , fillLeft'@@ -13,6 +15,13 @@ , fitCenterWith , applyMarkLeftWith , applyMarkRightWith++ -- * List-related tools+ , fillStart'+ , fillStart+ , fillEnd+ , fillBoth'+ , fillBoth ) where @@ -33,26 +42,44 @@ 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' i lenS s = spaces (i - lenS) ++ s+fillLeft' = fillStart' ' ' -- | Fill on the left until the 'String' has the desired length. fillLeft :: Int -> String -> String-fillLeft i s = fillLeft' i (length s) s+fillLeft = fillStart ' ' -- | Fill on the right until the 'String' has the desired length. fillRight :: Int -> String -> String-fillRight i s = take i $ s ++ repeat ' '+fillRight = fillEnd ' ' fillCenter' :: Int -> Int -> String -> String-fillCenter' i lenS s = let missing = i - lenS- (q, r) = missing `divMod` 2- -- Puts more spaces on the right if odd.- in spaces q ++ s ++ spaces (q + r)+fillCenter' = fillBoth' ' ' -- | Fill on both sides equally until the 'String' has the desired length. fillCenter :: Int -> String -> String-fillCenter i s = fillCenter' i (length s) s+fillCenter = fillBoth ' ' -- | Fits to the given length by either trimming or filling it to the right. fitRightWith :: CutMarkSpec -> Int -> String -> String
table-layout.cabal view
@@ -6,14 +6,14 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.0.0+version: 0.3.0.0 synopsis: Layout text as grid or table. description: `table-layout` is a library for text-based table layout, it provides several- functions which help in this task from the ground up, although using them is- not necessary. It provides the following layout features:+ functions and types which help in this task from the ground up, although+ using them is not necessary. It provides the following layout features: . * Fixed-size and arbitrarily sized columns and limiting versions of those .@@ -26,6 +26,9 @@ * Fancy tables with optional headers and user styles . * Justified text layout over multiple rows+ .+ /Note:/ This package is currently under development and may not be suited for+ productive use. -- URL for the project homepage or repository. homepage: https://github.com/muesli4/table-layout