module Text.Layout.Table.PrimMod
( CutMarkSpec
, cutMark
, spaces
, fillLeft'
, fillLeft
, fillRight
, fillCenter'
, fillCenter
, fitRightWith
, fitLeftWith
, fitCenterWith
, applyMarkLeftWith
, applyMarkRightWith
)
where
data CutMarkSpec = CutMarkSpec
{ leftMark :: String
, rightMark :: String
}
instance Show CutMarkSpec where
show (CutMarkSpec l r) = "cutMark " ++ show l ++ ' ' : show (reverse r)
cutMark :: String -> String -> CutMarkSpec
cutMark l r = CutMarkSpec l (reverse r)
spaces :: Int -> String
spaces = flip replicate ' '
fillLeft' :: Int -> Int -> String -> String
fillLeft' i lenS s = spaces (i lenS) ++ s
fillLeft :: Int -> String -> String
fillLeft i s = fillLeft' i (length s) s
fillRight :: Int -> String -> String
fillRight i s = take i $ s ++ repeat ' '
fillCenter' :: Int -> Int -> String -> String
fillCenter' i lenS s = let missing = i lenS
(q, r) = missing `divMod` 2
in spaces q ++ s ++ spaces (q + r)
fillCenter :: Int -> String -> String
fillCenter i s = fillCenter' i (length s) s
fitRightWith :: CutMarkSpec -> Int -> String -> String
fitRightWith cms i s =
if length s <= i
then fillRight i s
else applyMarkRightWith cms $ take i s
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
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
applyMarkLeftWith :: CutMarkSpec -> String -> String
applyMarkLeftWith cms = applyMarkLeftBy leftMark cms
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