{-# 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 {
  forall row cell rowH colH.
MixedContents row cell rowH colH
-> row -> ColumnIndex -> Maybe cell
cell :: row -> ColumnIndex -> Maybe cell -- ^ Function for obtaining a column of a row
, forall row cell rowH colH.
MixedContents row cell rowH colH
-> Maybe (row -> ColumnIndex -> Maybe rowH)
rowHdr :: Maybe (row -> RowIndex -> Maybe rowH) -- ^ Function for getting row header
, forall row cell rowH colH.
MixedContents row cell rowH colH
-> Maybe (ColumnIndex -> Maybe colH)
colHdr :: Maybe (ColumnIndex -> Maybe colH) -- ^ Function for getting column header
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall row cell rowH colH x.
Rep (MixedContents row cell rowH colH) x
-> MixedContents row cell rowH colH
forall row cell rowH colH x.
MixedContents row cell rowH colH
-> Rep (MixedContents row cell rowH colH) x
$cto :: forall row cell rowH colH x.
Rep (MixedContents row cell rowH colH) x
-> MixedContents row cell rowH colH
$cfrom :: forall row cell rowH colH x.
MixedContents row cell rowH colH
-> Rep (MixedContents row cell rowH colH) x
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 {
  forall n row cell rowH colH.
MixedRenderers n row cell rowH colH
-> ListFocused -> Position -> row -> Maybe cell -> Widget n
drawCell :: ListFocused -> Position -> row -> Maybe cell -> Widget n
, forall n row cell rowH colH.
MixedRenderers n row cell rowH colH
-> Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
drawRowHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> row -> Maybe rowH -> Widget n)
, forall n row cell rowH colH.
MixedRenderers n row cell rowH colH
-> Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
drawColHdr :: Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
, forall n row cell rowH colH.
MixedRenderers n row cell rowH colH
-> Maybe (ListFocused -> ColumnIndex -> Widget n)
drawColHdrRowHdr :: Maybe (ListFocused -> WidthDeficit -> Widget n)
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n row cell rowH colH x.
Rep (MixedRenderers n row cell rowH colH) x
-> MixedRenderers n row cell rowH colH
forall n row cell rowH colH x.
MixedRenderers n row cell rowH colH
-> Rep (MixedRenderers n row cell rowH colH) x
$cto :: forall n row cell rowH colH x.
Rep (MixedRenderers n row cell rowH colH) x
-> MixedRenderers n row cell rowH colH
$cfrom :: forall n row cell rowH colH x.
MixedRenderers n row cell rowH colH
-> Rep (MixedRenderers n row cell rowH colH) x
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.
  forall row. ColSizes row -> row -> [ColumnIndex]
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.
, forall row. ColSizes row -> Maybe ([ColumnIndex], ColumnIndex)
colHdr :: Maybe ([Width], Height)
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall row x. Rep (ColSizes row) x -> ColSizes row
forall row x. ColSizes row -> Rep (ColSizes row) x
$cto :: forall row x. Rep (ColSizes row) x -> ColSizes row
$cfrom :: forall row x. ColSizes row -> Rep (ColSizes row) x
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 forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall row x. Rep (CalcColSizes row) x -> CalcColSizes row
forall row x. CalcColSizes row -> Rep (CalcColSizes row) x
$cto :: forall row x. Rep (CalcColSizes row) x -> CalcColSizes row
$cfrom :: forall row x. CalcColSizes row -> Rep (CalcColSizes row) x
Generic

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

-- | See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data MixedTabularList n row cell rowH colH = MixedTabularList {
  forall n row cell rowH colH.
MixedTabularList n row cell rowH colH -> GenericList n Seq row
list :: L.GenericList n Seq row -- ^ The underlying primitive list that comes from brick
, forall n row cell rowH colH.
MixedTabularList n row cell rowH colH -> MixedSizes row rowH
sizes :: MixedSizes row rowH
, forall n row cell rowH colH.
MixedTabularList n row cell rowH colH
-> MixedContents row cell rowH colH
contents :: MixedContents row cell rowH colH
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n row cell rowH colH x.
Rep (MixedTabularList n row cell rowH colH) x
-> MixedTabularList n row cell rowH colH
forall n row cell rowH colH x.
MixedTabularList n row cell rowH colH
-> Rep (MixedTabularList n row cell rowH colH) x
$cto :: forall n row cell rowH colH x.
Rep (MixedTabularList n row cell rowH colH) x
-> MixedTabularList n row cell rowH colH
$cfrom :: forall n row cell rowH colH x.
MixedTabularList n row cell rowH colH
-> Rep (MixedTabularList n row cell rowH colH) x
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 :: forall n row rowH cell colH.
n
-> Seq row
-> ColumnIndex
-> MixedSizes row rowH
-> MixedContents row cell rowH colH
-> MixedTabularList n row cell rowH colH
mixedTabularList n
n Seq row
rows ColumnIndex
h MixedSizes row rowH
sizes MixedContents row cell rowH colH
contents = MixedTabularList {
  $sel:list:MixedTabularList :: GenericList n Seq row
list = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> ColumnIndex -> GenericList n t e
L.list n
n Seq row
rows ColumnIndex
h
, $sel:sizes:MixedTabularList :: MixedSizes row rowH
sizes = MixedSizes row rowH
sizes
, $sel:contents:MixedTabularList :: MixedContents row cell rowH colH
contents = MixedContents row cell rowH colH
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 :: forall n row cell rowH colH.
(Show n, Ord n) =>
MixedRenderers n row cell rowH colH
-> ListFocused -> MixedTabularList n row cell rowH colH -> Widget n
renderMixedTabularList MixedRenderers n row cell rowH colH
r ListFocused
lf MixedTabularList n row cell rowH colH
l = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- forall n. RenderM n (Context n)
getContext
  let drawCell :: ListFocused -> Position -> row -> Maybe cell -> Widget n
drawCell = MixedRenderers n row cell rowH colH
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "drawCell" a => a
#drawCell
      cell :: row -> ColumnIndex -> Maybe cell
cell = MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "contents" a => a
#contents forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "cell" a => a
#cell
      aW :: ColumnIndex
aW = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) ColumnIndex
availWidthL
      aH :: ColumnIndex
aH = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) ColumnIndex
availHeightL
      iH :: ColumnIndex
iH = MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listItemHeight" a => a
#listItemHeight
      wSet :: ColumnIndex -> Widget n -> Widget n
wSet = forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, ColumnIndex
iH)
      colHdrRow :: Maybe ([ColumnIndex], ColumnIndex)
