    -- | 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
    (Int -> RowTemplate -> ShowS)
    -> (RowTemplate -> String)
    -> ([RowTemplate] -> ShowS)
    -> Show RowTemplate
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RowTemplate -> ShowS
    showsPrec :: Int -> RowTemplate -> ShowS
    $cshow :: RowTemplate -> String
    show :: RowTemplate -> String
    $cshowList :: [RowTemplate] -> ShowS
    showList :: [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 = ([Entry] -> Int) -> [[Entry]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int] -> Int
    forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
    maxinum ([Int] -> Int) -> ([Entry] -> [Int]) -> [Entry] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Entry -> Int) -> [Entry] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (Entry -> String) -> Entry -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Entry -> String
    entryText)) ([[Entry]] -> [Int])
    -> ([[Entry]] -> [[Entry]]) -> [[Entry]] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Entry]] -> [[Entry]]
    forall a. [[a]] -> [[a]]
    transpose ([[Entry]] -> [Int]) -> [[Entry]] -> [Int]
    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 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
      where
        bar :: Doc AnsiStyle
    bar = Doc AnsiStyle
    "\x2502"
        cells :: Doc AnsiStyle
    cells = [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. Monoid a => [a] -> a
    mconcat ((Entry -> Int -> Doc AnsiStyle)
    -> [Entry] -> [Int] -> [Doc AnsiStyle]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Entry -> Int -> Doc AnsiStyle
    buildCell [Entry]
    entries [Int]
    widths) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> 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 Doc AnsiStyle
    bar Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    " " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate AnsiStyle
    sgr (String -> Doc AnsiStyle
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty String
    entry) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. Monoid a => [a] -> a
    mconcat (Int -> Doc AnsiStyle -> [Doc AnsiStyle]
    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) =
      String -> Doc AnsiStyle
    forall {a} {ann}. Pretty a => [a] -> Doc ann
    corners (String -> Doc AnsiStyle)
    -> ([Int] -> String) -> [Int] -> Doc AnsiStyle
    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] -> Doc AnsiStyle) -> [Int] -> Doc AnsiStyle
    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. Semigroup a => a -> a -> a
    <> [Char
    sep]
        corners :: [a] -> Doc ann
    corners [] = Doc ann
    ""
        corners [a]
    s = Char -> Doc ann
    forall ann. Char -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Char
    lCorner Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> [a] -> Doc ann
    forall ann. [a] -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty ([a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    init [a]
    s) Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Char -> Doc ann
    forall ann. Char -> Doc ann
    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 (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ RowTemplate -> Doc AnsiStyle
    buildTop RowTemplate
    template Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    sepRows Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> RowTemplate -> Doc AnsiStyle
    buildBottom RowTemplate
    template Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
      where
        sepRows :: Doc AnsiStyle
    sepRows = [Doc AnsiStyle] -> Doc AnsiStyle
    forall a. Monoid a => [a] -> a
    mconcat ([Doc AnsiStyle] -> Doc AnsiStyle)
    -> [Doc AnsiStyle] -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
    forall a. a -> [a] -> [a]
    intersperse (RowTemplate -> Doc AnsiStyle
    buildFloor RowTemplate
    template) [Doc AnsiStyle]
    builtRows
        builtRows :: [Doc AnsiStyle]
    builtRows = ([Entry] -> Doc AnsiStyle) -> [[Entry]] -> [Doc AnsiStyle]
    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 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    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 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
        buildBottom :: RowTemplate -> Doc AnsiStyle
    buildBottom = Char -> Char -> Char -> RowTemplate -> Doc AnsiStyle
    buildSep Char
    '\x2514' Char
    '\x2518' Char
    '\x2534'