module Test.Speculate.Utils.PrettyPrint
( beside
, above
, table
, spaces
)
where
import Data.List (transpose)
import Data.Char (isSpace)
import Test.Speculate.Utils.List
import Test.LeanCheck ((+|))
beside :: String -> String -> String
beside cs ds = unlines $ zipWith (++) (normalize ' ' css) dss
where [css,dss] = normalize "" [lines cs,lines ds]
above :: String -> String -> String
above cs ds = if last cs == '\n' || head ds == '\n'
then cs ++ ds
else cs ++ '\n':ds
table :: String -> [[String]] -> String
table s [] = ""
table s sss = unlines
. map (removeTrailing ' ')
. map (concat . (+| spaces s))
. transpose
. zipWith (`normalizeTo` ' ') (discard isSpace s)
. foldr1 (zipWith (++))
. map (normalize "" . map lines)
. normalize ""
$ sss
fit :: a -> Int -> [a] -> [a]
fit x n xs = xs ++ replicate (n - length xs) x
fitR :: a -> Int -> [a] -> [a]
fitR x n xs = replicate (n - length xs) x ++ xs
normalize :: a -> [[a]] -> [[a]]
normalize x xs = map (x `fit` maxLength xs) xs
normalizeR :: a -> [[a]] -> [[a]]
normalizeR x xs = map (x `fitR` maxLength xs) xs
normalizeTo :: Char -> a -> [[a]] -> [[a]]
normalizeTo 'l' = normalize
normalizeTo 'r' = normalizeR
normalizeTo _ = error "normalizeTo: unhandled case"
maxLength :: [[a]] -> Int
maxLength = maximum . (0:) . map length
removeTrailing :: Eq a => a -> [a] -> [a]
removeTrailing x = reverse
. dropWhile (==x)
. reverse
spaces :: String -> [String]
spaces "" = []
spaces s = case takeWhile isSpace s of
"" -> spaces (dropWhile isntSpace $ dropWhile isSpace s)
s' -> s' : spaces (dropWhile isntSpace $ dropWhile isSpace s)
isntSpace :: Char -> Bool
isntSpace = not . isSpace