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

import Data.List (intersperse, transpose)
import Futhark.Util (maxinum)
import Futhark.Util.Pretty hiding (sep, width)
import System.IO (Handle)

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 as how it should
-- be styled..
data Entry = Entry {Entry -> String
entryText :: String, Entry -> AnsiStyle
_entryStyle :: AnsiStyle}

-- | Makes a table entry.
mkEntry :: String -> AnsiStyle -> Entry
mkEntry :: String -> AnsiStyle -> Entry
mkEntry = String -> AnsiStyle -> Entry
Entry

buildRowTemplate :: [[Entry]] -> Int -> RowTemplate
buildRowTemplate :: [[Entry]] -> Int -> RowTemplate
buildRowTemplate [[Entry]]
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
. Entry -> String
entryText)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ [[Entry]]
rows

buildRow :: RowTemplate -> [Entry] -> Doc AnsiStyle
buildRow :: RowTemplate -> [Entry] -> Doc AnsiStyle
buildRow (RowTemplate [Int]
widths Int
pad) [Entry]
entries = Doc AnsiStyle
cells forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
  where
    bar :: Doc AnsiStyle
bar = Doc AnsiStyle
"\x2502"
    cells :: Doc AnsiStyle
cells = forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Entry -> Int -> Doc AnsiStyle
buildCell [Entry]
entries [Int]
widths) forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
bar
    buildCell :: Entry -> Int -> Doc AnsiStyle
buildCell (Entry String
entry AnsiStyle
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 Doc AnsiStyle
bar forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" " forall a. Semigroup a => a -> a -> a
<> forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
sgr (forall a ann. Pretty a => a -> Doc ann
pretty String
entry) forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
padding Doc AnsiStyle
" ")

buildSep :: Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
buildSep :: Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
buildSep Char
lCorner Char
rCorner Char
sep (RowTemplate [Int]
widths Int
pad) =
  forall {a} {ann}. Pretty a => [a] -> Doc ann
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. Semigroup a => a -> a -> a
<> [Char
sep]
    corners :: [a] -> Doc ann
corners [] = Doc ann
""
    corners [a]
s = forall a ann. Pretty a => a -> Doc ann
pretty Char
lCorner forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. [a] -> [a]
init [a]
s) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Char
rCorner

-- | Produce 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.
hPutTable :: Handle -> [[Entry]] -> Int -> IO ()
hPutTable :: Handle -> [[Entry]] -> Int -> IO ()
hPutTable Handle
h [[Entry]]
rows Int
pad = Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
h forall a b. (a -> b) -> a -> b
$ RowTemplate -> Doc AnsiStyle
buildTop RowTemplate
template forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
sepRows forall a. Semigroup a => a -> a -> a
<> RowTemplate -> Doc AnsiStyle
buildBottom RowTemplate
template forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
  where
    sepRows :: Doc AnsiStyle
sepRows = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (RowTemplate -> Doc AnsiStyle
buildFloor RowTemplate
template) [Doc AnsiStyle]
builtRows
    builtRows :: [Doc AnsiStyle]
builtRows = forall a b. (a -> b) -> [a] -> [b]
map (RowTemplate -> [Entry] -> Doc AnsiStyle
buildRow RowTemplate
template) [[Entry]]
rows
    template :: RowTemplate
template = [[Entry]] -> Int -> RowTemplate
buildRowTemplate [[Entry]]
rows Int
pad
    buildTop :: RowTemplate -> Doc AnsiStyle
buildTop RowTemplate
rt = Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
buildSep Char
'\x250C' Char
'\x2510' Char
'\x252C' RowTemplate
rt forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
    buildFloor :: RowTemplate -> Doc AnsiStyle
buildFloor RowTemplate
rt = Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
buildSep Char
'\x251C' Char
'\x2524' Char
'\x253C' RowTemplate
rt forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
    buildBottom :: RowTemplate -> Doc AnsiStyle
buildBottom = Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
buildSep Char
'\x2514' Char
'\x2518' Char
'\x2534'