brick-panes-1.0.0.3: src/Brick/Panes.hs
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-| This package provides an overlay library for Brick that allows
individual TUI screen areas to be independently developed and then easily
composed into the overall application.
This is done by representing each 'Pane' via a class that describes the common
types and methods for that 'Pane', as well as the internal state of the 'Pane'.
The full 'Pane' class is shown here in brief (more extensive documentation is
available below):
> class Pane n appEv pane | pane -> n where
> data PaneState pane appEv
>
> type InitConstraints pane initctxt :: Constraint
> initPaneState :: (InitConstraints pane i) => i -> PaneState pane appEv
>
> type DrawConstraints pane drwctxt n :: Constraint
> drawPane :: (DrawConstraints pane drawcontext n, Eq n)
> => PaneState pane appEv -> drawcontext -> Maybe (Widget n)
>
> type EventConstraints pane evctxt :: Constraint
> type EventType pane n appEv
> focusable :: (EventConstraints pane eventcontext, Eq n)
> => eventcontext -> PaneState pane appEv -> Seq.Seq n
> focusable _ _ = mempty
> handlePaneEvent :: (EventConstraints pane eventcontext, Eq n)
> => eventcontext
> -> EventType pane n appEv
> -> PaneState pane appEv
> -> EventM n es (PaneState pane appEv)
> handlePaneEvent _ _ = return
>
> type UpdateType pane
> updatePane :: UpdateType pane
> -> PaneState pane appEv
> -> PaneState pane appEv
Each 'Pane' can be added to an overall 'Panel', where the 'Panel' provides
appropriate focus management and consolidates event and draw dispatching to the
(appropriate) panes. The 'Panel' can support modal panes which grab focus (and
are not visible when not active and focused), panes which participate in a
normal focus ring, and panes which are never focused. The 'Panel' is
represented by a recursive data structure that is initialized by calling the
'basePanel' function with the global application state and passing that result
to the 'addToPanel' function for each 'Pane' that should be added to the
'Panel'.
-}
module Brick.Panes
(
-- * Pane Specification
-- ** Definition and Initialization
Pane
, PaneState
, InitConstraints
, initPaneState
-- ** Drawing
, DrawConstraints
, drawPane
-- ** Event Handling
, EventConstraints
, EventType
, DispatchEvent
, focusable
, handlePaneEvent
-- ** Updating the Pane's state
, UpdateType
, updatePane
-- ** Focus management helpers and constraints
, focus1If
, HasFocus
, getFocus
, Focused(Focused)
, focused
-- * Panel Specification
-- ** Definition and Initialization
, Panel
, basePanel
, addToPanel
, PaneFocus( Always, Never, WhenFocused, WhenFocusedModal
, WhenFocusedModalHandlingAllEvents
)
-- ** Pane and base state access
, onPane
, onBaseState
-- ** Drawing
, panelDraw
-- ** Focus and Event management
, handleFocusAndPanelEvents
, focusRingUpdate
, isPanelModal
, enteredModal
, exitedModal
, PanelMode(Normal, Modal)
, PanelTransition
-- ** Access and operations
, PanelOps(..)
, PaneNumber
)
where
import Control.Applicative ( (<|>) )
import qualified Data.Foldable as F
import Data.Kind ( Constraint, Type )
import qualified Data.List as L
import Data.Maybe ( fromMaybe )
import Data.Sequence ( Seq, (><) )
import qualified Data.Sequence as Seq
import Data.Type.Equality
import Data.Void ( Void, absurd )
import GHC.TypeLits
import qualified Graphics.Vty as Vty
import Lens.Micro
#if !MIN_VERSION_base(4,16,0)
-- starting in base 4.16.0.0, GHC.TypeLits exports Natural
import Numeric.Natural ( Natural )
#endif
import Brick
import Brick.Focus
-- | Class to manage each pane in the Brick TUI.
--
-- Type parameters:
--
-- * @pane@ = Pane Type, uniquely identifying this pane
-- * @appEv@ = The application's event type
-- * @n@ = Widget type parameter
--
-- The 'PaneState' specifies the state that should be stored globally
-- and which provides the primary information for handling this pane
-- (for both draw and event handling operations).
--
-- The 'initPaneState' method is responsible for returning an initial 'PaneState'
-- value (at startup).
--
-- The 'drawPane' method is called to render the pane into a 'Widget' (or Nothing
-- if this Pane should not currently be drawn). It is passed the 'PaneState' and
-- also a drawing parameter. The 'DrawConstraints' can be used to specify
-- additional instance requirements for the drawing parameter. The global
-- application state is often passed as this drawing parameter, but the
-- 'drawPane' method should only perform 'DrawConstraints' operations, along with
-- general Brick drawing operations.
--
-- The 'focusable' method should return the names of the widgets that can be the
-- target of the 'FocusRing' in the current state. This should always return an
-- empty list if the 'drawPane' returns 'Nothing'.
--
-- The 'handlePaneEvent' method is called to handle an event that has occurred
-- within this Pane. It should return the updated 'PaneState' in the context of
-- an 'EventM' monadic operation.
--
-- The 'updatePane' method is called with the 'UpdateType' to perform any
-- updating of the 'PaneState' from the update type data.
class Pane n appEv pane | pane -> n where
-- | State information associated with this pane
data PaneState pane appEv
-- | Type of data provided to updatePane.
--
-- The default is @()@, indicating that this Pane does not receive any external
-- data during an update (which usually indicates that the Pane does not update
-- once created).
type UpdateType pane
-- | Constraints on argument passed to 'initPaneState'. If there are no
-- constraints, this may be specified as @()@, or simply omitted because @()@
-- is the default.
type InitConstraints pane initctxt :: Constraint
-- | Function called to initialize the internal 'PaneState'
initPaneState :: (InitConstraints pane i) => i -> PaneState pane appEv
-- | Constraints on the @drawcontext@ parameter passed to 'drawPane'. This is
-- usually used when the Pane must establish class constraints on the
-- @drawcontext@ that it is passed, since this class definition is fully
-- polymorphic. The default is @()@ which indicate there are no constraints on
-- the Pane's 'draw' function (meaning the Pane can be fully drawn using only
-- the internal 'PaneState').
type DrawConstraints pane drwctxt n :: Constraint
-- | Function called to draw the 'Pane' as a Brick 'Widget', or 'Nothing' if
-- this 'Pane' should not be drawn at the current time.
drawPane :: (DrawConstraints pane drawcontext n, Eq n)
=> PaneState pane appEv -> drawcontext -> Maybe (Widget n)
-- | The constraints that should exist on the 'eventcontext' argment passed to
-- 'focusable' and 'handlePaneEvent'. This is usually used when the Pane must
-- establish class constraints on the @eventcontext@, since this class
-- definition is fully polymorphic. The default is @()@ which indicate there
-- are no constraints on the Pane's 'focusable' and 'handlePaneEvent' functions
-- (meaning the Pane can be fully drawn using only the internal 'PaneState').
type EventConstraints pane evctxt :: Constraint
-- | The type of the event argument delivered to 'handlePaneEvent'. This
-- should either be 'Vty.Event' or 'BrickEvent', depending on what level of
-- granularity the 'handlePaneEvent' operates at.
type EventType pane n appEv
-- | The 'focusable' method is called to determine which Widget targets should
-- be part of the Brick 'FocusRing'.
--
-- The default is @mempty@, which indicates that no part of this Pane is ever
-- focusable.
focusable :: (EventConstraints pane eventcontext, Eq n)
=> eventcontext -> PaneState pane appEv -> Seq.Seq n
-- | Called to handle an 'EventType' event for the 'Pane'. This is typically
-- only called when (one of the 'focusable' targets of) the 'Pane' is the focus
-- of the 'FocusRing'. It should modify the internal 'PaneState' as
-- appropriate and make any appropriate changes to properly render the 'Pane'
-- on the next 'drawPane' call.
--
-- Note that this function also receives an eventcontext which it may stipulate
-- constraints on. Those constraints should be *read-only* constraints. This
-- is especially important when the pane is used as part of a panel: the Panel
-- itself is passed as the eventcontext, but the panel may not be modified
-- because the panel event dispatching will discard any changes on completion.
--
-- The default is to return the pane state unmodified, indicating that this
-- Pane never responds to any events.
handlePaneEvent :: (EventConstraints pane eventcontext, Eq n)
=> eventcontext
-> EventType pane n appEv
-> PaneState pane appEv
-> EventM n es (PaneState pane appEv)
-- | Function called to update the internal 'PaneState', using the passed
-- 'updateType' argument.
--
-- The default is to return the pane state unmodified, indicating that this
-- Pane cannot have its internal state changed after creation.
updatePane :: UpdateType pane
-> PaneState pane appEv
-> PaneState pane appEv
-- A set of defaults that allows a minimal instance specification
type UpdateType pane = ()
type InitConstraints pane initctxt = ()
type DrawConstraints pane drwctxt n = ()
type EventConstraints pane evctxt = ()
type EventType pane n appev = Vty.Event -- by default, handle Vty events
focusable _ _ = mempty
handlePaneEvent _ _ = return
updatePane _ = id
-- | This is a helper function for a Pane with a single Widget name and a
-- conditional focus. For example, if a widget is always focusable, then it can
-- specify:
--
-- > instance Pane N E ThisPane () where
-- > ...
-- > focusable _ = const $ focus1If MyWidgetName True
focus1If :: n -> Bool -> Seq.Seq n
focus1If n b = if b then Seq.singleton n else mempty
-- | This class allows retrieval of the current focused Widget (if any). This
-- class is frequently specified as one of the constraints for the
-- 'DrawConstraints' or 'EventConstraints' of a 'Pane'.
class HasFocus b n | b -> n where
-- | Provides a lens from the primary type to the 'Focused' type, which
-- specifies the current focused element (if any).
getFocus :: Lens' b (Focused n)
-- By default, nothing has Focus
getFocus f x = const x <$> f (Focused Nothing)
-- | This is a newtype to wrap the identification of the current focused element
-- (if any).
newtype Focused n = Focused { focused :: Maybe n
-- ^ The current focused element or 'Nothing'.
}
-- | The 'DispatchEvent' class is used to determine which type of event to
-- dispatch to a 'Pane' by selecting on the @'EventType' pane n@. This is used
-- internally in the brick-panes implementation and client code does not need to
-- explicitly specify instances of this class.
class DispatchEvent n appev pane evtype where
dispEv :: ( Pane n appev pane
, EventConstraints pane base
, Eq n
)
=> EventType pane n appev :~: evtype
-> base -> BrickEvent n appev -> PaneState pane appev
-> EventM n es (PaneState pane appev)
instance DispatchEvent n appev pane (BrickEvent n appev) where
dispEv Refl base ev s = handlePaneEvent base ev s
instance DispatchEvent n appev pane Vty.Event where
dispEv Refl base ev s = case ev of
VtyEvent vev -> handlePaneEvent base vev s
_ -> return s
----------------------------------------------------------------------
-- A Panel is a composite of a number of panes
-- | A Panel is a recursive data sequence of individual 'Pane' elements
-- with a core state. The core state represents the base state of the
-- Brick application, independent of the various Pane data. Each 'Pane'
-- has an instance that defines its 'PaneState', which is associated
-- here with a potential Widget name (allowing selected actions; see
-- 'handleFocusAndPanelEvents').
--
-- The 'Panel' type closes over the 'state' type argument, which is used for all
-- three of the 'Pane' constraints ('DrawConstraints', 'EventConstraints', and
-- indirectly the 'InitConstraints'), which means that the same 'state' type must
-- be passed to all three associated Pane methods; a 'Pane' used outside of the
-- 'Panel' container is not constrained in this manner and each method could have
-- a different argument. For the Panel, the 'state' is typically the Panel
-- "beneath" the current Pane, which is the aggregate of the base state and all
-- Panes added before the current pane.
data Panel n appev state (panes :: [Type]) where
Panel :: state -> Panel n appev state '[]
PanelWith :: ( Pane n appev pane
, DrawConstraints pane (Panel n appev state panes) n
, EventConstraints pane (Panel n appev state panes)
, DispatchEvent n appev pane (EventType pane n appev)
)
=> PaneState pane appev -> PaneFocus n
-> Panel n appev state panes -> Panel n appev state (pane ': panes)
-- | This is the base constructor for Panel that is given the core
-- application state.
basePanel :: state -> Panel n appev state '[]
basePanel = Panel
-- | Each 'Pane' that is part of the 'Panel' should be added to the 'Panel' via
-- this function, which also specifies when the `Pane` should receive Events.
addToPanel :: Pane n appev pane
=> InitConstraints pane (Panel n appev state panes)
=> DrawConstraints pane (Panel n appev state panes) n
=> EventConstraints pane (Panel n appev state panes)
=> DispatchEvent n appev pane (EventType pane n appev)
=> PaneFocus n
-> Panel n appev state panes
-> Panel n appev state (pane ': panes)
addToPanel n pnl = PanelWith (initPaneState pnl) n pnl
-- | Specifies when a Pane should receive events.
data PaneFocus n =
-- | Indicates that this Pane always receives all events, although it is never
-- part of a focus ring. This should be used for Widgets that have a global
-- event handling.
Always
-- | Indicates that this Pane's handlePaneEvent is never called
| Never
-- | Indicates that the pane should receive events when the current focus is
-- equal to a 'focusable' return from the Pane.
| WhenFocused
-- | Indicates that the pane should receive events when the current focus is
-- equal to a 'focusable' return from the Pane, and that this should block
-- all non-modal focus candidates (it is expected that there is only one
-- modal, but this is not required).
| WhenFocusedModal
| WhenFocusedModal' (FocusRing n) -- previous focus ring to return to
-- | Indicates that the pane should receive events when the current focus is
-- equal to a 'focusable' return from the Pane, and that this should block all
-- non-modal focus candidates, just as with 'WhenFocusedModal'. However, this
-- also sends *all* events to the modal Pane instead of the normal 'Panel'
-- handling of events (e.g. @TAB@/@Shift-TAB@).
| WhenFocusedModalHandlingAllEvents
| WhenFocusedModalHandlingAllEvents' (FocusRing n) -- previous focus ring
-- | If the base state provides Focus information, then the Panel can provide
-- focus information.
instance HasFocus appState n => HasFocus (Panel n appEv appState panes) n where
getFocus = onBaseState . getFocus
-- | This is a lens providing access to the base application state at
-- the core of the Panel.
onBaseState :: Lens' (Panel n appev state panes) state
onBaseState f (Panel s) = Panel <$> f s
onBaseState f (PanelWith p n i) = PanelWith p n <$> onBaseState f i
-- | This is a lens providing access to the PaneState for a specific Pane in the
-- Panel. The Pane is typically specified via a type application
-- (e.g. @@MyPane@).
onPane :: forall pane n appev state panes .
PanelOps pane n appev panes state
=> Lens' (Panel n appev state panes) (PaneState pane appev)
onPane = lens (panelState @pane) (panelStateUpdate @pane)
-- -- | This can be used to get the inner Pane from the current Pane in the state.
-- onNextPane :: Lens' (Panel n appev state (pane ': panes)) (Panel n appev state panes)
-- onNextPane f = \case
-- PanelWith a b r -> (\r' -> PanelWith a b r') <$> f r
-- | This class defines the various operations that can be performed
-- on a Panel. Most of these operations specify a particular Pane as
-- the target of the operation; the operation is performed on that
-- pane and the Panel is is updated with the result.
--
-- The user of this library will not need to develop new instances of this class:
-- the instances defined internally are sufficient. Users may need to specify
-- 'PanelOps' constraints on various functions.
class PanelOps pane n appev panes s | pane -> n where
-- | This is called to pass the VTY Event to the specified Pane's
-- handler with a Panel.
handlePanelEvent :: (EventConstraints pane s, Eq n)
=> s -> pane -> Panel n appev s panes -> BrickEvent n appev
-> EventM n es (Panel n appev s panes)
-- | This is used to obtain the state of a specific Pane within the Panel. The
-- pane is usually specified by a type application (e.g. @@MyPane@).
panelState :: Panel n appev s panes -> PaneState pane appev
-- | This is used to update the state of a specific Pane within the Panel. The
-- pane is usually specified by a type application (e.g. @@MyPane@).
panelStateUpdate :: Panel n appev s panes -> PaneState pane appev
-> Panel n appev s panes
-- | This returns an ordinal index of the pane within the panel.
paneNumber :: Panel n appev s panes -> PaneNumber
instance (Pane n appev pane) => PanelOps pane n appev (pane ': panes) s where
handlePanelEvent s _p (PanelWith pd n r) ev =
(\pd' -> PanelWith pd' n r) <$> dispEv Refl s ev pd
panelState (PanelWith pd _ _) = pd
panelStateUpdate (PanelWith _pd n r) = \pd' -> PanelWith pd' n r
paneNumber _ = PaneNo 0
instance {-# OVERLAPPABLE #-} (PanelOps pane n appev panes s) =>
PanelOps pane n appev (o ': panes) s where
handlePanelEvent s p (PanelWith pd n r) ev =
PanelWith pd n <$> handlePanelEvent s p r ev
panelState (PanelWith _ _ r) = panelState r
panelStateUpdate (PanelWith pd n r) =
\pd' -> PanelWith pd n $ panelStateUpdate r pd'
paneNumber (PanelWith _ _ r) = succ $ paneNumber @pane r
instance ( TypeError
('Text "No " ':<>: 'ShowType pane ':<>: 'Text " in Panel"
':$$: 'Text "Add this pane to your Panel (or move it lower)"
':$$: 'Text "(Possibly driven by DrawConstraints)"
)
, Pane n appev pane
)
=> PanelOps pane n appev '[] s where
handlePanelEvent = absurd (undefined :: Void)
panelState = absurd (undefined :: Void)
panelStateUpdate = absurd (undefined :: Void)
paneNumber = absurd (undefined :: Void)
-- | Called to draw a specific pane in the panel. Typically invoked from the
-- applications' global drawing function.
panelDraw :: forall pane n appev s panes .
( DrawConstraints pane (Panel n appev s panes) n
, PanelOps pane n appev panes s
, Pane n appev pane
, Eq n
)
=> Panel n appev s panes -> Maybe (Widget n)
panelDraw panel = drawPane (panelState @pane panel) panel
-- | Called to dispatch an events to the focused Pane in the Panel as determined
-- by matching the Widget names returned by the Pane's 'focusable' with the
-- current FocusRing focus target.
handlePanelEvents :: Eq n
=> Panel n appev s panes
-> BrickEvent n appev
-> Focused n
-> EventM n es (Panel n appev s panes)
handlePanelEvents panel ev (Focused focus) =
-- n.b. no need to check focusable for a pane because an invisible
-- pane should never have focus
case focus of
Nothing -> return panel
Just fcs -> go fcs panel ev
where
go :: Eq n
=> n -> Panel n appev s panes -> BrickEvent n appev
-> EventM n es (Panel n appev s panes)
go _ p@(Panel {}) _ = return p
go fcs (PanelWith pd pf r) evnt =
let handleIt = dispEv Refl r evnt pd
skipIt = return pd
in do pd' <- case pf of
Never -> skipIt
Always -> handleIt
WhenFocused -> if fcs `elem` focusable r pd
then handleIt
else skipIt
WhenFocusedModal -> if fcs `elem` focusable r pd
then handleIt
else skipIt
WhenFocusedModal' _ -> if fcs `elem` focusable r pd
then handleIt
else skipIt
WhenFocusedModalHandlingAllEvents ->
if fcs `elem` focusable r pd
then handleIt
else skipIt
WhenFocusedModalHandlingAllEvents' _ ->
if fcs `elem` focusable r pd
then handleIt
else skipIt
PanelWith pd' pf <$> go fcs r evnt
-- | Called to handle events for the entire 'Panel', including focus-changing
-- events. The current focused 'Pane' is determined and that Pane's handler is
-- called (based on the 'Widget' names returned as 'focusable' for that Pane).
-- If a Pane has no associated Widget name (the 'PaneFocus' value is specified as
-- 'Nothing' when adding the Pane to the Panel) then its handler is never called.
--
-- This function returns the updated Panel state, as well as an indication of
-- whether a modal transition occured while handling the event.
--
-- This function manages updating the focus when @Tab@ or @Shift-Tab@ is
-- selected, except when the currently focused pane was created with the
-- 'WhenFocusedModalHandlingAllEvents', in which case all events are passed
-- through to the Pane.
handleFocusAndPanelEvents :: Eq n => Ord n
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes
-> BrickEvent n appev
-> EventM n es (PanelTransition, Panel n appev s panes)
handleFocusAndPanelEvents focusL panel =
let fcs = focusGetCurrent (panel ^. focusL)
doPanelEvHandling = case fcs of
Nothing -> True
Just curFcs -> chkEv curFcs panel
in \case
VtyEvent (Vty.EvKey (Vty.KChar '\t') []) | doPanelEvHandling ->
return (Nothing, panel & focusL %~ focusNext)
VtyEvent (Vty.EvKey Vty.KBackTab []) | doPanelEvHandling ->
return (Nothing, panel & focusL %~ focusPrev)
panelEv -> do
u <- focusRingUpdate focusL <$> handlePanelEvents panel panelEv (Focused fcs)
let fcs' = focusGetCurrent (u ^. focusL)
if fcs == fcs'
then return (Nothing, u)
else let m0 = panelMode focusL panel
m1 = panelMode focusL u
in return $ if m0 == m1
then (Nothing, u)
else (Just (m0, m1), u)
where
chkEv :: Eq n => n -> Panel n appev s panes -> Bool
chkEv curFcs = \case
Panel {} -> True
PanelWith pd WhenFocusedModalHandlingAllEvents r ->
(not $ curFcs `elem` focusable r pd) && chkEv curFcs r
PanelWith pd (WhenFocusedModalHandlingAllEvents' _) r ->
(not $ curFcs `elem` focusable r pd) && chkEv curFcs r
PanelWith _ _ r -> chkEv curFcs r
panelMode :: Eq n
=> Ord n
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes -> PanelMode
panelMode focusL panel =
modalTgt (L.sort $ focusRingToList (panel ^. focusL)) panel
-- Note that the focusL-retrieved focus rings (m0, at least)
-- come from the live previous pane set and may not match the
-- order of the widget set. Oddly, it doesn't match a rotation
-- of the original either, ergo the sorting.
where
modalTgt :: Eq n
=> Ord n
=> [n] -> Panel n appev s panes -> PanelMode
modalTgt fcsRing = \case
Panel {} -> Normal
PanelWith pd WhenFocusedModal r ->
matchOrRecurse fcsRing r $ focusable r pd
PanelWith pd (WhenFocusedModal' _) r ->
matchOrRecurse fcsRing r $ focusable r pd
PanelWith pd WhenFocusedModalHandlingAllEvents r ->
matchOrRecurse fcsRing r $ focusable r pd
PanelWith pd (WhenFocusedModalHandlingAllEvents' _) r ->
matchOrRecurse fcsRing r $ focusable r pd
PanelWith _ _ r -> case modalTgt fcsRing r of
Normal -> Normal
Modal p -> Modal $ succ p
matchOrRecurse :: Eq n => Ord n
=> [n] -> Panel n appev s pnlpanes -> Seq.Seq n -> PanelMode
matchOrRecurse fcsRing r f =
-- if fcsRing `elem` rotations (F.toList f)
if fcsRing == L.sort (F.toList f)
then Modal (PaneNo 0)
else case modalTgt fcsRing r of
Normal -> Normal
Modal p -> Modal $ succ p
-- | This function can be called at any time to determine if the Panel is
-- currently displaying a Modal Pane. This needs the Panel object and a lens
-- that can be used to extract the FocusRing from the Panel.
isPanelModal :: Eq n
=> Ord n
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes
-> Bool
isPanelModal focusL panel = Normal /= panelMode focusL panel
-- | Indicates the current mode of the Panel. If Modal, the currently active
-- modal Panel is identified by the PaneNumber, which matches the return value of
-- the 'paneNumber' of PanelOps; in general, the use of 'isPaneModal' is
-- recommended over attempting to determine _which_ actual modal pane is active.
data PanelMode = Normal | Modal PaneNumber deriving (Eq)
-- | Internal bookkeeping to identify a particular Pane within a Panel by number.
newtype PaneNumber = PaneNo Natural deriving (Eq, Enum)
-- | This is returned from the 'handleFocusAndPanelEvents' function to indicate
-- whether a modal transition occured during the panel's (and associated Pane's)
-- handling of this event. This can be used by the outer-level application code
-- to determine if a modal Pane was entered or exited due to the Event.
type PanelTransition = Maybe (PanelMode, PanelMode)
-- | Indicates if the specified Pane (via Type Application) is the one that was
-- modally entered as a result of processing an event (as indicated by
-- PanelTransition).
enteredModal :: forall pane n appev state panes
. PanelOps pane n appev panes state
=> PanelTransition -> Panel n appev state panes -> Bool
-- n.b. assumes the Panel passed here is the same panel passed to
-- handleFocusAndPanelEvents for which the PanelTransition was
-- obtained
enteredModal = \case
Just (_, Modal pnum) -> (pnum ==) . paneNumber @pane
_ -> const False
-- | Indicates if the specified Pane (via Type Application) is the one that was
-- modally exited (dismissed) as a result of processing an event (as indicated by
-- PanelTransition).
exitedModal :: forall pane n appev state panes
. PanelOps pane n appev panes state
=> PanelTransition -> Panel n appev state panes -> Bool
-- n.b. assumes the Panel passed here is the same panel passed to
-- handleFocusAndPanelEvents for which the PanelTransition was
-- obtained
exitedModal = \case
Just (Modal pnum, _) -> (pnum ==) . paneNumber @pane
_ -> const False
-- | When the Panel is managing focus events (e.g. when using
-- 'handleFocusAndPanelEvents'), this function can be called if there
-- has been a situation where the members of the focus ring might need
-- to be updated. This is automatically called at the end of the
-- 'handleFocusAndPanelEvents', but it should be explicitly called
-- once when the Panel is initialized, and it can additionally be
-- called whenever needed in a situation where the
-- 'handleFocusAndPanelEvents' invocation is insufficient (e.g. a
-- separate global action enables a modal pane).
focusRingUpdate :: (Eq n, Ord n)
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes -> Panel n appev s panes
focusRingUpdate focusL panel = let (p', r) = focusableNames focusL panel
in p' & focusL %~ updRing r
where
updRing :: Eq n => [n] -> FocusRing n -> FocusRing n
updRing nl fcs =
case nl of
[] -> focusRing []
(n : _) ->
case focusGetCurrent fcs of
Nothing ->
-- no current focus, just use new list
focusSetCurrent n $ focusRing nl
Just e ->
case L.find ((e ==) . head) $ rotations nl of
Just r ->
focusRing r -- new ring with current element still focused
Nothing ->
-- new focus ring doesn't include current focused
-- element, so just use the new list.
focusSetCurrent n $ focusRing nl
-- | This returns the focusable Widget names for the focus ring, in the 'Ord'
-- order. It also returns an updated panel, which internally records the input
-- focus ring if a modal is selected). If the previous focus was a modal and the
-- new focus is not modal, this will return that previous focus ring rather than
-- the computed focus ring.
focusableNames :: (Eq n, Ord n)
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes -> (Panel n appev s panes, [n])
focusableNames focusL panel = finish $ subFocusable focusL panel panel
where
finish ((prvFcs, pnl), (mdlFcs, regFcs)) =
let reorder = F.toList . Seq.sort
fr = if null mdlFcs
then fromMaybe (reorder regFcs) prvFcs
else reorder mdlFcs
in (pnl, fr)
subFocusable :: Eq n
=> Lens' (Panel n appev s panes) (FocusRing n)
-> Panel n appev s panes -> Panel n appev s rempanes
-> ((Maybe [n], Panel n appev s rempanes), (Seq n, Seq n))
subFocusable focusL base = \case
i@(Panel {}) -> ((Nothing, i), (mempty, mempty))
PanelWith pd WhenFocused r ->
let (i', ns) = subFocusable focusL base r
ns' = let pf = focusable r pd
in (fst ns, pf >< snd ns)
in (PanelWith pd WhenFocused <$> i', ns')
PanelWith pd WhenFocusedModal r ->
let (f', pf', i', ns') = goModal focusL base pd Nothing r
pfNew = case pf' of
Nothing -> WhenFocusedModal
Just x -> WhenFocusedModal' x
in ((f', PanelWith pd pfNew i'), ns')
PanelWith pd (WhenFocusedModal' pf) r ->
let (f', pf', i', ns') = goModal focusL base pd (Just pf) r
pfNew = case pf' of
Nothing -> WhenFocusedModal
Just x -> WhenFocusedModal' x
in ((f', PanelWith pd pfNew i'), ns')
PanelWith pd WhenFocusedModalHandlingAllEvents r ->
let (f', pf', i', ns') = goModal focusL base pd Nothing r
pfNew = case pf' of
Nothing -> WhenFocusedModalHandlingAllEvents
Just x -> WhenFocusedModalHandlingAllEvents' x
in ((f', PanelWith pd pfNew i'), ns')
PanelWith pd (WhenFocusedModalHandlingAllEvents' pf) r ->
let (f', pf', i', ns') = goModal focusL base pd (Just pf) r
pfNew = case pf' of
Nothing -> WhenFocusedModalHandlingAllEvents
Just x -> WhenFocusedModalHandlingAllEvents' x
in ((f', PanelWith pd pfNew i'), ns')
PanelWith x y r -> let (i', ns) = subFocusable focusL base r
in (PanelWith x y <$> i', ns)
goModal :: fullpanel ~ Panel n appev s panes
=> rempanel ~ Panel n appev s rempanes
=> EventConstraints pane rempanel
=> Pane n appev pane
=> Eq n
=> Lens' fullpanel (FocusRing n)
-> fullpanel
-> PaneState pane appev
-> Maybe (FocusRing n)
-> rempanel
-> (Maybe [n], Maybe (FocusRing n), rempanel, (Seq n, Seq n))
goModal focusL base pd pf r =
let ((f, i'), ns) = subFocusable focusL base r
fnms = focusable r pd
fpred = not $ Seq.null fnms
ns' = (fnms >< fst ns, snd ns)
f' = if fpred then Nothing else f <|> (focusRingToList <$> pf)
pf' = if fpred then pf <|> Just (base^.focusL) else Nothing
in (f', pf', i', ns')
-- | This returns all shrl instances of the input list.
--
-- rotations [1,2,3] == [ [1,2,3], [2,3,1], [3,1,2] ]
-- rotations [1,2,3,4] == [ [1,2,3,4], [2,3,4,1], [3,4,1,2], [4,1,2,3] ]
-- rotations [1] == [ [1] ]
-- rotations [] == []
rotations :: [a] -> [ [a] ]
rotations l = map rotateBy $ [0..length l - 1]
where rotateBy n = uncurry (flip (<>)) $ L.splitAt n l