Mixed.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TupleSections #-}
-- | Mixed tabular list is a list with different kinds of rows.
--
-- ![ ](mixed-tabular-list.png)
--
-- Read [Shared Traits of Tabular List Widgets]("Brick.Widgets.TabularList#g:SharedTraitsOfTabularListWidgets")
-- before reading further.
--
-- Each row belongs to a row kind which is usually a data constructor of row data type. Because there can be more than
-- one data constructor in row data type, this list is called mixed tabular list. Each row kind can have a different
-- number of columns than another row kind.
--
-- Cell by cell navigation is not supported. You can navigate row by row.
--
-- Because this list is designed to show every column in the available space, horizontal scrolling is not supported.
module Brick.Widgets.TabularList.Mixed (
-- * Data types
  MixedContents(..)
, MixedRenderers(..)
, ColSizes(..)
, CalcColSizes(..)
, MixedSizes(..)
, MixedTabularList(..)
-- * List construction
, mixedTabularList
-- * Rendering
, renderMixedTabularList
-- * Event handlers
, handleMixedListEvent
, handleMixedListEventVi
-- * Shared types
, module Brick.Widgets.TabularList.Types
) where

import Brick.Widgets.TabularList.Types
import Brick.Widgets.TabularList.Internal.Common
import Brick.Widgets.TabularList.Internal.Lens
-- base
import GHC.Generics (Generic)
import Data.Maybe (catMaybes, fromMaybe)
-- Third party libraries
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Optics.Core
import Data.Generics.Labels
import Data.Sequence (Seq)
-- Brick & Vty
import qualified Brick.Widgets.List as L
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Graphics.Vty.Input.Events (Event)

-- | Functions for getting contents of mixed tabular list elements.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data MixedContents row cell rowH colH = MixedContents {
  cell :: row -> ColumnIndex -> Maybe cell -- ^ Function for obtaining a column of a row
, rowHdr :: Maybe (row -> RowIndex -> Maybe rowH) -- ^ Function for getting row header
, colHdr :: Maybe (ColumnIndex -> Maybe colH) -- ^ Function for getting column header
} deriving Generic

-- | Rendering functions for elements of mixed tabular list. See
--
-- * [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data MixedRenderers n row cell rowH colH = MixedRenderers {
  drawCell :: ListFocused -> Position -> row -> Maybe cell -> Widget n
, drawRowHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> row -> Maybe rowH -> Widget n)
, drawColHdr :: Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
} deriving Generic

-- | Column sizes calculated after row header width is calculated.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data ColSizes row = ColSizes {
  -- | Widths for each row kind. Use pattern matching to detect the kind of each row. Usually, a row kind is a data
  -- constructor of row. The returned widths should be pre-calculated widths. If widths are calculated in this function,
  -- width calculation will be repeated at every row. If the function is given pre-calculated widths, width calculation
  -- is done only once.
  rowKind :: row -> [Width]
  -- | Widths and height for column headers. Widths and height don't have to be pre-calculated because column headers are
  -- only drawn once. Because they are drawn once, any calculation done in this field is also done only once.
, colHdr :: Maybe ([Width], Height)
} deriving Generic

-- | Function for calculating column sizes.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data CalcColSizes row =
  -- | Calculate sizes with the width available after row header width is calculated.
  AvailWidth (AvailWidth -> ColSizes row)
  -- | Calculate sizes with visible rows and the width available after row header width is calculated.
  | VisibleRows ([row] -> AvailWidth -> ColSizes row) deriving Generic

-- | Sizes for elements of mixed tabular list.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data MixedSizes row rowH = MixedSizes {
  rowHdr :: Maybe (RowHeaderWidth rowH) -- ^ Width for row headers
, colSizes :: CalcColSizes row -- ^ Function for calculating column sizes after row header width is calculated
} deriving Generic

-- | See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data MixedTabularList n row cell rowH colH = MixedTabularList {
  list :: L.GenericList n Seq row -- ^ The underlying primitive list that comes from brick
, sizes :: MixedSizes row rowH
, contents :: MixedContents row cell rowH colH
} deriving Generic

