{-# LANGUAGE MultiWayIf #-}
-- | This module provides a table widget that can draw other widgets
-- in a table layout, draw borders between rows and columns, and allow
-- configuration of row and column alignment. To get started, see
-- 'table'.
module Brick.Widgets.Table
  (
  -- * Types
    Table
  , ColumnAlignment(..)
  , RowAlignment(..)
  , TableException(..)

  -- * Construction
  , table

  -- * Configuration
  , alignLeft
  , alignRight
  , alignCenter
  , alignTop
  , alignMiddle
  , alignBottom
  , setColAlignment
  , setRowAlignment
  , setDefaultColAlignment
  , setDefaultRowAlignment
  , surroundingBorder
  , rowBorders
  , columnBorders

  -- * Rendering
  , renderTable

  -- * Low-level API
  , RenderedTableCells(..)
  , BorderConfiguration(..)
  , tableCellLayout
  , addBorders
  , alignColumns
  )
where

import Control.Monad (forM)
import qualified Control.Exception as E
import Data.List (transpose, intersperse, nub)
import qualified Data.Map as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Graphics.Vty (imageHeight, imageWidth, charFill)
import Lens.Micro ((^.))

import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Brick.Widgets.Border

-- | Column alignment modes. Use these modes with the alignment
-- functions in this module to configure column alignment behavior.
data ColumnAlignment =
    AlignLeft
    -- ^ Align all cells to the left.
    | AlignCenter
    -- ^ Center the content horizontally in all cells in the column.
    | AlignRight
    -- ^ Align all cells to the right.
    deriving (ColumnAlignment -> ColumnAlignment -> Bool
(ColumnAlignment -> ColumnAlignment -> Bool)
-> (ColumnAlignment -> ColumnAlignment -> Bool)
-> Eq ColumnAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnAlignment -> ColumnAlignment -> Bool
== :: ColumnAlignment -> ColumnAlignment -> Bool
$c/= :: ColumnAlignment -> ColumnAlignment -> Bool
/= :: ColumnAlignment -> ColumnAlignment -> Bool
Eq, Int -> ColumnAlignment -> ShowS
[ColumnAlignment] -> ShowS
ColumnAlignment -> String
(Int -> ColumnAlignment -> ShowS)
-> (ColumnAlignment -> String)
-> ([ColumnAlignment] -> ShowS)
-> Show ColumnAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnAlignment -> ShowS
showsPrec :: Int -> ColumnAlignment -> ShowS
$cshow :: ColumnAlignment -> String
show :: ColumnAlignment -> String
$cshowList :: [ColumnAlignment] -> ShowS
showList :: [ColumnAlignment] -> ShowS
Show, ReadPrec [ColumnAlignment]
ReadPrec ColumnAlignment
Int -> ReadS ColumnAlignment
ReadS [ColumnAlignment]
(Int -> ReadS ColumnAlignment)
-> ReadS [ColumnAlignment]
-> ReadPrec ColumnAlignment
-> ReadPrec [ColumnAlignment]
-> Read ColumnAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ColumnAlignment
readsPrec :: Int -> ReadS ColumnAlignment
$creadList :: ReadS [ColumnAlignment]
readList :: ReadS [ColumnAlignment]
$creadPrec :: ReadPrec ColumnAlignment
readPrec :: ReadPrec ColumnAlignment
$creadListPrec :: ReadPrec [ColumnAlignment]
readListPrec :: ReadPrec [ColumnAlignment]
Read)

-- | Row alignment modes. Use these modes with the alignment functions
-- in this module to configure row alignment behavior.
data RowAlignment =
    AlignTop
    -- ^ Align all cells to the top.
    | AlignMiddle
    -- ^ Center the content vertically in all cells in the row.
    | AlignBottom
    -- ^ Align all cells to the bottom.
    deriving (RowAlignment -> RowAlignment -> Bool
(RowAlignment -> RowAlignment -> Bool)
-> (RowAlignment -> RowAlignment -> Bool) -> Eq RowAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowAlignment -> RowAlignment -> Bool
== :: RowAlignment -> RowAlignment -> Bool
$c/= :: RowAlignment -> RowAlignment -> Bool
/= :: RowAlignment -> RowAlignment -> Bool
Eq, Int -> RowAlignment -> ShowS
[RowAlignment] -> ShowS
RowAlignment -> String
(Int -> RowAlignment -> ShowS)
-> (RowAlignment -> String)
-> ([RowAlignment] -> ShowS)
-> Show RowAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RowAlignment -> ShowS
showsPrec :: Int -> RowAlignment -> ShowS
$cshow :: RowAlignment -> String
show :: RowAlignment -> String
$cshowList :: [RowAlignment] -> ShowS
showList :: [RowAlignment] -> ShowS
Show, ReadPrec [RowAlignment]
ReadPrec RowAlignment
Int -> ReadS RowAlignment
ReadS [RowAlignment]
(Int -> ReadS RowAlignment)
-> ReadS [RowAlignment]
-> ReadPrec RowAlignment
-> ReadPrec [RowAlignment]
-> Read RowAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RowAlignment
readsPrec :: Int -> ReadS RowAlignment
$creadList :: ReadS [RowAlignment]
readList :: ReadS [RowAlignment]
$creadPrec :: ReadPrec RowAlignment
readPrec :: ReadPrec RowAlignment
$creadListPrec :: ReadPrec [RowAlignment]
readListPrec :: ReadPrec [RowAlignment]
Read)

-- | A table creation exception.
data TableException =
    TEUnequalRowSizes
    -- ^ Rows did not all have the same number of cells.
    | TEInvalidCellSizePolicy
    -- ^ Some cells in the table did not use the 'Fixed' size policy for
    -- both horizontal and vertical sizing.
    deriving (TableException -> TableException -> Bool
(TableException -> TableException -> Bool)
-> (TableException -> TableException -> Bool) -> Eq TableException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableException -> TableException -> Bool
== :: TableException -> TableException -> Bool
$c/= :: TableException -> TableException -> Bool
/= :: TableException -> TableException -> Bool
Eq, Int -> TableException -> ShowS
[TableException] -> ShowS
TableException -> String
(Int -> TableException -> ShowS)
-> (TableException -> String)
-> ([TableException] -> ShowS)
-> Show TableException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableException -> ShowS
showsPrec :: Int -> TableException -> ShowS
$cshow :: TableException -> String
show :: TableException -> String
$cshowList :: [TableException] -> ShowS
showList :: [TableException] -> ShowS
Show, ReadPrec [TableException]
ReadPrec TableException
Int -> ReadS TableException
ReadS [TableException]
(Int -> ReadS TableException)
-> ReadS [TableException]
-> ReadPrec TableException
-> ReadPrec [TableException]
-> Read TableException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TableException
readsPrec :: Int -> ReadS TableException
$creadList :: ReadS [TableException]
readList :: ReadS [TableException]
$creadPrec :: ReadPrec TableException
readPrec :: ReadPrec TableException
$creadListPrec :: ReadPrec [TableException]
readListPrec :: ReadPrec [TableException]
Read)

instance E.Exception TableException where

-- | A table data structure for widgets of type 'Widget' @n@. Create a
-- table with 'table'.
data Table n =
    Table { forall n. Table n -> Map Int ColumnAlignment
columnAlignments :: M.Map Int ColumnAlignment
          , forall n. Table n -> Map Int RowAlignment
rowAlignments :: M.Map Int RowAlignment
          , forall n. Table n -> [[Widget n]]
tableRows :: [[Widget n]]
          , forall n. Table n -> ColumnAlignment
defaultColumnAlignment :: ColumnAlignment
          , forall n. Table n -> RowAlignment
defaultRowAlignment :: RowAlignment
          , forall n. Table n -> BorderConfiguration
tableBorderConfiguration :: BorderConfiguration
          }

-- | A border configuration for a table.
data BorderConfiguration =
    BorderConfiguration { BorderConfiguration -> Bool
drawSurroundingBorder :: Bool
                        , BorderConfiguration -> Bool
drawRowBorders :: Bool
                        , BorderConfiguration -> Bool
drawColumnBorders :: Bool
                        }

-- | Construct a new table.
--
-- The argument is the list of rows with the topmost row first, with
-- each element of the argument list being the contents of the cells in
-- in each column of the respective row, with the leftmost cell first.
--
-- Each row's height is determined by the height of the tallest cell
-- in that row, and each column's width is determined by the width of
-- the widest cell in that column. This means that control over row
-- and column dimensions is a matter of controlling the size of the
-- individual cells, such as by wrapping cell contents in padding,
-- 'fill' and 'hLimit' or 'vLimit', etc. This also means that it is not
-- necessary to explicitly set the width of most table cells because
-- the table will determine the per-row and per-column dimensions by
-- looking at the largest cell contents. In particular, this means
-- that the table's alignment logic only has an effect when a given
-- cell's contents are smaller than the maximum for its row and column,
-- thus giving the table some way to pad the contents to result in the
-- desired alignment.
--
-- By default:
--
-- * All columns are left-aligned. Use the alignment functions in this
-- module to change that behavior.
-- * All rows are top-aligned. Use the alignment functions in this
-- module to change that behavior.
-- * The table will draw borders between columns, between rows, and
-- around the outside of the table. Border-drawing behavior can be
-- configured with the API in this module. Note that tables always draw
-- with 'joinBorders' enabled. If a cell's contents has smart borders
-- but you don't want those borders to connect to the surrounding table
-- borders, wrap the cell's contents with 'freezeBorders'.
--
-- All cells of all rows MUST use the 'Fixed' growth policy for both
-- horizontal and vertical growth. If the argument list contains any
-- cells that use the 'Greedy' policy, this function will raise a
-- 'TableException'.
--
-- All rows MUST have the same number of cells. If not, this function
-- will raise a 'TableException'.
table :: [[Widget n]] -> Table n
table :: forall n. [[Widget n]] -> Table n
table [[Widget n]]
rows =
    if | Bool -> Bool
not Bool
allFixed      -> TableException -> Table n
forall a e. Exception e => e -> a
E.throw TableException
TEInvalidCellSizePolicy
       | Bool -> Bool
not Bool
allSameLength -> TableException -> Table n
forall a e. Exception e => e -> a
E.throw TableException
TEUnequalRowSizes
       | Bool
otherwise         -> Table n
t
    where
        allSameLength :: Bool
allSameLength = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Widget n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Widget n] -> Int) -> [[Widget n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Widget n]]
rows)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
        allFixed :: Bool
