{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} module Matterhorn.Events.Main where import Prelude () import Matterhorn.Prelude import Brick.Main ( viewportScroll, vScrollBy ) import Brick.Keybindings import qualified Graphics.Vty as Vty import Network.Mattermost.Types ( TeamId ) import Matterhorn.HelpTopics import Matterhorn.Events.MessageInterface import Matterhorn.Events.ThreadWindow import Matterhorn.State.ChannelSelect import Matterhorn.State.Channels import Matterhorn.State.Help import Matterhorn.State.Teams import Matterhorn.State.PostListWindow ( enterFlaggedPostListMode ) import Matterhorn.Types onEventMain :: TeamId -> Vty.Event -> MH () onEventMain :: TeamId -> Event -> MH () onEventMain TeamId tId = forall (f :: * -> *) a. Functor f => f a -> f () void forall b c a. (b -> c) -> (a -> b) -> a -> c . [Event -> MH Bool] -> Event -> MH Bool handleEventWith [ (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH) -> Event -> MH Bool mhHandleKeyboardEvent (TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH mainKeybindings TeamId tId) , \Event e -> do ChatState st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use forall a. a -> a id case ChatState stforall s a. s -> Getting a s a -> a ^.TeamId -> Lens' ChatState TeamState csTeam(TeamId tId)forall b c a. (b -> c) -> (a -> b) -> a -> c .Lens' TeamState MessageInterfaceFocus tsMessageInterfaceFocus of MessageInterfaceFocus FocusThread -> TeamId -> Event -> MH Bool onEventThreadWindow TeamId tId Event e MessageInterfaceFocus FocusCurrentChannel -> do Maybe ChannelId mCid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (TeamId -> SimpleGetter ChatState (Maybe ChannelId) csCurrentChannelId(TeamId tId)) case Maybe ChannelId mCid of Maybe ChannelId Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return Bool False Just ChannelId cId -> forall i. TeamId -> Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool handleMessageInterfaceEvent TeamId tId (ChannelId -> Lens' ChatState ChannelMessageInterface csChannelMessageInterface(ChannelId cId)) Event e ] mainKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH mainKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH mainKeybindings TeamId tId KeyConfig KeyEvent kc = forall k (m :: * -> *). Ord k => KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m unsafeKeyDispatcher KeyConfig KeyEvent kc (TeamId -> [MHKeyEventHandler] mainKeyHandlers TeamId tId) mainKeyHandlers :: TeamId -> [MHKeyEventHandler] mainKeyHandlers :: TeamId -> [MHKeyEventHandler] mainKeyHandlers TeamId tId = [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ShowHelpEvent Text "Show this help screen" forall a b. (a -> b) -> a -> b $ do TeamId -> HelpTopic -> MH () showHelpScreen TeamId tId HelpTopic mainHelpTopic , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent EnterFastSelectModeEvent Text "Enter fast channel selection mode" forall a b. (a -> b) -> a -> b $ TeamId -> MH () beginChannelSelect TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChannelListScrollUpEvent Text "Scroll up in the channel list" forall a b. (a -> b) -> a -> b $ do let vp :: ViewportScroll Name vp = forall n. n -> ViewportScroll n viewportScroll forall a b. (a -> b) -> a -> b $ TeamId -> Name ChannelListViewport TeamId tId forall a. EventM Name ChatState a -> MH a mh forall a b. (a -> b) -> a -> b $ forall n. ViewportScroll n -> forall s. Int -> EventM n s () vScrollBy ViewportScroll Name vp (-Int 1) , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChannelListScrollDownEvent Text "Scroll down in the channel list" forall a b. (a -> b) -> a -> b $ do let vp :: ViewportScroll Name vp = forall n. n -> ViewportScroll n viewportScroll forall a b. (a -> b) -> a -> b $ TeamId -> Name ChannelListViewport TeamId tId forall a. EventM Name ChatState a -> MH a mh forall a b. (a -> b) -> a -> b $ forall n. ViewportScroll n -> forall s. Int -> EventM n s () vScrollBy ViewportScroll Name vp Int 1 , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent CycleChannelListSorting Text "Cycle through channel list sorting modes" forall a b. (a -> b) -> a -> b $ TeamId -> MH () cycleChannelListSortingMode TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChangeMessageEditorFocus Text "Cycle between message editors when a thread is open" forall a b. (a -> b) -> a -> b $ TeamId -> MH () cycleTeamMessageInterfaceFocus TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent NextChannelEvent Text "Change to the next channel in the channel list" forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextChannel TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent PrevChannelEvent Text "Change to the previous channel in the channel list" forall a b. (a -> b) -> a -> b $ TeamId -> MH () prevChannel TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent NextUnreadChannelEvent Text "Change to the next channel with unread messages or return to the channel marked '~'" forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextUnreadChannel TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent NextUnreadUserOrChannelEvent Text "Change to the next channel with unread messages preferring direct messages" forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextUnreadUserOrChannel TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent LastChannelEvent Text "Change to the most recently-focused channel" forall a b. (a -> b) -> a -> b $ TeamId -> MH () recentChannel TeamId tId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ClearUnreadEvent Text "Clear the current channel's unread / edited indicators" forall a b. (a -> b) -> a -> b $ do TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH () withCurrentChannel TeamId tId forall a b. (a -> b) -> a -> b $ \ChannelId cId ClientChannel _ -> do ChannelId -> MH () clearChannelUnreadStatus ChannelId cId , forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent EnterFlaggedPostsEvent Text "View currently flagged posts" forall a b. (a -> b) -> a -> b $ TeamId -> MH () enterFlaggedPostListMode TeamId tId ]