Mixed.hs

{-# OPTIONS_HADDOCK show-extensions #-}
{-# 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
  MixedRowCtxt(..)
, MixedColCtxt(..)
, MixedCtxt(..)
, MixedColHdr(..)
, MixedRenderers(..)
, WidthsPerRowKind(..)
, 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)

-- | Mixed row context
data MixedRowCtxt = MRowC {
  index :: Index
, selected :: Selected
} deriving (Eq, Generic, Show)

-- | Mixed column context
newtype MixedColCtxt = MColC { index :: Index } deriving (Eq, Generic, Show)

-- | Context for mixed columns
data MixedCtxt = MxdCtxt {
  row :: MixedRowCtxt
, col :: MixedColCtxt
} deriving (Eq, Generic, Show)

-- | Mixed column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data MixedColHdr n w = MixedColHdr {
  draw :: ListFocused -> MixedColCtxt -> Widget n
  -- | A function for getting widths for column headers from the type that contains widths per row kind
, widths :: w -> [ColWidth]
, height :: ColHdrHeight
} 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 {
  cell :: ListFocused -> MixedCtxt -> e -> Widget n
, rowHdr :: Maybe (RowHdr n e r)
, colHdr :: Maybe (MixedColHdr n w)
, colHdrRowHdr :: Maybe (ColHdrRowHdr 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")
newtype WidthsPerRowKind e w = WsPerRK (AvailWidth -> [e] -> w) deriving Generic

-- | 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")
newtype WidthsPerRow e w = WsPerR (w -> e -> [ColWidth]) deriving Generic

-- | * [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
, widthsPerRowKind :: WidthsPerRowKind 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
  -> WidthsPerRowKind e w
  -> WidthsPerRow e w
  -> MixedTabularList n e w
mixedTabularList n rows (LstItmH h) wprk wpr = MixedTabularList {
  list = L.list n rows h
, widthsPerRowKind = wprk
, 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 (LstFcs f) l = Widget Greedy Greedy $ do
  c <- getContext
  let aW = c^^.availWidthL
      aH = c^^.availHeightL
      cell = r ^. #cell
      MixedTabularList {list=l', widthsPerRowKind=WsPerRK wprk', widthsPerRow=WsPerR wpr} = l
      iH = l' ^^. L.listItemHeightL
      colHdrRow wprk (RowHdrW rhw) (WdthD rhwd) = case r ^. #colHdr of
        Nothing -> emptyWidget
        Just (MixedColHdr {draw, widths, height=ColHdrH chh}) -> let
          col ci (ColW w) = sz (w, chh) $ draw (LstFcs f) (MColC ci)
          chrw = case r ^. #colHdrRowHdr of
            Nothing -> fill ' '
            Just (CHRH chrw) -> chrw (LstFcs f) (WdthD rhwd)
          in sz (rhw, chh) chrw <+> hBox (zipWith col [Ix 0..] $ widths wprk)
      row wprk i f r = let
        col ci (ColW w) = sz (w, iH) $ cell (LstFcs f) (MxdCtxt (MRowC (Ix i) (Sel f)) $ MColC ci) r
        in hBox $ zipWith col [Ix 0..] $ wpr wprk r
      lst = let wprk = wprk' (AvlW aW) $ fst $ visibleRowIdx l' (AvlH aH)
        in render $ colHdrRow wprk (RowHdrW 0) (WdthD 0) <=> L.renderListWithIndex (row wprk) f l'
      hdrLst (RowHdr {draw=drw, width, toRH=tR}) = let
        (es, is) = visibleRowIdx l' (AvlH aH)
        RowHdrW rhw' = width (AvlW aW) $ zipWith tR es is
        rhw = min rhw' aW
        rhwd = WdthD $ max 0 $ rhw' - aW
        wprk = wprk' (AvlW $ aW - rhw) es
        hdrRow i f r = sz (rhw, iH) (drw (LstFcs f) rhwd (RowHdrCtxt $ Sel f) $ tR r (Ix i)) <+> row wprk i f r
        in render $ colHdrRow wprk (RowHdrW rhw) rhwd <=> L.renderListWithIndex hdrRow f l'
  maybe lst hdrLst $ 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)