allFixed = ([Widget n] -> Bool) -> [[Widget n]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Widget n] -> Bool
forall {n}. [Widget n] -> Bool
fixedRow [[Widget n]]
rows
        fixedRow :: [Widget n] -> Bool
fixedRow = (Widget n -> Bool) -> [Widget n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Widget n -> Bool
forall {n}. Widget n -> Bool
fixedCell
        fixedCell :: Widget n -> Bool
fixedCell Widget n
w = Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
w Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
Fixed Bool -> Bool -> Bool
&& Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
w Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
Fixed
        t :: Table n
t = Table { columnAlignments :: Map Int ColumnAlignment
columnAlignments = Map Int ColumnAlignment
forall a. Monoid a => a
mempty
                  , rowAlignments :: Map Int RowAlignment
rowAlignments = Map Int RowAlignment
forall a. Monoid a => a
mempty
                  , tableRows :: [[Widget n]]
tableRows = [[Widget n]]
rows
                  , defaultColumnAlignment :: ColumnAlignment
defaultColumnAlignment = ColumnAlignment
AlignLeft
                  , defaultRowAlignment :: RowAlignment
defaultRowAlignment = RowAlignment
AlignTop
                  , tableBorderConfiguration :: BorderConfiguration
tableBorderConfiguration =
                      BorderConfiguration { drawSurroundingBorder :: Bool
drawSurroundingBorder = Bool
True
                                          , drawRowBorders :: Bool
drawRowBorders = Bool
True
                                          , drawColumnBorders :: Bool
drawColumnBorders = Bool
True
                                          }
                  }

-- | Configure whether the table draws a border on its exterior.
surroundingBorder :: Bool -> Table n -> Table n
surroundingBorder :: forall n. Bool -> Table n -> Table n
surroundingBorder Bool
b Table n
t =
    Table n
t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } }

