Mixed.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
-- | Mixed tabular list is a list with different kinds of rows.
--
-- ![demo](mixed-tabular-list.png)
--
-- 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
  MixedContext(..)
, MixedColHdr(..)
, MixedRenderers(..)
, CalcWidthsPerRowKind
, WidthsPerRow
, 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 Graphics.Vty.Input.Events (Event)

-- | Context for mixed columns
data MixedContext = MixedContext {
  row :: FlatContext -- ^ Row context
, col :: Index -- ^ Index of column
}

-- | Mixed column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data MixedColHdr n w = MixedColHdr {
  draw :: ListFocused -> Index -> Widget n
  -- | A function for getting widths for column headers from the type that contains widths per row kind
, widths :: w -> [Width]
, height:: Height -- ^ Height for column headers and column header row header
} deriving Generic

-- | Rendering functions for components of mixed tabular list
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data MixedRenderers n e w r = MixedRenderers {
  drawCell :: ListFocused -> MixedContext -> e -> Widget n
, rowHdr :: Maybe (RowHdr n e r)
, colHdr :: Maybe (MixedColHdr n w)
, drawColHdrRowHdr :: DrawColHdrRowHdr n
} deriving Generic

-- | Calculate widths per row kind from visible list rows and the width available after row header.
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
type CalcWidthsPerRowKind e w = AvailWidth -> [e] -> w

-- | It is a function to get widths for each row. Use pattern matching to detect the kind of each row. Usually, a row
-- kind is a data constructor of row data type.
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
type WidthsPerRow e w = w -> e -> [Width]

-- | * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
data MixedTabularList n e w = MixedTabularList {
  list :: L.GenericList n Seq e -- ^ The underlying list that comes from brick
, calcWidthsPerRowKind :: CalcWidthsPerRowKind e w
, widthsPerRow :: WidthsPerRow e w
} deriving Generic

-- | Create a mixed tabular list.
mixedTabularList :: n -- ^ The name of the list. It must be unique.
  -> Seq e -- ^ The initial list elements
  -> ListItemHeight
  -> CalcWidthsPerRowKind e w
  -> WidthsPerRow e w
  -> MixedTabularList n e w
mixedTabularList n rows h cWprk wpr = MixedTabularList {
  list = L.list n rows h
, calcWidthsPerRowKind = cWprk
, widthsPerRow = wpr
}

-- | Render mixed tabular list.
renderMixedTabularList :: (Show n, Ord n)
  => MixedRenderers n e w r -- ^ Renderers
  -> ListFocused
  -> MixedTabularList n e w -- ^ The list
  -> Widget n
renderMixedTabularList r lf l = Widget Greedy Greedy $ do
  c <- getContext
  let aW = c^^.availWidthL
      aH = c^^.availHeightL
      MixedRenderers {drawCell} = r
      MixedTabularList {list=l', calcWidthsPerRowKind=cWprk, widthsPerRow=wpr} = l
      iH = l' ^^. L.listItemHeightL
      colHdrRow wprk rhw' rhwd = case r ^. #colHdr of
        Nothing -> emptyWidget
        Just (MixedColHdr {draw, widths, height}) -> let
          drawCol ci w = setAvailableSize (w, height) $ draw lf ci
          chrw = case r ^. #drawColHdrRowHdr of
            Nothing -> fill ' '
            Just dchrw -> dchrw lf rhwd
          in setAvailableSize (rhw', height) chrw <+> hBox (zipWith drawCol [0..] $ widths wprk)
      renderRow wprk i f row = let
        drawColumn ci w = setAvailableSize (w, iH) $ drawCell lf (MixedContext (FlatContext i f) ci) row
        in hBox $ zipWith drawColumn [0..] $ wpr wprk row
      renderList = let wprk = cWprk aW $ visibleRows l' aH
        in render $ colHdrRow wprk 0 0 <=> L.renderListWithIndex (renderRow wprk) lf l'
      renderHdrList (RowHdr {draw, width, toRowHdr}) = let
        (es, s) = visibleRowsWithStart l' aH
        rhw = width aW $ zipWith toRowHdr es [s..]
        rhw' = min rhw aW
        rhwd = max 0 $ rhw - aW
        wprk = cWprk (aW - rhw') es
        renderHdrRow i f r = setAvailableSize (rhw', iH) (draw lf rhwd f $ toRowHdr r i) <+> renderRow wprk i f r
        in render $ colHdrRow wprk rhw' rhwd <=> L.renderListWithIndex renderHdrRow lf l'
  maybe renderList renderHdrList $ r ^. #rowHdr

-- | Handle events for mixed tabular list with navigation keys. This just calls 'L.handleListEvent'.
handleMixedListEvent :: Ord n
  => Event -- ^ Event
  -> EventM n (MixedTabularList n e w) ()
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 -- ^ Event
  -> EventM n (MixedTabularList n e w) ()
handleMixedListEventVi e = zoom #list (L.handleListEventVi (\_ -> return ()) e)