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

import Data.List (intercalate, transpose)
import Futhark.Util (maxinum)
import Futhark.Util.Console (color)
import System.Console.ANSI

data RowTemplate = RowTemplate [Int] Int deriving (Int -> RowTemplate -> ShowS
[RowTemplate] -> ShowS
RowTemplate -> String
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose 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 forall a. [a] -> [a] -> [a]
++ String
"\n"
  where
    bar :: String
bar = String
"\x2502"
    cells :: String
cells = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String, [SGR]), Int) -> String
buildCell (forall a b. [a] -> [b] -> [(a, b)]
zip [(String, [SGR])]
entries [Int]
widths) 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 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
entry forall a. Num a => a -> a -> a
+ Int
pad
       in String
bar forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [SGR] -> ShowS
color [SGR]
sgr String
entry forall a. [a] -> [a] -> [a]
++ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> String
cellFloor forall a b. (a -> b) -> a -> b
$ [Int]
widths
  where
    cellFloor :: Int -> String
cellFloor Int
width = forall a. Int -> a -> [a]
replicate (Int
width forall a. Num a => a -> a -> a
+ Int
pad forall a. Num a => a -> a -> a
+ Int
1) Char
'\x2500' forall a. [a] -> [a] -> [a]
++ [Char
sep]
    corners :: ShowS
corners [] = String
""
    corners String
s = [Char
lCorner] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
init String
s 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 forall a. [a] -> [a] -> [a]
++ String
sepRows forall a. [a] -> [a] -> [a]
++ RowTemplate -> String
buildBottom RowTemplate
template
  where
    sepRows :: String
sepRows = forall a. [a] -> [[a]] -> [a]
intercalate (RowTemplate -> String
buildFloor RowTemplate
template) [String]
builtRows
    builtRows :: [String]
builtRows = 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 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 forall a. [a] -> [a] -> [a]
++ String
"\n"
    buildBottom :: RowTemplate -> String
buildBottom = Char -> Char -> Char -> RowTemplate -> String
buildSep Char
'\x2514' Char
'\x2518' Char
'\x2534'