-- | Configure whether the table draws borders between its rows.
rowBorders :: Bool -> Table n -> Table n
rowBorders :: forall n. Bool -> Table n -> Table n
rowBorders Bool
b Table n
t =
    Table n
t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } }

-- | Configure whether the table draws borders between its columns.
columnBorders :: Bool -> Table n -> Table n
columnBorders :: forall n. Bool -> Table n -> Table n
columnBorders Bool
b Table n
t =
    Table n
t { tableBorderConfiguration = (tableBorderConfiguration t) { drawColumnBorders = b } }

-- | Align the specified column to the right. The argument is the column
-- index, starting with zero. Silently does nothing if the index is out
-- of range.
alignRight :: Int -> Table n -> Table n
alignRight :: forall n. Int -> Table n -> Table n
alignRight = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignRight

-- | Align the specified column to the left. The argument is the column
-- index, starting with zero. Silently does nothing if the index is out
-- of range.
alignLeft :: Int -> Table n -> Table n
alignLeft :: forall n. Int -> Table n -> Table n
alignLeft = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignLeft

-- | Align the specified column to center. The argument is the column
-- index, starting with zero. Silently does nothing if the index is out
-- of range.
alignCenter :: Int -> Table n -> Table n
alignCenter :: forall n. Int -> Table n -> Table n
alignCenter = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignCenter

