{-# 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 > handlePaneEvent :: (EventConstraints pane eventcontext, Eq n) > => eventcontext > -> EventType pane n appEv > -> PaneState pane appEv > -> EventM n es (PaneState pane appEv) > > 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 wheen 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 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'. 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'. 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'. 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. 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. 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