{-# 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.ChannelList ( updateSidebar ) 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 = MH Bool -> MH () forall (f :: * -> *) a. Functor f => f a -> f () void (MH Bool -> MH ()) -> (Event -> MH Bool) -> Event -> MH () 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 <- Getting ChatState ChatState ChatState -> MH ChatState forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use Getting ChatState ChatState ChatState forall a. a -> a id case ChatState stChatState -> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus -> MessageInterfaceFocus forall s a. s -> Getting a s a -> a ^.TeamId -> Lens' ChatState TeamState csTeam(TeamId tId)((TeamState -> Const MessageInterfaceFocus TeamState) -> ChatState -> Const MessageInterfaceFocus ChatState) -> ((MessageInterfaceFocus -> Const MessageInterfaceFocus MessageInterfaceFocus) -> TeamState -> Const MessageInterfaceFocus TeamState) -> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus forall b c a. (b -> c) -> (a -> b) -> a -> c .(MessageInterfaceFocus -> Const MessageInterfaceFocus MessageInterfaceFocus) -> TeamState -> Const MessageInterfaceFocus TeamState Lens' TeamState MessageInterfaceFocus tsMessageInterfaceFocus of MessageInterfaceFocus FocusThread -> TeamId -> Event -> MH Bool onEventThreadWindow TeamId tId Event e MessageInterfaceFocus FocusCurrentChannel -> do Maybe ChannelId mCid <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId) -> MH (Maybe ChannelId) 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 -> Bool -> MH Bool forall a. a -> MH a forall (m :: * -> *) a. Monad m => a -> m a return Bool False Just ChannelId cId -> TeamId -> Lens' ChatState (MessageInterface Name ()) -> Event -> MH Bool forall i. TeamId -> Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool handleMessageInterfaceEvent TeamId tId (ChannelId -> Lens' ChatState (MessageInterface Name ()) 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 = KeyConfig KeyEvent -> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH forall k (m :: * -> *). Ord k => KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m unsafeKeyDispatcher KeyConfig KeyEvent kc (TeamId -> [KeyEventHandler KeyEvent MH] mainKeyHandlers TeamId tId) mainKeyHandlers :: TeamId -> [MHKeyEventHandler] mainKeyHandlers :: TeamId -> [KeyEventHandler KeyEvent MH] mainKeyHandlers TeamId tId = [ KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ShowHelpEvent Text "Show this help screen" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ do TeamId -> HelpTopic -> MH () showHelpScreen TeamId tId HelpTopic mainHelpTopic , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent EnterFastSelectModeEvent Text "Enter fast channel selection mode" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () beginChannelSelect TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChannelListScrollUpEvent Text "Scroll up in the channel list" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ do let vp :: ViewportScroll Name vp = Name -> ViewportScroll Name forall n. n -> ViewportScroll n viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name forall a b. (a -> b) -> a -> b $ TeamId -> Name ChannelListViewport TeamId tId EventM Name ChatState () -> MH () forall a. EventM Name ChatState a -> MH a mh (EventM Name ChatState () -> MH ()) -> EventM Name ChatState () -> MH () forall a b. (a -> b) -> a -> b $ ViewportScroll Name -> forall s. Int -> EventM Name s () forall n. ViewportScroll n -> forall s. Int -> EventM n s () vScrollBy ViewportScroll Name vp (-Int 1) , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChannelListScrollDownEvent Text "Scroll down in the channel list" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ do let vp :: ViewportScroll Name vp = Name -> ViewportScroll Name forall n. n -> ViewportScroll n viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name forall a b. (a -> b) -> a -> b $ TeamId -> Name ChannelListViewport TeamId tId EventM Name ChatState () -> MH () forall a. EventM Name ChatState a -> MH a mh (EventM Name ChatState () -> MH ()) -> EventM Name ChatState () -> MH () forall a b. (a -> b) -> a -> b $ ViewportScroll Name -> forall s. Int -> EventM Name s () forall n. ViewportScroll n -> forall s. Int -> EventM n s () vScrollBy ViewportScroll Name vp Int 1 , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent CycleChannelListSorting Text "Cycle through channel list sorting modes" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () cycleChannelListSortingMode TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ChangeMessageEditorFocus Text "Cycle between message editors when a thread is open" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () cycleTeamMessageInterfaceFocus TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent NextChannelEvent Text "Change to the next channel in the channel list" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextChannel TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent PrevChannelEvent Text "Change to the previous channel in the channel list" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () prevChannel TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH 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 '~'" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextUnreadChannel TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent NextUnreadUserOrChannelEvent Text "Change to the next channel with unread messages preferring direct messages" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () nextUnreadUserOrChannel TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent LastChannelEvent Text "Change to the most recently-focused channel" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () recentChannel TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent ClearUnreadEvent Text "Clear the current channel's unread / edited indicators" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ do TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH () withCurrentChannel TeamId tId ((ChannelId -> ClientChannel -> MH ()) -> MH ()) -> (ChannelId -> ClientChannel -> MH ()) -> MH () forall a b. (a -> b) -> a -> b $ \ChannelId cId ClientChannel _ -> do ChannelId -> MH () clearChannelUnreadStatus ChannelId cId Maybe TeamId -> MH () updateSidebar (Maybe TeamId -> MH ()) -> Maybe TeamId -> MH () forall a b. (a -> b) -> a -> b $ TeamId -> Maybe TeamId forall a. a -> Maybe a Just TeamId tId , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m onEvent KeyEvent EnterFlaggedPostsEvent Text "View currently flagged posts" (MH () -> KeyEventHandler KeyEvent MH) -> MH () -> KeyEventHandler KeyEvent MH forall a b. (a -> b) -> a -> b $ TeamId -> MH () enterFlaggedPostListMode TeamId tId ]