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)
data Entry = Entry {Entry -> String
entryText :: String, Entry -> AnsiStyle
_entryStyle :: AnsiStyle}
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
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'