{-# 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 {
  MixedRowCtxt -> Index
index :: Index
, MixedRowCtxt -> Selected
selected :: Selected
} deriving (MixedRowCtxt -> MixedRowCtxt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MixedRowCtxt -> MixedRowCtxt -> Bool
$c/= :: MixedRowCtxt -> MixedRowCtxt -> Bool
== :: MixedRowCtxt -> MixedRowCtxt -> Bool
$c== :: MixedRowCtxt -> MixedRowCtxt -> Bool
Eq, forall x. Rep MixedRowCtxt x -> MixedRowCtxt
forall x. MixedRowCtxt -> Rep MixedRowCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MixedRowCtxt x -> MixedRowCtxt
$cfrom :: forall x. MixedRowCtxt -> Rep MixedRowCtxt x
Generic, Int -> MixedRowCtxt -> ShowS
[MixedRowCtxt] -> ShowS
MixedRowCtxt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MixedRowCtxt] -> ShowS
$cshowList :: [MixedRowCtxt] -> ShowS
show :: MixedRowCtxt -> String
$cshow :: MixedRowCtxt -> String
showsPrec :: Int -> MixedRowCtxt -> ShowS
$cshowsPrec :: Int -> MixedRowCtxt -> ShowS
Show)

-- | Mixed column context
newtype MixedColCtxt = MColC { MixedColCtxt -> Index
index :: Index } deriving (MixedColCtxt -> MixedColCtxt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MixedColCtxt -> MixedColCtxt -> Bool
$c/= :: MixedColCtxt -> MixedColCtxt -> Bool
== :: MixedColCtxt -> MixedColCtxt -> Bool
$c== :: MixedColCtxt -> MixedColCtxt -> Bool
Eq, forall x. Rep MixedColCtxt x -> MixedColCtxt
forall x. MixedColCtxt -> Rep MixedColCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MixedColCtxt x -> MixedColCtxt
$cfrom :: forall x. MixedColCtxt -> Rep MixedColCtxt x
Generic, Int -> MixedColCtxt -> ShowS
[MixedColCtxt] -> ShowS
MixedColCtxt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MixedColCtxt] -> ShowS
$cshowList :: [MixedColCtxt] -> ShowS
show :: MixedColCtxt -> String
$cshow :: MixedColCtxt -> String
showsPrec :: Int -> MixedColCtxt -> ShowS
$cshowsPrec :: Int -> MixedColCtxt -> ShowS
Show)

-- | Context for mixed columns
data MixedCtxt = MxdCtxt {
  MixedCtxt -> MixedRowCtxt
row :: MixedRowCtxt
, MixedCtxt -> MixedColCtxt
col :: MixedColCtxt
} deriving (MixedCtxt -> MixedCtxt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MixedCtxt -> MixedCtxt -> Bool
$c/= :: MixedCtxt -> MixedCtxt -> Bool
== :: MixedCtxt -> MixedCtxt -> Bool
$c== :: MixedCtxt -> MixedCtxt -> Bool
Eq, forall x. Rep MixedCtxt x -> MixedCtxt
forall x. MixedCtxt -> Rep MixedCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MixedCtxt x -> MixedCtxt
$cfrom :: forall x. MixedCtxt -> Rep MixedCtxt x
Generic, Int -> MixedCtxt -> ShowS
[MixedCtxt] -> ShowS
MixedCtxt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MixedCtxt] -> ShowS
$cshowList :: [MixedCtxt] -> ShowS
show :: MixedCtxt -> String
$cshow :: MixedCtxt -> String
showsPrec :: Int -> MixedCtxt -> ShowS
$cshowsPrec :: Int -> MixedCtxt -> ShowS
Show)

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

-- | * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
data MixedTabularList n e w = MixedTabularList {
  forall n e w. MixedTabularList n e w -> GenericList n Seq e
list :: L.GenericList n Seq e -- ^ The underlying list that comes from brick
, forall n e w. MixedTabularList n e w -> WidthsPerRowKind e w
widthsPerRowKind :: WidthsPerRowKind e w
, forall n e w. MixedTabularList n e w -> WidthsPerRow e w
widthsPerRow :: WidthsPerRow e w
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e w x.
Rep (MixedTabularList n e w) x -> MixedTabularList n e w
forall n e w x.
MixedTabularList n e w -> Rep (MixedTabularList n e w) x
$cto :: forall n e w x.
Rep (MixedTabularList n e w) x -> MixedTabularList n e w
$cfrom :: forall n e w x.
MixedTabularList n e w -> Rep (MixedTabularList n e w) x
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 :: forall n e w.
n
-> Seq e
-> ListItemHeight
-> WidthsPerRowKind e w
-> WidthsPerRow e w
-> MixedTabularList n e w
mixedTabularList n
n Seq e
rows (LstItmH Int
h) WidthsPerRowKind e w
wprk WidthsPerRow e w
wpr = MixedTabularList {
  $sel:list:MixedTabularList :: GenericList n Seq e
list = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list n
n Seq e
rows Int
h
, $sel:widthsPerRowKind:MixedTabularList :: WidthsPerRowKind e w
widthsPerRowKind = WidthsPerRowKind e w
wprk
, $sel:widthsPerRow:MixedTabularList :: WidthsPerRow e w
widthsPerRow = WidthsPerRow e w
wpr
}

-- | Render mixed tabular list.
renderMixedTabularList :: (Show n, Ord n)
  => MixedRenderers n e w -- ^ Renderers
  -> ListFocused
  -> MixedTabularList n e w -- ^ The list
  -> Widget n
renderMixedTabularList :: forall n e w.
(Show n, Ord n) =>
MixedRenderers n e w
-> ListFocused -> MixedTabularList n e w -> Widget n
renderMixedTabularList MixedRenderers n e w
r (LstFcs Bool
f) MixedTabularList n e w
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 aW :: Int
aW = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) Int
availWidthL
      aH :: Int
aH = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) Int
availHeightL
      cell :: ListFocused -> MixedCtxt -> e -> Widget n
cell = MixedRenderers n e w
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "cell" a => a
#cell
      MixedTabularList {$sel:list:MixedTabularList :: forall n e w. MixedTabularList n e w -> GenericList n Seq e
list=GenericList n Seq e
l', $sel:widthsPerRowKind:MixedTabularList :: forall n e w. MixedTabularList n e w -> WidthsPerRowKind e w
widthsPerRowKind=WsPerRK AvailWidth -> [e] -> w
wprk', $sel:widthsPerRow:MixedTabularList :: forall n e w. MixedTabularList n e w -> WidthsPerRow e w
widthsPerRow=WsPerR w -> e -> [ColWidth]
wpr} = MixedTabularList n e w
l
      iH :: Int
iH = GenericList n Seq e
l' forall {s} {a}. s -> Getting a s a -> a
^^. forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
L.listItemHeightL
      colHdrRow :: w -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow w
wprk (RowHdrW Int
rhw) (WdthD Int
rhwd) = case MixedRenderers n e w
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "colHdr" a => a
#colHdr of
        Maybe (MixedColHdr n w)
Nothing -> forall n. Widget n
emptyWidget
        Just (MixedColHdr {ListFocused -> MixedColCtxt -> Widget n
draw :: ListFocused -> MixedColCtxt -> Widget n
$sel:draw:MixedColHdr :: forall n w.
MixedColHdr n w -> ListFocused -> MixedColCtxt -> Widget n
draw, w -> [ColWidth]
widths :: w -> [ColWidth]
$sel:widths:MixedColHdr :: forall n w. MixedColHdr n w -> w -> [ColWidth]
widths, $sel:height:MixedColHdr :: forall n w. MixedColHdr n w -> ColHdrHeight
height=ColHdrH Int
chh}) -> let
          col :: Index -> ColWidth -> Widget n
col Index
ci (ColW Int
w) = forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
w, Int
chh) forall a b. (a -> b) -> a -> b
$ ListFocused -> MixedColCtxt -> Widget n
draw (Bool -> ListFocused
LstFcs Bool
f) (Index -> MixedColCtxt
MColC Index
ci)
          chrh :: Widget n
chrh = case MixedRenderers n e w
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "colHdrRowHdr" a => a
#colHdrRowHdr of
            Maybe (ColHdrRowHdr n)
Nothing -> forall n. Char -> Widget n
fill Char
' '
            Just (ColHdrRowHdr ListFocused -> WidthDeficit -> Widget n
chrh) -> ListFocused -> WidthDeficit -> Widget n
chrh (Bool -> ListFocused
LstFcs Bool
f) (Int -> WidthDeficit
WdthD Int
rhwd)
          in forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
rhw, Int
chh) Widget n
chrh 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 Index -> ColWidth -> Widget n
col [Int -> Index
Ix Int
0..] forall a b. (a -> b) -> a -> b
$ w -> [ColWidth]
widths w
wprk)
      row :: w -> Int -> Bool -> e -> Widget n
row w
wprk Int
i Bool
f e
r = let
        col :: Index -> ColWidth -> Widget n
col Index
ci (ColW Int
w) = forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
w, Int
iH) forall a b. (a -> b) -> a -> b
$ ListFocused -> MixedCtxt -> e -> Widget n
cell (Bool -> ListFocused
LstFcs Bool
f) (MixedRowCtxt -> MixedColCtxt -> MixedCtxt
MxdCtxt (Index -> Selected -> MixedRowCtxt
MRowC (Int -> Index
Ix Int
i) (Bool -> Selected
Sel Bool
f)) forall a b. (a -> b) -> a -> b
$ Index -> MixedColCtxt
MColC Index
ci) e
r
        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 Index -> ColWidth -> Widget n
col [Int -> Index
Ix Int
0..] forall a b. (a -> b) -> a -> b
$ w -> e -> [ColWidth]
wpr w
wprk e
r
      lst :: RenderM n (Result n)
lst = let wprk :: w
wprk = AvailWidth -> [e] -> w
wprk' (Int -> AvailWidth
AvlW Int
aW) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall n e. GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx GenericList n Seq e
l' (Int -> AvailHeight
AvlH Int
aH)
        in forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ w -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow w
wprk (Int -> RowHdrWidth
RowHdrW Int
0) (Int -> WidthDeficit
WdthD Int
0) forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex (w -> Int -> Bool -> e -> Widget n
row w
wprk) Bool
f GenericList n Seq e
l'
      hdrLst :: RowHdr n e -> RenderM n (Result n)
hdrLst (RowHdr {$sel:draw:RowHdr :: ()
draw=ListFocused -> WidthDeficit -> RowHdrCtxt -> r -> Widget n
drw, AvailWidth -> [r] -> RowHdrWidth
$sel:width:RowHdr :: ()
width :: AvailWidth -> [r] -> RowHdrWidth
width, $sel:toRH:RowHdr :: ()
toRH=e -> Index -> r
tR}) = let
        ([e]
es, [Index]
is) = forall n e. GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx GenericList n Seq e
l' (Int -> AvailHeight
AvlH Int
aH)
        RowHdrW Int
rhw' = AvailWidth -> [r] -> RowHdrWidth
width (Int -> AvailWidth
AvlW Int
aW) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith e -> Index -> r
tR [e]
es [Index]
is
        rhw :: Int
rhw = forall a. Ord a => a -> a -> a
min Int
rhw' Int
aW
        rhwd :: WidthDeficit
rhwd = Int -> WidthDeficit
WdthD forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
rhw' forall a. Num a => a -> a -> a
- Int
aW
        wprk :: w
wprk = AvailWidth -> [e] -> w
wprk' (Int -> AvailWidth
AvlW forall a b. (a -> b) -> a -> b
$ Int
aW forall a. Num a => a -> a -> a
- Int
rhw) [e]
es
        hdrRow :: Int -> Bool -> e -> Widget n
hdrRow Int
i Bool
f e
r = forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
rhw, Int
iH) (ListFocused -> WidthDeficit -> RowHdrCtxt -> r -> Widget n
drw (Bool -> ListFocused
LstFcs Bool
f) WidthDeficit
rhwd (Selected -> RowHdrCtxt
RowHdrCtxt forall a b. (a -> b) -> a -> b
$ Bool -> Selected
Sel Bool
f) forall a b. (a -> b) -> a -> b
$ e -> Index -> r
tR e
r (Int -> Index
Ix Int
i)) forall n. Widget n -> Widget n -> Widget n
<+> w -> Int -> Bool -> e -> Widget n
row w
wprk Int
i Bool
f e
r
        in forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ w -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow w
wprk (Int -> RowHdrWidth
RowHdrW Int
rhw) WidthDeficit
rhwd forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex Int -> Bool -> e -> Widget n
hdrRow Bool
f GenericList n Seq e
l'
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe RenderM n (Result n)
lst RowHdr n e -> RenderM n (Result n)
hdrLst forall a b. (a -> b) -> a -> b
$ MixedRenderers n e w
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rowHdr" a => a
#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 :: forall n e w.
Ord n =>
Event -> EventM n (MixedTabularList n e w) ()
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 e w) ()
handleMixedListEventVi :: forall n e w.
Ord n =>
Event -> EventM n (MixedTabularList n e w) ()
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)