-> ColumnIndex -> ColumnIndex -> Widget n
colHdrRow Maybe ([ColumnIndex], ColumnIndex)
sizes ColumnIndex
rhw' ColumnIndex
rhwd = case (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "contents" a => a
#contents forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "colHdr" a => a
#colHdr, Maybe ([ColumnIndex], ColumnIndex)
sizes, MixedRenderers n row cell rowH colH
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "drawColHdr" a => a
#drawColHdr) of
        (Maybe (ColumnIndex -> Maybe colH)
Nothing, Maybe ([ColumnIndex], ColumnIndex)
_, Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
_) -> forall n. Widget n
emptyWidget
        (Maybe (ColumnIndex -> Maybe colH)
_, Maybe ([ColumnIndex], ColumnIndex)
Nothing, Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
_) -> forall n. Widget n
emptyWidget
        (Maybe (ColumnIndex -> Maybe colH)
_, Maybe ([ColumnIndex], ColumnIndex)
_, Maybe (ListFocused -> ColumnIndex -> Maybe colH -> Widget n)
Nothing) -> forall n. Widget n
emptyWidget
        (Just ColumnIndex -> Maybe colH
colH, Just ([ColumnIndex]
colWs, ColumnIndex
colHdrH), Just ListFocused -> ColumnIndex -> Maybe colH -> Widget n
dch) -> let
          drawCol :: ColumnIndex -> ColumnIndex -> Widget n
drawCol ColumnIndex
ci ColumnIndex
w = forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize (ColumnIndex
w, ColumnIndex
colHdrH) forall a b. (a -> b) -> a -> b
$ ListFocused -> ColumnIndex -> Maybe colH -> Widget n
dch ListFocused
lf ColumnIndex
ci forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Maybe colH
colH ColumnIndex
ci
          chrw :: Widget n
chrw = case MixedRenderers n row cell rowH colH
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "drawColHdrRowHdr" a => a
#drawColHdrRowHdr of
            Maybe (ListFocused -> ColumnIndex -> Widget n)
Nothing -> forall n. Char -> Widget n
fill Char
' '
            Just ListFocused -> ColumnIndex -> Widget n
dchrw -> ListFocused -> ColumnIndex -> Widget n
dchrw ListFocused
lf ColumnIndex
rhwd
          in forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize (ColumnIndex
rhw', ColumnIndex
colHdrH) Widget n
chrw forall n. Widget n -> Widget n -> Widget n
<+> forall n. [Widget n] -> Widget n
hBox (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ColumnIndex -> ColumnIndex -> Widget n
drawCol [ColumnIndex
0..] [ColumnIndex]
colWs)
      renderRow :: (row -> [ColumnIndex])
-> ColumnIndex -> ListFocused -> row -> Widget n
renderRow row -> [ColumnIndex]
wprk ColumnIndex
i ListFocused
f row
row = let
        drawColumn :: ColumnIndex -> ColumnIndex -> Widget n
drawColumn ColumnIndex
ci ColumnIndex
w = forall {n}. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
w forall a b. (a -> b) -> a -> b
$ ListFocused -> Position -> row -> Maybe cell -> Widget n
drawCell ListFocused
lf (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
i ListFocused
f) row
row forall a b. (a -> b) -> a -> b
$ row -> ColumnIndex -> Maybe cell
cell row
row ColumnIndex
ci
        in forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ColumnIndex -> ColumnIndex -> Widget n
drawColumn [ColumnIndex
0..] forall a b. (a -> b) -> a -> b
$ row -> [ColumnIndex]
wprk row
row
      sizesAfterRowHdr :: ColumnIndex -> Maybe [row] -> ColSizes row
sizesAfterRowHdr ColumnIndex
rhw Maybe [row]
rows = case MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sizes" a => a
#sizes forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "colSizes" a => a
#colSizes of
        AvailWidth ColumnIndex -> ColSizes row
wf -> ColumnIndex -> ColSizes row
wf forall a b. (a -> b) -> a -> b
$ ColumnIndex
aW forall a. Num a => a -> a -> a
- ColumnIndex
rhw
        VisibleRows [row] -> ColumnIndex -> ColSizes row
wf -> case Maybe [row]
rows of
          Maybe [row]
Nothing -> [row] -> ColumnIndex -> ColSizes row
wf (forall n row. GenericList n Seq row -> ColumnIndex -> [row]
visibleRows (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list) ColumnIndex
aH) forall a b. (a -> b) -> a -> b
$ ColumnIndex
aW forall a. Num a => a -> a -> a
- ColumnIndex
rhw
          Just [row]
rows -> [row] -> ColumnIndex -> ColSizes row
wf [row]
rows forall a b. (a -> b) -> a -> b
$ ColumnIndex
aW forall a. Num a => a -> a -> a
- ColumnIndex
rhw
      renderList :: RenderM n (Result n)
renderList = let ColSizes {Maybe ([ColumnIndex], ColumnIndex)
row -> [ColumnIndex]
colHdr :: Maybe ([ColumnIndex], ColumnIndex)
rowKind :: row -> [ColumnIndex]
$sel:colHdr:ColSizes :: forall row. ColSizes row -> Maybe ([ColumnIndex], ColumnIndex)
$sel:rowKind:ColSizes :: forall row. ColSizes row -> row -> [ColumnIndex]
..} = ColumnIndex -> Maybe [row] -> ColSizes row
sizesAfterRowHdr ColumnIndex
0 forall a. Maybe a
Nothing
        in forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Maybe ([ColumnIndex], ColumnIndex)
-> ColumnIndex -> ColumnIndex -> Widget n
colHdrRow Maybe ([ColumnIndex], ColumnIndex)
colHdr ColumnIndex
0 ColumnIndex
0 forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(ColumnIndex -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex ((row -> [ColumnIndex])
-> ColumnIndex -> ListFocused -> row -> Widget n
renderRow row -> [ColumnIndex]
rowKind) ListFocused
lf (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list)
      renderHdrList :: (row -> ColumnIndex -> a)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n)
-> Maybe [row]
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> a
rh ColumnIndex
rhw ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n
drh Maybe [row]
rows = let
        rhw' :: ColumnIndex
rhw' = forall a. Ord a => a -> a -> a
min ColumnIndex
rhw ColumnIndex
aW
        rhwd :: ColumnIndex
rhwd = forall a. Ord a => a -> a -> a
max ColumnIndex
0 forall a b. (a -> b) -> a -> b
$ ColumnIndex
rhw forall a. Num a => a -> a -> a
- ColumnIndex
aW
        ColSizes {Maybe ([ColumnIndex], ColumnIndex)
row -> [ColumnIndex]
colHdr :: Maybe ([ColumnIndex], ColumnIndex)
rowKind :: row -> [ColumnIndex]
$sel:colHdr:ColSizes :: forall row. ColSizes row -> Maybe ([ColumnIndex], ColumnIndex)
$sel:rowKind:ColSizes :: forall row. ColSizes row -> row -> [ColumnIndex]
..} = ColumnIndex -> Maybe [row] -> ColSizes row
sizesAfterRowHdr ColumnIndex
rhw' Maybe [row]
rows
        renderHdrRow :: ColumnIndex -> ListFocused -> row -> Widget n
renderHdrRow ColumnIndex
i ListFocused
f row
r = forall {n}. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
rhw' (ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n
drh ListFocused
lf ColumnIndex
rhwd (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
i ListFocused
f) row
r forall a b. (a -> b) -> a -> b
$ row -> ColumnIndex -> a
rh row
r ColumnIndex
i) forall n. Widget n -> Widget n -> Widget n
<+> (row -> [ColumnIndex])
-> ColumnIndex -> ListFocused -> row -> Widget n
renderRow row -> [ColumnIndex]
rowKind ColumnIndex
i ListFocused
f row
r
        in forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Maybe ([ColumnIndex], ColumnIndex)
-> ColumnIndex -> ColumnIndex -> Widget n
colHdrRow Maybe ([ColumnIndex], ColumnIndex)
colHdr ColumnIndex
rhw' ColumnIndex
rhwd forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(ColumnIndex -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex ColumnIndex -> ListFocused -> row -> Widget n
renderHdrRow ListFocused
lf (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list)
  case (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "contents" a => a
#contents forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rowHdr" a => a
#rowHdr, MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sizes" a => a
#sizes forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rowHdr" a => a
#rowHdr, MixedRenderers n row cell rowH colH
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "drawRowHdr" a => a
#drawRowHdr) of
    (Maybe (row -> ColumnIndex -> Maybe rowH)
Nothing, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> RenderM n (Result n)
renderList
    (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
Nothing, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> RenderM n (Result n)
renderList
    (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
Nothing) -> RenderM n (Result n)
renderList
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (FixedRowHeader ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> forall {a}.
(row -> ColumnIndex -> a)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n)
-> Maybe [row]
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh ColumnIndex
w ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh forall a. Maybe a
Nothing
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (AvailRowHeader ColumnIndex -> ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> forall {a}.
(row -> ColumnIndex -> a)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n)
-> Maybe [row]
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh (ColumnIndex -> ColumnIndex
w ColumnIndex
aW) ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh forall a. Maybe a
Nothing
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (VisibleRowHeaders ColumnIndex -> [rowH] -> ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> let ([row]
rs, [rowH]
rHs) = forall n row rowH.
GenericList n Seq row
-> ColumnIndex
-> (row -> ColumnIndex -> Maybe rowH)
-> ([row], [rowH])
visibleRowsAndRowHdrs (MixedTabularList n row cell rowH colH
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list) ColumnIndex
aH row -> ColumnIndex -> Maybe rowH
rh
      in forall {a}.
(row -> ColumnIndex -> a)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> a -> Widget n)
-> Maybe [row]
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh (ColumnIndex -> [rowH] -> ColumnIndex
w ColumnIndex
aW [rowH]
rHs) ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh (forall a. a -> Maybe a
Just [row]
rs)

-- | Handle events for mixed tabular list with navigation keys. This just calls 'L.handleListEvent'.
handleMixedListEvent :: Ord n
  => Event -- ^ Event
  -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEvent :: forall n row cell rowH colH.
Ord n =>
Event -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEvent Event
e = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall a. IsLabel "list" a => a
#list (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
L.handleListEvent Event
e)

-- | Handle events for mixed tabular list with vim keys. This just calls 'L.handleListEventVi'.
handleMixedListEventVi :: Ord n
  => Event -- ^ Event
  -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEventVi :: forall n row cell rowH colH.
Ord n =>
Event -> EventM n (MixedTabularList n row cell rowH colH) ()
handleMixedListEventVi Event
e = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall a. IsLabel "list" a => a
#list (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> EventM n (GenericList n t e) ())
-> Event -> EventM n (GenericList n t e) ()
L.handleListEventVi (\Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()) Event
e)