{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.Main where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( viewportScroll, vScrollBy )
import qualified Graphics.Vty as Vty

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.HelpTopics
import           Matterhorn.Events.Keybindings
import           Matterhorn.Events.MessageInterface
import           Matterhorn.Events.ThreadWindow
import           Matterhorn.State.ChannelSelect
import           Matterhorn.State.Channels
import           Matterhorn.State.Editing
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 -> KeyHandlerMap) -> Event -> MH Bool
handleKeyboardEvent (TeamId -> KeyConfig -> KeyHandlerMap
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 (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 -> KeyHandlerMap
mainKeybindings :: TeamId -> KeyConfig -> KeyHandlerMap
mainKeybindings TeamId
tId = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings (TeamId -> [KeyEventHandler]
mainKeyHandlers TeamId
tId)

mainKeyHandlers :: TeamId -> [KeyEventHandler]
mainKeyHandlers :: TeamId -> [KeyEventHandler]
mainKeyHandlers TeamId
tId =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ShowHelpEvent
        Text
"Show this help screen" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
        TeamId -> HelpTopic -> MH ()
showHelpScreen TeamId
tId HelpTopic
mainHelpTopic

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
EnterFastSelectModeEvent
        Text
"Enter fast channel selection mode" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
beginChannelSelect TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
ChannelListScrollUpEvent
        Text
"Scroll up in the channel list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll Name
vp (-Int
1)

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
ChannelListScrollDownEvent
        Text
"Scroll down in the channel list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll Name
vp Int
1

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
CycleChannelListSorting
        Text
"Cycle through channel list sorting modes" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        TeamId -> MH ()
cycleChannelListSortingMode TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ReplyRecentEvent
        Text
"Reply to the most recent message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        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
_ ->
            Lens' ChatState (EditState Name) -> MH ()
replyToLatestMessage (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(ChannelId
cId))

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ChangeMessageEditorFocus
        Text
"Cycle between message editors when a thread is open" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        TeamId -> MH ()
cycleTeamMessageInterfaceFocus TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextChannelEvent Text
"Change to the next channel in the channel list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
nextChannel TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PrevChannelEvent Text
"Change to the previous channel in the channel list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
prevChannel TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextUnreadChannelEvent Text
"Change to the next channel with unread messages or return to the channel marked '~'" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
nextUnreadChannel TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextUnreadUserOrChannelEvent
         Text
"Change to the next channel with unread messages preferring direct messages" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
nextUnreadUserOrChannel TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
LastChannelEvent Text
"Change to the most recently-focused channel" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
recentChannel TeamId
tId

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ClearUnreadEvent Text
"Clear the current channel's unread / edited indicators" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
EnterFlaggedPostsEvent Text
"View currently flagged posts" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         TeamId -> MH ()
enterFlaggedPostListMode TeamId
tId
    ]