module Test.FitSpec.PrettyPrint
( beside
, above
, showTuple
, table
, columns
, showQuantity
, showEach
, headToUpper
)
where
import Data.List (intercalate,transpose,isSuffixOf)
import Data.Char (toUpper)
showQuantity :: Int -> String -> String
showQuantity 1 what = "1 " ++ what
showQuantity n what = show n ++ " " ++ pluralize what
showEach :: Show a => String -> [a] -> String
showEach what [x] = what ++ " " ++ show x
showEach what xs = "each of " ++ pluralize what ++ " "
++ intercalate ", " (map show $ init xs)
++ " and "
++ show (last xs)
pluralize :: String -> String
pluralize s | s `ew` "se" = s ++ "s"
| s `ew` "n" = s ++ "s"
| s `ew` "y" = init s ++ "ies"
| otherwise = s
where ew = flip isSuffixOf
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
showTuple :: [String] -> String
showTuple [] = ""
showTuple [s] = s
showTuple (s:ss) =
if any ('\n' `elem`) (s:ss)
then "( " `beside` s
++ init (concatMap (", " `beside`) ss)
++ " )\n"
else "(" ++ intercalate "," (s:ss) ++ ")"
table :: String -> [[String]] -> String
table s [] = ""
table s sss = unlines
. map (removeTrailing ' ')
. map (intercalate s)
. transpose
. map (normalize ' ')
. foldr1 (zipWith (++))
. map (normalize "" . map lines)
. normalize ""
$ sss
columns :: String -> [String] -> String
columns s = unlines
. map (removeTrailing ' ')
. map (intercalate s)
. transpose
. map (normalize ' ')
. normalize ""
. map lines
fit :: a -> Int -> [a] -> [a]
fit x n xs = xs ++ replicate (n - length xs) x
normalize :: a -> [[a]] -> [[a]]
normalize x xs = map (x `fit` maxLength xs) xs
maxLength :: [[a]] -> Int
maxLength = maximum . (0:) . map length
removeTrailing :: Eq a => a -> [a] -> [a]
removeTrailing x = reverse
. dropWhile (==x)
. reverse
headToUpper :: [Char] -> [Char]
headToUpper [] = []
headToUpper (c:cs) = toUpper c : cs