module Matterhorn.Events.ChannelSelect where import Prelude () import Matterhorn.Prelude import Brick.Widgets.Edit ( handleEditorEvent ) import qualified Graphics.Vty as Vty import Matterhorn.Events.Keybindings import Matterhorn.State.Channels import Matterhorn.State.ChannelSelect import Matterhorn.State.Editing ( editingKeybindings ) import Matterhorn.Types import qualified Matterhorn.Zipper as Z onEventChannelSelect :: Vty.Event -> MH Bool onEventChannelSelect :: Event -> MH Bool onEventChannelSelect = (KeyConfig -> KeyHandlerMap) -> (Event -> MH ()) -> Event -> MH Bool handleKeyboardEvent KeyConfig -> KeyHandlerMap channelSelectKeybindings ((Event -> MH ()) -> Event -> MH Bool) -> (Event -> MH ()) -> Event -> MH Bool forall a b. (a -> b) -> a -> b $ \Event e -> do Bool handled <- (KeyConfig -> KeyHandlerMap) -> (Event -> MH ()) -> Event -> MH Bool handleKeyboardEvent (Lens' ChatState (Editor Text Name) -> KeyConfig -> KeyHandlerMap editingKeybindings ((TeamState -> f TeamState) -> ChatState -> f ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState) -> ((Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState) -> (Editor Text Name -> f (Editor Text Name)) -> ChatState -> f ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChannelSelectState -> f ChannelSelectState) -> TeamState -> f TeamState Lens' TeamState ChannelSelectState tsChannelSelectState((ChannelSelectState -> f ChannelSelectState) -> TeamState -> f TeamState) -> ((Editor Text Name -> f (Editor Text Name)) -> ChannelSelectState -> f ChannelSelectState) -> (Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(Editor Text Name -> f (Editor Text Name)) -> ChannelSelectState -> f ChannelSelectState Lens' ChannelSelectState (Editor Text Name) channelSelectInput)) (MH () -> Event -> MH () forall a b. a -> b -> a const (MH () -> Event -> MH ()) -> MH () -> Event -> MH () forall a b. (a -> b) -> a -> b $ () -> MH () forall (m :: * -> *) a. Monad m => a -> m a return ()) Event e Bool -> MH () -> MH () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Bool -> Bool not Bool handled) (MH () -> MH ()) -> MH () -> MH () forall a b. (a -> b) -> a -> b $ Lens' ChatState (Editor Text Name) -> (Event -> Editor Text Name -> EventM Name (Editor Text Name)) -> Event -> MH () forall b e. Lens' ChatState b -> (e -> b -> EventM Name b) -> e -> MH () mhHandleEventLensed ((TeamState -> f TeamState) -> ChatState -> f ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState) -> ((Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState) -> (Editor Text Name -> f (Editor Text Name)) -> ChatState -> f ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChannelSelectState -> f ChannelSelectState) -> TeamState -> f TeamState Lens' TeamState ChannelSelectState tsChannelSelectState((ChannelSelectState -> f ChannelSelectState) -> TeamState -> f TeamState) -> ((Editor Text Name -> f (Editor Text Name)) -> ChannelSelectState -> f ChannelSelectState) -> (Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(Editor Text Name -> f (Editor Text Name)) -> ChannelSelectState -> f ChannelSelectState Lens' ChannelSelectState (Editor Text Name) channelSelectInput) Event -> Editor Text Name -> EventM Name (Editor Text Name) forall t n. (DecodeUtf8 t, Eq t, GenericTextZipper t) => Event -> Editor t n -> EventM n (Editor t n) handleEditorEvent Event e MH () updateChannelSelectMatches channelSelectKeybindings :: KeyConfig -> KeyHandlerMap channelSelectKeybindings :: KeyConfig -> KeyHandlerMap channelSelectKeybindings = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap mkKeybindings [KeyEventHandler] channelSelectKeyHandlers channelSelectKeyHandlers :: [KeyEventHandler] channelSelectKeyHandlers :: [KeyEventHandler] channelSelectKeyHandlers = [ Text -> Event -> MH () -> KeyEventHandler staticKb Text "Switch to selected channel" (Key -> [Modifier] -> Event Vty.EvKey Key Vty.KEnter []) (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler forall a b. (a -> b) -> a -> b $ do Zipper ChannelListGroup ChannelSelectMatch matches <- Getting (Zipper ChannelListGroup ChannelSelectMatch) ChatState (Zipper ChannelListGroup ChannelSelectMatch) -> MH (Zipper ChannelListGroup ChannelSelectMatch) forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState) -> ChatState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState) -> ChatState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChatState) -> ((Zipper ChannelListGroup ChannelSelectMatch -> Const (Zipper ChannelListGroup ChannelSelectMatch) (Zipper ChannelListGroup ChannelSelectMatch)) -> TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState) -> Getting (Zipper ChannelListGroup ChannelSelectMatch) ChatState (Zipper ChannelListGroup ChannelSelectMatch) forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChannelSelectState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState) -> TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState Lens' TeamState ChannelSelectState tsChannelSelectState((ChannelSelectState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState) -> TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState) -> ((Zipper ChannelListGroup ChannelSelectMatch -> Const (Zipper ChannelListGroup ChannelSelectMatch) (Zipper ChannelListGroup ChannelSelectMatch)) -> ChannelSelectState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState) -> (Zipper ChannelListGroup ChannelSelectMatch -> Const (Zipper ChannelListGroup ChannelSelectMatch) (Zipper ChannelListGroup ChannelSelectMatch)) -> TeamState -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(Zipper ChannelListGroup ChannelSelectMatch -> Const (Zipper ChannelListGroup ChannelSelectMatch) (Zipper ChannelListGroup ChannelSelectMatch)) -> ChannelSelectState -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState Lens' ChannelSelectState (Zipper ChannelListGroup ChannelSelectMatch) channelSelectMatches) case Zipper ChannelListGroup ChannelSelectMatch -> Maybe ChannelSelectMatch forall a b. Zipper a b -> Maybe b Z.focus Zipper ChannelListGroup ChannelSelectMatch matches of Maybe ChannelSelectMatch Nothing -> () -> MH () forall (m :: * -> *) a. Monad m => a -> m a return () Just ChannelSelectMatch match -> do Mode -> MH () setMode Mode Main ChannelId -> MH () setFocus (ChannelId -> MH ()) -> ChannelId -> MH () forall a b. (a -> b) -> a -> b $ ChannelListEntry -> ChannelId channelListEntryChannelId (ChannelListEntry -> ChannelId) -> ChannelListEntry -> ChannelId forall a b. (a -> b) -> a -> b $ ChannelSelectMatch -> ChannelListEntry matchEntry ChannelSelectMatch match , KeyEvent -> Text -> MH () -> KeyEventHandler mkKb KeyEvent CancelEvent Text "Cancel channel selection" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler forall a b. (a -> b) -> a -> b $ Mode -> MH () setMode Mode Main , KeyEvent -> Text -> MH () -> KeyEventHandler mkKb KeyEvent NextChannelEvent Text "Select next match" MH () channelSelectNext , KeyEvent -> Text -> MH () -> KeyEventHandler mkKb KeyEvent PrevChannelEvent Text "Select previous match" MH () channelSelectPrevious , KeyEvent -> Text -> MH () -> KeyEventHandler mkKb KeyEvent NextChannelEventAlternate Text "Select next match (alternate binding)" MH () channelSelectNext , KeyEvent -> Text -> MH () -> KeyEventHandler mkKb KeyEvent PrevChannelEventAlternate Text "Select previous match (alternate binding)" MH () channelSelectPrevious ]