-- | Align the specified row to the top. The argument is the row index,
-- starting with zero. Silently does nothing if the index is out of
-- range.
alignTop :: Int -> Table n -> Table n
alignTop :: forall n. Int -> Table n -> Table n
alignTop = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignTop

-- | Align the specified row to the middle. The argument is the row
-- index, starting with zero. Silently does nothing if the index is out
-- of range.
alignMiddle :: Int -> Table n -> Table n
alignMiddle :: forall n. Int -> Table n -> Table n
alignMiddle = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignMiddle

-- | Align the specified row to bottom. The argument is the row index,
-- starting with zero. Silently does nothing if the index is out of
-- range.
alignBottom :: Int -> Table n -> Table n
alignBottom :: forall n. Int -> Table n -> Table n
alignBottom = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignBottom

-- | Set the alignment for the specified column index (starting at
-- zero). Silently does nothing if the index is out of range.
setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n
setColAlignment :: forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
a Int
col Table n
t =
    Table n
t { columnAlignments = M.insert col a (columnAlignments t) }

-- | Set the alignment for the specified row index (starting at
-- zero). Silently does nothing if the index is out of range.
setRowAlignment :: RowAlignment -> Int -> Table n -> Table n
setRowAlignment :: forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
a Int
row Table n
t =
    Table n
t { rowAlignments = M.insert row a (rowAlignments t) }

-- | Set the default column alignment for columns with no explicitly
-- configured alignment.
setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n
setDefaultColAlignment :: forall n. ColumnAlignment -> Table n -> Table n
setDefaultColAlignment ColumnAlignment
a Table n
t =
    Table n
t { defaultColumnAlignment = a }

-- | Set the default row alignment for rows with no explicitly
-- configured alignment.
setDefaultRowAlignment :: RowAlignment -> Table n -> Table n
setDefaultRowAlignment :: forall n. RowAlignment -> Table n -> Table n
setDefaultRowAlignment RowAlignment
a Table n
t =
    Table n
t { defaultRowAlignment = a }

-- | Render the table.
renderTable :: Table n -> Widget n
renderTable :: forall n. Table n -> Widget n
renderTable Table n
t =
    Widget n -> Widget n