-- | Create a mixed tabular list.
mixedTabularList :: n -- ^ The name of the list. It must be unique.
  -> Seq row -- ^ The initial list rows
  -> ListItemHeight
  -> MixedSizes row rowH
  -> MixedContents row cell rowH colH
  -> MixedTabularList n row cell rowH colH
mixedTabularList n rows h sizes contents = MixedTabularList {
  list = L.list n rows h
, sizes = sizes
, contents = contents
}

-- | Render mixed tabular list
renderMixedTabularList :: (Show n, Ord n)
  => MixedRenderers n row cell rowH colH -- ^ Renderers
  -> ListFocused
  -> MixedTabularList n row cell rowH colH -- ^ The list
  -> Widget n
renderMixedTabularList r lf l = Widget Greedy Greedy $ do
  c <- getContext
  let drawCell = r ^. #drawCell
      cell = l ^. #contents % #cell
      aW = c^^.availWidthL
      aH = c^^.availHeightL
      iH = l ^. #list % #listItemHeight
      wSet = setAvailableSize . (, iH)
      colHdrRow sizes rhw = case (l ^. #contents % #colHdr, sizes, r ^. #drawColHdr) of
        (Nothing, _, _) -> emptyWidget
        (_, Nothing, _) -> emptyWidget
        (_, _, Nothing) -> emptyWidget
        (Just colH, Just (colWs, colHdrH), Just dch) -> let
          wSet = setAvailableSize . (, colHdrH)
          drawCol ci w = wSet w $ dch lf ci $ colH ci
          in wSet rhw (fill ' ') <+> hBox (zipWith drawCol [0..] colWs)
      renderRow wprk i f row = let
        drawColumn ci w = wSet w $ drawCell lf (Position i f) row $ cell row ci
        in hBox $ zipWith drawColumn [0..] $ wprk row
      sizesAfterRowHdr rhw rows = case l ^. #sizes % #colSizes of
        AvailWidth wf -> wf $ aW - rhw
        VisibleRows wf -> case rows of
          Nothing -> wf (visibleRows (l ^. #list) aH) $ aW - rhw
          Just rows -> wf rows $ aW - rhw
      renderList = let ColSizes {..} = sizesAfterRowHdr 0 Nothing
        in render $ colHdrRow colHdr 0 <=> L.renderListWithIndex (renderRow rowKind) lf (l ^. #list)
      renderHdrList rh rhw drh rows = let
        rhw' = min rhw aW
        rwhd = max 0 $ rhw - aW
        ColSizes {..} = sizesAfterRowHdr rhw' rows
        renderHdrRow i f r = wSet rhw' (drh lf rwhd (Position i f) r $ rh r i) <+> renderRow rowKind i f r
        in render $ colHdrRow colHdr rhw' <=> L.renderListWithIndex renderHdrRow lf (l ^. #list)
  case (l ^. #contents % #rowHdr, l ^. #sizes % #rowHdr, r ^. #drawRowHdr) of
    (Nothing, _, _) -> renderList
    (_, Nothing, _) -> renderList
    (_, _, Nothing) -> renderList
    (Just rh, Just (FixedRowHeader w), Just drh) -> renderHdrList rh w drh Nothing
    (Just rh, Just (AvailRowHeader w), Just drh) -> renderHdrList rh (w aW) drh Nothing
    (Just rh, Just (VisibleRowHeaders w), Just drh) -> let (rs, rHs) = visibleRowsAndRowHdrs (l ^. #list) aH rh
      in renderHdrList rh (w aW rHs) drh (Just rs)

-- | Handle events for mixed tabular list with navigation keys. This just calls 'L.handleListEvent'.
handleMixedListEvent :: Ord n => Event -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEvent e = zoom #list (L.handleListEvent e)

-- | Handle events for mixed tabular list with vim keys. This just calls 'L.handleListEventVi'.
handleMixedListEventVi :: Ord n => Event -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEventVi e = zoom #list (L.handleListEventVi (\_ -> return ()) e)