-- | 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 , concatLines -- ** Filling , fillLeft' , fillLeft , fillRight , fillCenter' , fillCenter -- ** Fitting , fitRightWith , fitLeftWith , fitCenterWith -- ** Applying cut marks , applyMarkLeftWith , applyMarkRightWith -- * List-related tools -- ** Filling , fillStart' , fillStart , fillEnd , fillBoth' , fillBoth ) where -- TODO rename cut marks (they are too long) 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 ' ' concatLines :: [String] -> String concatLines = intercalate "\n" 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 :: CutMark -> 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 :: CutMark -> 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 :: CutMark -> 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 'CutMark' to the left of a 'String', while preserving the length. applyMarkLeftWith :: CutMark -> String -> String applyMarkLeftWith cms = applyMarkLeftBy leftMark cms -- | 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 applyMarkLeftBy f v = zipWith ($) $ map const (f v) ++ repeat id