-- |
-- Module      : Test.Speculate.Utils.PrettyPrint
-- Copyright   : (c) 2016-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate.
--
-- A very simple pretty printing library
module Test.Speculate.Utils.PrettyPrint
  ( beside
  , above
  , table
  , spaces
  )
where
-- TODO: Fix somewhat inefficient implementations, i.e.: heavy use of '(++)'.

import Data.List (transpose)
import Data.Char (isSpace)
import Test.Speculate.Utils.List
import Test.LeanCheck ((+|))

-- | Appends two Strings side by side, line by line
--
-- > beside ["asdf\nqw\n","zxvc\nas"] ==
-- >  "asdfzxvc\n\
-- >  \qw  as\n"
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]

-- | Append two Strings on top of each other, adding line breaks *when needed*.
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

-- | Formats a table.  Examples:
--
-- > table "l  l  l" [ ["asdf", "qwer",     "zxvc\nzxvc"]
-- >                 , ["0",    "1",        "2"]
-- >                 , ["123",  "456\n789", "3"] ] ==
-- >   "asdf  qwer  zxvc\n\
-- >   \            zxvc\n\
-- >   \0     1     2\n\
-- >   \123   456   3\n\
-- >   \      789\n"
--
-- > table "r  l  l" [ ["asdf", "qwer",     "zxvc\nzxvc"]
-- >                 , ["0",    "1",        "2"]
-- >                 , ["123",  "456\n789", "3"] ] ==
-- >   "asdf  qwer  zxvc\n\
-- >   \            zxvc\n\
-- >   \   0  1     2\n\
-- >   \ 123  456   3\n\
-- >   \      789\n"
--
-- > table "r  r  l" [ ["asdf", "qwer",     "zxvc\nzxvc"]
-- >                 , ["0",    "1",        "2"]
-- >                 , ["123",  "456\n789", "3"] ] ==
-- >   "asdf  qwer  zxvc\n\
-- >   \            zxvc\n\
-- >   \   0     1  2\n\
-- >   \ 123   456  3\n\
-- >   \       789\n"
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

-- | Fits a list to a certain width by appending a certain value
--
-- > fit ' ' 6 "str" == "str   "
--
-- > fit 0 6 [1,2,3] == [1,2,3,0,0,0]
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 makes all list the same length by adding a value
--
-- > normalize ["asdf","qw","er"] == normalize ["asdf","qw  ","er  "]
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"

-- | Given a list of lists returns the maximum length
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