-- | Basic table building for prettier futhark-test output.
module Futhark.Util.Table
     ( buildTable
     , mkEntry
     , Entry
     ) where

import Data.List (intercalate, transpose)
import System.Console.ANSI

import Futhark.Util.Console (color)

data RowTemplate = RowTemplate [Int] Int deriving (Int -> RowTemplate -> ShowS
[RowTemplate] -> ShowS
RowTemplate -> String
(Int -> RowTemplate -> ShowS)
-> (RowTemplate -> String)
-> ([RowTemplate] -> ShowS)
-> Show RowTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowTemplate] -> ShowS
$cshowList :: [RowTemplate] -> ShowS
show :: RowTemplate -> String
$cshow :: RowTemplate -> String
showsPrec :: Int -> RowTemplate -> ShowS
$cshowsPrec :: Int -> RowTemplate -> ShowS
Show)

-- | A table entry. Consists of the content as well a list of
-- SGR commands to color/stylelize the entry.
type Entry = (String, [SGR])

-- | Makes a table entry with the default SGR mode.
mkEntry :: String -> (String, [SGR])
mkEntry :: String -> (String, [SGR])
mkEntry String
s = (String
s, [])

buildRowTemplate :: [[Entry]] -> Int -> RowTemplate

buildRowTemplate :: [[(String, [SGR])]] -> Int -> RowTemplate
buildRowTemplate [[(String, [SGR])]]
rows = [Int] -> Int -> RowTemplate
RowTemplate [Int]
widths
  where widths :: [Int]
widths = ([(String, [SGR])] -> Int) -> [[(String, [SGR])]] -> [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, [SGR])] -> [Int]) -> [(String, [SGR])] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [SGR]) -> Int) -> [(String, [SGR])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, [SGR]) -> String) -> (String, [SGR]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [SGR]) -> String
forall a b. (a, b) -> a
fst)) ([[(String, [SGR])]] -> [Int])
-> ([[(String, [SGR])]] -> [[(String, [SGR])]])
-> [[(String, [SGR])]]
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(String, [SGR])]] -> [[(String, [SGR])]]
forall a. [[a]] -> [[a]]
transpose ([[(String, [SGR])]] -> [Int]) -> [[(String, [SGR])]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[(String, [SGR])]]
rows

buildRow :: RowTemplate -> [Entry] -> String
buildRow :: RowTemplate -> [(String, [SGR])] -> String
buildRow (RowTemplate [Int]
widths Int
pad) [(String, [SGR])]
entries = String
cells String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  where bar :: String
bar   = String
"\x2502"
        cells :: String
cells = (((String, [SGR]), Int) -> String)
-> [((String, [SGR]), Int)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String, [SGR]), Int) -> String
buildCell ([(String, [SGR])] -> [Int] -> [((String, [SGR]), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, [SGR])]
entries [Int]
widths) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bar
        buildCell :: ((String, [SGR]), Int) -> String
buildCell ((String
entry, [SGR]
sgr), Int
width) =
          let padding :: Int
padding = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
entry Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pad
          in  String
bar String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SGR] -> ShowS
color [SGR]
sgr String
entry String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
padding Char
' '

buildSep :: Char -> Char -> Char -> RowTemplate -> String
buildSep :: Char -> Char -> Char -> RowTemplate -> String
buildSep Char
lCorner Char
rCorner Char
sep (RowTemplate [Int]
widths Int
pad) =
  ShowS
corners ShowS -> ([Int] -> String) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> String
cellFloor ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int]
widths
  where cellFloor :: Int -> String
cellFloor Int
width = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'\x2500' String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep]
        corners :: ShowS
corners [] = String
""
        corners String
s  = [Char
lCorner] String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
init String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
rCorner]

-- | Builds a table from a list of entries and a padding amount that
-- determines padding from the right side of the widest entry in each column.
buildTable :: [[Entry]] -> Int -> String
buildTable :: [[(String, [SGR])]] -> Int -> String
buildTable [[(String, [SGR])]]
rows Int
pad = RowTemplate -> String
buildTop RowTemplate
template String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepRows String -> ShowS
forall a. [a] -> [a] -> [a]
++ RowTemplate -> String
buildBottom RowTemplate
template
  where sepRows :: String
sepRows       = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (RowTemplate -> String
buildFloor RowTemplate
template) [String]
builtRows
        builtRows :: [String]
builtRows     = ([(String, [SGR])] -> String) -> [[(String, [SGR])]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (RowTemplate -> [(String, [SGR])] -> String
buildRow RowTemplate
template) [[(String, [SGR])]]
rows
        template :: RowTemplate
template      = [[(String, [SGR])]] -> Int -> RowTemplate
buildRowTemplate [[(String, [SGR])]]
rows Int
pad
        buildTop :: RowTemplate -> String
buildTop RowTemplate
rt   = Char -> Char -> Char -> RowTemplate -> String
buildSep Char
'\x250C' Char
'\x2510' Char
'\x252C' RowTemplate
rt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
        buildFloor :: RowTemplate -> String
buildFloor RowTemplate
rt = Char -> Char -> Char -> RowTemplate -> String
buildSep Char
'\x251C' Char
'\x2524' Char
'\x253C' RowTemplate
rt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
        buildBottom :: RowTemplate -> String
buildBottom   = Char -> Char -> Char -> RowTemplate -> String
buildSep Char
'\x2514' Char
'\x2518' Char
'\x2534'