module Text.Tabular.AsciiArt where
import Data.List (intersperse, transpose)
import Text.Tabular
render :: (rh -> String)
-> (ch -> String)
-> (a -> String)
-> Table rh ch a
-> String
render :: (rh -> String)
-> (ch -> String) -> (a -> String) -> Table rh ch a -> String
render rh -> String
fr ch -> String
fc a -> String
f (Table Header rh
rh Header ch
ch [[a]]
cells) =
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ Properties -> String
bar Properties
SingleLine
, [Int] -> Header String -> String
renderColumns [Int]
sizes Header String
ch2
, Properties -> String
bar Properties
DoubleLine
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(Header String -> [String]
renderRs (Header String -> [String]) -> Header String -> [String]
forall a b. (a -> b) -> a -> b
$ (([a], String) -> String) -> Header ([a], String) -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a], String) -> String
renderR (Header ([a], String) -> Header String)
-> Header ([a], String) -> Header String
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]] -> Header String -> Header ([a], String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader [] [[a]]
cells (Header String -> Header ([a], String))
-> Header String -> Header ([a], String)
forall a b. (a -> b) -> a -> b
$ (rh -> String) -> Header rh -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap rh -> String
fr Header rh
rh) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ Properties -> String
bar Properties
SingleLine ]
where
bar :: Properties -> String
bar = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (Properties -> [String]) -> Properties -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Header String -> Properties -> [String]
renderHLine [Int]
sizes Header String
ch2
ch2 :: Header String
ch2 = Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine [String -> Header String
forall h. h -> Header h
Header String
"", (ch -> String) -> Header ch -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> String
fc Header ch
ch]
cells2 :: [[String]]
cells2 = Header String -> [String]
forall h. Header h -> [h]
headerContents Header String
ch2
[String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: (String -> [a] -> [String]) -> [String] -> [[a]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
h [a]
cs -> String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
cs) [String]
rhStrings [[a]]
cells
renderR :: ([a], String) -> String
renderR ([a]
cs,String
h) = [Int] -> Header String -> String
renderColumns [Int]
sizes (Header String -> String) -> Header String -> String
forall a b. (a -> b) -> a -> b
$ Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine
[ String -> Header String
forall h. h -> Header h
Header String
h
, ((String, ch) -> String) -> Header (String, ch) -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, ch) -> String
forall a b. (a, b) -> a
fst (Header (String, ch) -> Header String)
-> Header (String, ch) -> Header String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Header ch -> Header (String, ch)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader String
"" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
cs) Header ch
ch]
rhStrings :: [String]
rhStrings = (rh -> String) -> [rh] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map rh -> String
fr ([rh] -> [String]) -> [rh] -> [String]
forall a b. (a -> b) -> a -> b
$ Header rh -> [rh]
forall h. Header h -> [h]
headerContents Header rh
rh
sizes :: [Int]
sizes = ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[String]] -> [Int])
-> ([[String]] -> [[String]]) -> [[String]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose ([[String]] -> [Int]) -> [[String]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[String]]
cells2
renderRs :: Header String -> [String]
renderRs (Header String
s) = [String
s]
renderRs (Group Properties
p [Header String]
hs) = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([Header String] -> [[String]]) -> [Header String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
intersperse [String]
sep ([[String]] -> [[String]])
-> ([Header String] -> [[String]]) -> [Header String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header String -> [String]) -> [Header String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Header String -> [String]
renderRs ([Header String] -> [String]) -> [Header String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Header String]
hs
where sep :: [String]
sep = [Int] -> Header String -> Properties -> [String]
renderHLine [Int]
sizes Header String
ch2 Properties
p
renderColumns :: [Int]
-> Header String
-> String
renderColumns :: [Int] -> Header String -> String
renderColumns [Int]
is Header String
h = String
"| " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
coreLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |"
where
coreLine :: String
coreLine = (Either Properties (Int, String) -> String)
-> [Either Properties (Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Properties (Int, String) -> String
helper ([Either Properties (Int, String)] -> String)
-> [Either Properties (Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ Header (Int, String) -> [Either Properties (Int, String)]
forall h. Header h -> [Either Properties h]
flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
-> Header (Int, String) -> [Either Properties (Int, String)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Header String -> Header (Int, String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is Header String
h
helper :: Either Properties (Int, String) -> String
helper = (Properties -> String)
-> ((Int, String) -> String)
-> Either Properties (Int, String)
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> String
hsep ((Int -> String -> String) -> (Int, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> String -> String
padLeft)
hsep :: Properties -> String
hsep :: Properties -> String
hsep Properties
NoLine = String
" "
hsep Properties
SingleLine = String
" | "
hsep Properties
DoubleLine = String
" || "
renderHLine :: [Int]
-> Header String
-> Properties
-> [String]
renderHLine :: [Int] -> Header String -> Properties -> [String]
renderHLine [Int]
_ Header String
_ Properties
NoLine = []
renderHLine [Int]
w Header String
h Properties
SingleLine = [[Int] -> Char -> Header String -> String
renderHLine' [Int]
w Char
'-' Header String
h]
renderHLine [Int]
w Header String
h Properties
DoubleLine = [[Int] -> Char -> Header String -> String
renderHLine' [Int]
w Char
'=' Header String
h]
renderHLine' :: [Int] -> Char -> Header String -> String
renderHLine' :: [Int] -> Char -> Header String -> String
renderHLine' [Int]
is Char
sep Header String
h = [ Char
'+', Char
sep ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
coreLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
sep, Char
'+']
where
coreLine :: String
coreLine = (Either Properties (Int, String) -> String)
-> [Either Properties (Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Properties (Int, String) -> String
forall b. Either Properties (Int, b) -> String
helper ([Either Properties (Int, String)] -> String)
-> [Either Properties (Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ Header (Int, String) -> [Either Properties (Int, String)]
forall h. Header h -> [Either Properties h]
flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
-> Header (Int, String) -> [Either Properties (Int, String)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Header String -> Header (Int, String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader Int
0 [Int]
is Header String
h
helper :: Either Properties (Int, b) -> String
helper = (Properties -> String)
-> ((Int, b) -> String) -> Either Properties (Int, b) -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> String
vsep (Int, b) -> String
forall b. (Int, b) -> String
dashes
dashes :: (Int, b) -> String
dashes (Int
i,b
_) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
sep
vsep :: Properties -> String
vsep Properties
NoLine = [Char
sep]
vsep Properties
SingleLine = Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: String
"+" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
sep]
vsep Properties
DoubleLine = Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: String
"++" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
sep]
padLeft :: Int -> String -> String
padLeft :: Int -> String -> String
padLeft Int
l String
s = String
padding String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
where padding :: String
padding = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '