content: {-# 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 (Eq, Show, 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 (Eq, Show, 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 (Eq, Show, 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 { columnAlignments :: M.Map Int ColumnAlignment
            , rowAlignments :: M.Map Int RowAlignment
            , tableRows :: [[Widget n]]
            , defaultColumnAlignment :: ColumnAlignment
            , defaultRowAlignment :: RowAlignment
            , tableBorderConfiguration :: BorderConfiguration
            }
  
  -- | A border configuration for a table.
  data BorderConfiguration =
      BorderConfiguration { drawSurroundingBorder :: Bool
                          , drawRowBorders :: 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 rows =
      if | not allFixed      -> E.throw TEInvalidCellSizePolicy
         | not allSameLength -> E.throw TEUnequalRowSizes
         | otherwise         -> t
      where
          allSameLength = length (nub (length <$> rows)) <= 1
          allFixed = all fixedRow rows
          fixedRow = all fixedCell
          fixedCell w = hSize w == Fixed && vSize w == Fixed
          t = Table { columnAlignments = mempty
                    , rowAlignments = mempty
                    , tableRows = rows
                    , defaultColumnAlignment = AlignLeft
                    , defaultRowAlignment = AlignTop
                    , tableBorderConfiguration =
                        BorderConfiguration { drawSurroundingBorder = True
                                            , drawRowBorders = True
                                            , drawColumnBorders = True
                                            }
                    }
  
  -- | Configure whether the table draws a border on its exterior.
  surroundingBorder :: Bool -> Table n -> Table n
  surroundingBorder b t =
      t { tableBorderConfiguration = (tableBorderConfiguration t) { drawSurroundingBorder = b } }
  
  -- | Configure whether the table draws borders between its rows.
  rowBorders :: Bool -> Table n -> Table n
  rowBorders b t =
      t { tableBorderConfiguration = (tableBorderConfiguration t) { drawRowBorders = b } }
  
  -- | Configure whether the table draws borders between its columns.
  columnBorders :: Bool -> Table n -> Table n
  columnBorders b t =
      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 = setColAlignment 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 = setColAlignment 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 = setColAlignment 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 = setRowAlignment 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 = setRowAlignment 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 = setRowAlignment 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 a col t =
      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 a row t =
      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 a t =
      t { defaultColumnAlignment = a }
  
  -- | Set the default row alignment for rows with no explicitly
  -- configured alignment.
  setDefaultRowAlignment :: RowAlignment -> Table n -> Table n
  setDefaultRowAlignment a t =
      t { defaultRowAlignment = a }
  
  -- | Render the table.
  renderTable :: Table n -> Widget n
  renderTable t =
      joinBorders $
      Widget Fixed Fixed $ do
          tableCellLayout t >>= addBorders >>= render
  
  -- | The result of performing table cell intermediate rendering and
  -- layout.
  data RenderedTableCells n =
      RenderedTableCells { renderedTableRows :: [[Widget n]]
                         -- ^ The table's cells in row-major order.
                         , renderedTableColumnWidths :: [Int]
                         -- ^ The widths of the table's columns.
                         , renderedTableRowHeights :: [Int]
                         -- ^ The heights of the table's rows.
                         , 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 r = do
      let cfg = borderConfiguration r
          rows = renderedTableRows r
          rowHeights = renderedTableRowHeights r
          colWidths = renderedTableColumnWidths r
  
          contentWidth = sum colWidths
          contentHeight = sum rowHeights
  
          hBorderLength = contentWidth + if drawColumnBorders cfg
                                         then max (length colWidths - 1) 0
                                         else 0
          vBorderHeight = contentHeight + if drawRowBorders cfg
                                          then max (length rowHeights - 1) 0
                                          else 0
          horizBorder = hLimit hBorderLength hBorder
          vertBorder = vLimit vBorderHeight vBorder
  
          leftBorder =
              vBox [topLeftCorner, vertBorder, bottomLeftCorner]
          rightBorder =
              vBox [topRightCorner, vertBorder, bottomRightCorner]
  
          maybeWrap check f =
              if check cfg then f else id
          addSurroundingBorder b =
              leftBorder <+> (horizBorder <=> b <=> horizBorder) <+> rightBorder
          addRowBorders =
              intersperse horizBorder
  
          rowsWithColumnBorders = (\(h, row) -> hBox $ maybeColumnBorders h row) <$> zip rowHeights rows
          maybeColumnBorders height = maybeIntersperse cfg drawColumnBorders (vLimit height vBorder)
          body = vBox $
                 maybeWrap drawRowBorders addRowBorders rowsWithColumnBorders
  
      return $ maybeWrap drawSurroundingBorder addSurroundingBorder body
  
  tableCellLayout :: Table n -> RenderM n (RenderedTableCells n)
  tableCellLayout t = do
      ctx <- getContext
      cellResults <- forM (tableRows t) $ mapM render
  
      let rowHeights = rowHeight <$> cellResults
          colWidths = colWidth <$> transpose cellResults
          numRows = length rowHeights
          numCols = if length cellResults >= 1
                       then length (cellResults !! 0)
                       else 0
          allRowAligns = (\i -> M.findWithDefault (defaultRowAlignment t) i (rowAlignments t)) <$>
                         [0..numRows - 1]
          allColAligns = (\i -> M.findWithDefault (defaultColumnAlignment t) i (columnAlignments t)) <$>
                         [0..numCols - 1]
          rowHeight = maximum . fmap (imageHeight . image)
          colWidth = maximum . fmap (imageWidth . image)
  
          toW = Widget Fixed Fixed . return
          fillEmptyCell w h result =
              if imageWidth (image result) == 0 && imageHeight (image result) == 0
              then result { image = charFill (ctx^.attrL) ' ' w h }
              else result
          mkRow (vAlign, height, rowCells) =
              let paddedCells = flip map (zip3 allColAligns colWidths rowCells) $ \(hAlign, width, cell) ->
                      applyColAlignment width hAlign $
                      applyRowAlignment height vAlign $
                      toW $
                      fillEmptyCell width height cell
              in paddedCells
  
      let rows = mkRow <$> zip3 allRowAligns rowHeights cellResults
  
      return $ RenderedTableCells { renderedTableRows = rows
                                  , renderedTableColumnWidths = colWidths
                                  , renderedTableRowHeights = rowHeights
                                  , borderConfiguration = tableBorderConfiguration t
                                  }
  
  maybeIntersperse :: BorderConfiguration -> (BorderConfiguration -> Bool) -> Widget n -> [Widget n] -> [Widget n]
  maybeIntersperse cfg f v | f cfg = intersperse v
                           | otherwise = id
  
  topLeftCorner :: Widget n
  topLeftCorner = joinableBorder $ Edges False True False True
  
  topRightCorner :: Widget n
  topRightCorner = joinableBorder $ Edges False True True False
  
  bottomLeftCorner :: Widget n
  bottomLeftCorner = joinableBorder $ Edges True False False True
  
  bottomRightCorner :: Widget n
  bottomRightCorner = joinableBorder $ Edges True False True 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 as widths cells =
      (\(w, a, c) -> applyColAlignment w a c) <$> zip3 widths as cells
  
  applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n
  applyColAlignment width align w =
      hLimit width $ case align of
          AlignLeft   -> padRight Max w
          AlignCenter -> hCenter w
          AlignRight  -> padLeft Max w
  
  applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n
  applyRowAlignment rHeight align w =
      vLimit rHeight $ case align of
          AlignTop    -> padBottom Max w
          AlignMiddle -> vCenter w
          AlignBottom -> padTop Max w
  