forall n. Widget n -> Widget n
joinBorders (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Table n -> RenderM n (RenderedTableCells n)
forall n. Table n -> RenderM n (RenderedTableCells n)
tableCellLayout Table n
t RenderM n (RenderedTableCells n)
-> (RenderedTableCells n
    -> ReaderT (Context n) (State (RenderState n)) (Widget n))
-> ReaderT (Context n) (State (RenderState n)) (Widget n)
forall a b.
ReaderT (Context n) (State (RenderState n)) a
-> (a -> ReaderT (Context n) (State (RenderState n)) b)
-> ReaderT (Context n) (State (RenderState n)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RenderedTableCells n
-> ReaderT (Context n) (State (RenderState n)) (Widget n)
forall n. RenderedTableCells n -> RenderM n (Widget n)
addBorders ReaderT (Context n) (State (RenderState n)) (Widget n)
-> (Widget n -> RenderM n (Result n)) -> RenderM n (Result n)
forall a b.
ReaderT (Context n) (State (RenderState n)) a
-> (a -> ReaderT (Context n) (State (RenderState n)) b)
-> ReaderT (Context n) (State (RenderState n)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render

-- | The result of performing table cell intermediate rendering and
-- layout.
data RenderedTableCells n =
    RenderedTableCells { forall n. RenderedTableCells n -> [[Widget n]]
renderedTableRows :: [[Widget n]]
                       -- ^ The table's cells in row-major order.
                       , forall n. RenderedTableCells n -> [Int]
renderedTableColumnWidths :: [Int]
                       -- ^ The widths of the table's columns.
                       , forall n. RenderedTableCells n -> [Int]
renderedTableRowHeights :: [Int]
                       -- ^ The heights of the table's rows.
                       , forall n. RenderedTableCells n -> BorderConfiguration
borderConfiguration :: BorderConfiguration
                       -- ^ The border configuration to use.
                       }

-- | Augment rendered table cells with borders according to the
-- border configuration accompanying the cells.
addBorders :: RenderedTableCells n -> RenderM n (Widget n)
addBorders :: forall n. RenderedTableCells n -> RenderM n (Widget n)
addBorders RenderedTableCells n
r = do
    let cfg :: BorderConfiguration
cfg = RenderedTableCells n -> BorderConfiguration
forall n. RenderedTableCells n -> BorderConfiguration
borderConfiguration RenderedTableCells n
r
        rows :: [[Widget n]]
rows = RenderedTableCells n -> [[Widget n]]
forall n. RenderedTableCells n -> [[Widget n]]
renderedTableRows RenderedTableCells n
r
        rowHeights :: [Int]
rowHeights = RenderedTableCells n -> [Int]
forall n. RenderedTableCells n -> [Int]
renderedTableRowHeights RenderedTableCells n
r
        colWidths :: [Int]
colWidths = RenderedTableCells n -> [Int]
forall n. RenderedTableCells n -> [Int]
renderedTableColumnWidths RenderedTableCells n
r

        contentWidth :: Int
contentWidth = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
colWidths
        contentHeight :: Int
contentHeight = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rowHeights

        hBorderLength :: Int
hBorderLength = Int
contentWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if BorderConfiguration -> Bool
drawColumnBorders BorderConfiguration
cfg
                                       then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
colWidths Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
                                       else Int
0
        vBorderHeight :: Int
vBorderHeight = Int
contentHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if BorderConfiguration -> Bool
drawRowBorders BorderConfiguration
cfg
                                        then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rowHeights Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0
                                        else Int
0
        horizBorder :: Widget n
horizBorder = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
hBorderLength Widget n
forall n. Widget n
hBorder
        vertBorder :: Widget n
vertBorder = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
vBorderHeight Widget n
forall n. Widget n
vBorder

        leftBorder :: Widget n
leftBorder =
            [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [Widget n
forall n. Widget n
topLeftCorner, Widget n
forall n. Widget n
vertBorder, Widget n
forall n. Widget n
bottomLeftCorner]
        rightBorder :: Widget n
rightBorder =
            [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [Widget n
forall n. Widget n
topRightCorner, Widget n
forall n. Widget n
vertBorder, Widget n
forall n. Widget n
bottomRightCorner]

        maybeWrap :: (BorderConfiguration -> Bool) -> (a -> a) -> a -> a
maybeWrap BorderConfiguration -> Bool
check a -> a
f =
            if BorderConfiguration -> Bool
check BorderConfiguration
cfg then a -> a
f else a -> a
forall a. a -> a
id
        addSurroundingBorder :: Widget n -> Widget n
addSurroundingBorder Widget n
b =
            Widget n
forall n. Widget n
leftBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Widget n
forall n. Widget n
horizBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
b Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
horizBorder) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
rightBorder
        addRowBorders :: [Widget n] -> [Widget n]
addRowBorders =
            Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
forall n. Widget n
horizBorder

        rowsWithColumnBorders :: [Widget n]
rowsWithColumnBorders = (\(Int
h, [Widget n]
row) -> [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> [Widget n] -> [Widget n]
forall {n}. Int -> [Widget n] -> [Widget n]
maybeColumnBorders Int
h [Widget n]
row) ((Int, [Widget n]) -> Widget n)
-> [(Int, [Widget n])] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [[Widget n]] -> [(Int, [Widget n])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
rowHeights [[Widget n]]
rows
        maybeColumnBorders :: Int -> [Widget n] -> [Widget n]
maybeColumnBorders Int
height = BorderConfiguration
-> (BorderConfiguration -> Bool)
-> Widget n
-> [Widget n]
-> [Widget n]
forall n.
BorderConfiguration
-> (BorderConfiguration -> Bool)
-> Widget n
-> [Widget n]
-> [Widget n]
maybeIntersperse BorderConfiguration
cfg BorderConfiguration -> Bool
drawColumnBorders (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
height Widget n
forall n. Widget n
vBorder)
        body :: Widget n
body = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
               (BorderConfiguration -> Bool)
-> ([Widget n] -> [Widget n]) -> [Widget n] -> [Widget n]
forall {a}. (BorderConfiguration -> Bool) -> (a -> a) -> a -> a
maybeWrap BorderConfiguration -> Bool
drawRowBorders [Widget n] -> [Widget n]
forall {n}. [Widget n] -> [Widget n]
addRowBorders [Widget n]
rowsWithColumnBorders

    Widget n -> RenderM n (Widget n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> RenderM n (Widget n))
-> Widget n -> RenderM n (Widget n)
forall a b. (a -> b) -> a -> b
$ (BorderConfiguration -> Bool)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall {a}. (BorderConfiguration -> Bool) -> (a -> a) -> a -> a
maybeWrap BorderConfiguration -> Bool
drawSurroundingBorder Widget n -> Widget n
forall n. Widget n -> Widget n
addSurroundingBorder Widget n
body

tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)
tableCellLayout :: forall n. Table n -> RenderM n (RenderedTableCells n)
tableCellLayout Table n
t = do
    Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
    [[Result n]]
cellResults <- [[Widget n]]
-> ([Widget n]
    -> ReaderT (Context n) (State (RenderState n)) [Result n])
-> ReaderT (Context n) (State (RenderState n)) [[Result n]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Table n -> [[Widget n]]
forall n. Table n -> [[Widget n]]
tableRows Table n
t) (([Widget n]
  -> ReaderT (Context n) (State (RenderState n)) [Result n])
 -> ReaderT (Context n) (State (RenderState n)) [[Result n]])
-> ([Widget n]
    -> ReaderT (Context n) (State (RenderState n)) [Result n])
-> ReaderT (Context n) (State (RenderState n)) [[Result n]]
forall a b. (a -> b) -> a -> b
$ (Widget n
 -> ReaderT (Context n) (State (RenderState n)) (Result n))
-> [Widget n]
-> ReaderT (Context n) (State (RenderState n)) [Result n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Widget n -> ReaderT (Context n) (State (RenderState n)) (Result n)
forall n. Widget n -> RenderM n (Result n)
render

    let rowHeights :: [Int]
rowHeights = [Result n] -> Int
forall {n}. [Result n] -> Int
rowHeight ([Result n] -> Int) -> [[Result n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Result n]]
cellResults
        colWidths :: [Int]
colWidths = [Result n] -> Int
forall {n}. [Result n] -> Int
colWidth ([Result n] -> Int) -> [[Result n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Result n]] -> [[Result n]]
forall a. [[a]] -> [[a]]
transpose [[Result n]]
cellResults
        numRows :: Int
numRows = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rowHeights
        numCols :: Int
numCols = if [[Result n]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Result n]]
cellResults Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
                     then [Result n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Result n]]
cellResults [[Result n]] -> Int -> [Result n]
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
                     else Int
0
        allRowAligns :: [RowAlignment]
allRowAligns = (\Int
i -> RowAlignment -> Int -> Map Int RowAlignment -> RowAlignment
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (Table n -> RowAlignment
forall n. Table n -> RowAlignment
defaultRowAlignment Table n
t) Int
i (Table n -> Map Int RowAlignment
forall n. Table n -> Map Int RowAlignment
rowAlignments Table n
t)) (Int -> RowAlignment) -> [Int] -> [RowAlignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       [Int
0..Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        allColAligns :: [ColumnAlignment]
allColAligns = (\Int
i -> ColumnAlignment
-> Int -> Map Int ColumnAlignment -> ColumnAlignment
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (Table n -> ColumnAlignment
forall n. Table n -> ColumnAlignment
defaultColumnAlignment Table n
t) Int
i (Table n -> Map Int ColumnAlignment
forall n. Table n -> Map Int ColumnAlignment
columnAlignments Table n
t)) (Int -> ColumnAlignment) -> [Int] -> [ColumnAlignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       [Int
0..Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        rowHeight :: [Result n] -> Int
rowHeight = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Result n] -> [Int]) -> [Result n] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result n -> Int) -> [Result n] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Image -> Int
imageHeight (Image -> Int) -> (Result n -> Image) -> Result n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> Image
forall n. Result n -> Image
image)
        colWidth :: [Result n] -> Int
colWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Result n] -> [Int]) -> [Result n] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result n -> Int) -> [Result n] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Image -> Int
imageWidth (Image -> Int) -> (Result n -> Image) -> Result n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> Image
forall n. Result n -> Image
image)

        toW :: Result n -> Widget n
toW = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> (Result n -> RenderM n (Result n)) -> Result n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> RenderM n (Result n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
        fillEmptyCell :: d -> d -> Result n -> Result n
fillEmptyCell d
w d
h Result n
result =
            if Image -> Int
imageWidth (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Image -> Int
imageHeight (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Result n
result { image = charFill (ctx^.attrL) ' ' w h }
            else Result n
result
        mkRow :: (RowAlignment, Int, [Result n]) -> [Widget n]
mkRow (RowAlignment
vAlign, Int
height, [Result n]
rowCells) =
            let paddedCells :: [Widget n]
paddedCells = (((ColumnAlignment, Int, Result n) -> Widget n)
 -> [(ColumnAlignment, Int, Result n)] -> [Widget n])
-> [(ColumnAlignment, Int, Result n)]
-> ((ColumnAlignment, Int, Result n) -> Widget n)
-> [Widget n]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ColumnAlignment, Int, Result n) -> Widget n)
-> [(ColumnAlignment, Int, Result n)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map ([ColumnAlignment]
-> [Int] -> [Result n] -> [(ColumnAlignment, Int, Result n)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [ColumnAlignment]
allColAligns [Int]
colWidths [Result n]
rowCells) (((ColumnAlignment, Int, Result n) -> Widget n) -> [Widget n])
-> ((ColumnAlignment, Int, Result n) -> Widget n) -> [Widget n]
forall a b. (a -> b) -> a -> b
$ \(ColumnAlignment
hAlign, Int
width, Result n
cell) ->
                    Int -> ColumnAlignment -> Widget n -> Widget n
forall n. Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment Int
width ColumnAlignment
hAlign (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                    Int -> RowAlignment -> Widget n -> Widget n
forall n. Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment Int
height RowAlignment
vAlign (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                    Result n -> Widget n
forall {n}. Result n -> Widget n
toW (Result n -> Widget n) -> Result n -> Widget n
forall a b. (a -> b) -> a -> b
$
                    Int -> Int -> Result n -> Result n
forall {d} {n}. Integral d => d -> d -> Result n -> Result n
fillEmptyCell Int
width Int
height Result n
cell
            in [Widget n]
paddedCells

    let rows :: [[Widget n]]
rows = (RowAlignment, Int, [Result n]) -> [Widget n]
forall {n}. (RowAlignment, Int, [Result n]) -> [Widget n]
mkRow ((RowAlignment, Int, [Result n]) -> [Widget n])
-> [(RowAlignment, Int, [Result n])] -> [[Widget n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RowAlignment]
-> [Int] -> [[Result n]] -> [(RowAlignment, Int, [Result n])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [RowAlignment]
allRowAligns [Int]
rowHeights [[Result n]]
cellResults

    RenderedTableCells n -> RenderM n (RenderedTableCells n)
forall a. a -> ReaderT (Context n) (State (RenderState n)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RenderedTableCells n -> RenderM n (RenderedTableCells n))
-> RenderedTableCells n -> RenderM n (RenderedTableCells n)
forall a b. (a -> b) -> a -> b
$ RenderedTableCells { renderedTableRows :: [[Widget n]]
renderedTableRows = [[Widget n]]
rows
                                , renderedTableColumnWidths :: [Int]
renderedTableColumnWidths = [Int]
colWidths
                                , renderedTableRowHeights :: [Int]
renderedTableRowHeights = [Int]
rowHeights
                                , borderConfiguration :: BorderConfiguration
borderConfiguration = Table n -> BorderConfiguration
forall n. Table n -> BorderConfiguration
tableBorderConfiguration Table n
t
                                }

maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]
maybeIntersperse :: forall n.
BorderConfiguration
-> (BorderConfiguration -> Bool)
-> Widget n
-> [Widget n]
-> [Widget n]
maybeIntersperse BorderConfiguration
cfg BorderConfiguration -> Bool
f Widget n
v | BorderConfiguration -> Bool
f BorderConfiguration
cfg = Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
v
                         | Bool
otherwise = [Widget n] -> [Widget n]
forall a. a -> a
id

topLeftCorner :: Widget n
topLeftCorner :: forall n. Widget n
topLeftCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True

topRightCorner :: Widget n
topRightCorner :: forall n. Widget n
topRightCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False

bottomLeftCorner :: Widget n
bottomLeftCorner :: forall n. Widget n
bottomLeftCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True

bottomRightCorner :: Widget n
bottomRightCorner :: forall n. Widget n
bottomRightCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False

-- | Given a "table row" of widgets, align each one according to the
-- list of specified column alignments in columns of the specified
-- widths.
alignColumns :: [ColumnAlignment]
             -- ^ The column alignments to use for each widget,
             -- respectively.
             -> [Int]
             -- ^ The width of each column in terminal columns,
             -- respectively.
             -> [Widget n]
             -- ^ The column cells to align.
             -> [Widget n]
alignColumns :: forall n. [ColumnAlignment] -> [Int] -> [Widget n] -> [Widget n]
alignColumns [ColumnAlignment]
as [Int]
widths [Widget n]
cells =
    (\(Int
w, ColumnAlignment
a, Widget n
c) -> Int -> ColumnAlignment -> Widget n -> Widget n
forall n. Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment Int
w ColumnAlignment
a Widget n
c) ((Int, ColumnAlignment, Widget n) -> Widget n)
-> [(Int, ColumnAlignment, Widget n)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> [ColumnAlignment]
-> [Widget n]
-> [(Int, ColumnAlignment, Widget n)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
widths [ColumnAlignment]
as [Widget n]
cells

applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment :: forall n. Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment Int
width ColumnAlignment
align Widget n
w =
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case ColumnAlignment
align of
        ColumnAlignment
AlignLeft   -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max Widget n
w
        ColumnAlignment
AlignCenter -> Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter Widget n
w
        ColumnAlignment
AlignRight  -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max Widget n
w

applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment :: forall n. Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment Int
rHeight RowAlignment
align Widget n
w =
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
rHeight (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case RowAlignment
align of
        RowAlignment
AlignTop    -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max Widget n
w
        RowAlignment
AlignMiddle -> Widget n -> Widget n
forall n. Widget n -> Widget n
vCenter Widget n
w
        RowAlignment
AlignBottom -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop Padding
Max Widget n
w