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 :: String -> String -> String
beside String
cs String
ds = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (Char -> [String] -> [String]
forall a. a -> [[a]] -> [[a]]
normalize Char
' ' [String]
css) [String]
dss
where [[String]
css,[String]
dss] = String -> [[String]] -> [[String]]
forall a. a -> [[a]] -> [[a]]
normalize String
"" [String -> [String]
lines String
cs,String -> [String]
lines String
ds]
above :: String -> String -> String
above :: String -> String -> String
above String
cs String
ds = if String -> Char
forall a. HasCallStack => [a] -> a
last String
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| String -> Char
forall a. HasCallStack => [a] -> a
head String
ds Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
then String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ds
else String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds
table :: String -> [[String]] -> String
table :: String -> [[String]] -> String
table String
s [] = String
""
table String
s [[String]]
sss = [String] -> String
unlines
([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
removeTrailing Char
' ')
([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
+| String -> [String]
spaces String
s))
([[String]] -> [String])
-> ([[String]] -> [[String]]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose
([[String]] -> [[String]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [String] -> [String])
-> String -> [[String]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Char -> Char -> [String] -> [String]
forall a. Char -> a -> [[a]] -> [[a]]
`normalizeTo` Char
' ') ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
discard Char -> Bool
isSpace String
s)
([[String]] -> [[String]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[String]] -> [[String]] -> [[String]])
-> [[[String]]] -> [[String]]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (([String] -> [String] -> [String])
-> [[String]] -> [[String]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++))
([[[String]]] -> [[String]])
-> ([[String]] -> [[[String]]]) -> [[String]] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [[String]]) -> [[String]] -> [[[String]]]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [[String]] -> [[String]]
forall a. a -> [[a]] -> [[a]]
normalize String
"" ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
lines)
([[String]] -> [[[String]]])
-> ([[String]] -> [[String]]) -> [[String]] -> [[[String]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[String]] -> [[String]]
forall a. a -> [[a]] -> [[a]]
normalize String
""
([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$ [[String]]
sss
fit :: a -> Int -> [a] -> [a]
fit :: forall a. a -> Int -> [a] -> [a]
fit a
x Int
n [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
x
fitR :: a -> Int -> [a] -> [a]
fitR :: forall a. a -> Int -> [a] -> [a]
fitR a
x Int
n [a]
xs = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
normalize :: a -> [[a]] -> [[a]]
normalize :: forall a. a -> [[a]] -> [[a]]
normalize a
x [[a]]
xs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> Int -> [a] -> [a]
forall a. a -> Int -> [a] -> [a]
`fit` [[a]] -> Int
forall a. [[a]] -> Int
maxLength [[a]]
xs) [[a]]
xs
normalizeR :: a -> [[a]] -> [[a]]
normalizeR :: forall a. a -> [[a]] -> [[a]]
normalizeR a
x [[a]]
xs = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> Int -> [a] -> [a]
forall a. a -> Int -> [a] -> [a]
`fitR` [[a]] -> Int
forall a. [[a]] -> Int
maxLength [[a]]
xs) [[a]]
xs
normalizeTo :: Char -> a -> [[a]] -> [[a]]
normalizeTo :: forall a. Char -> a -> [[a]] -> [[a]]
normalizeTo Char
'l' = a -> [[a]] -> [[a]]
forall a. a -> [[a]] -> [[a]]
normalize
normalizeTo Char
'r' = a -> [[a]] -> [[a]]
forall a. a -> [[a]] -> [[a]]
normalizeR
normalizeTo Char
_ = String -> a -> [[a]] -> [[a]]
forall a. HasCallStack => String -> a
error String
"normalizeTo: unhandled case"
maxLength :: [[a]] -> Int
maxLength :: forall a. [[a]] -> Int
maxLength = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([[a]] -> [Int]) -> [[a]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> ([[a]] -> [Int]) -> [[a]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
removeTrailing :: Eq a => a -> [a] -> [a]
removeTrailing :: forall a. Eq a => a -> [a] -> [a]
removeTrailing a
x = [a] -> [a]
forall a. [a] -> [a]
reverse
([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)
([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
spaces :: String -> [String]
spaces :: String -> [String]
spaces String
"" = []
spaces String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace String
s of
String
"" -> String -> [String]
spaces ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isntSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
String
s' -> String
s' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
spaces ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isntSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
isntSpace :: Char -> Bool
isntSpace :: Char -> Bool
isntSpace = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace