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

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Widgets.Edit
import qualified Graphics.Vty as Vty

import           Matterhorn.Command
import           Matterhorn.Events.Keybindings
import           Matterhorn.State.Attachments
import           Matterhorn.State.ChannelSelect
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Channels
import           Matterhorn.State.Editing
import           Matterhorn.State.MessageSelect
import           Matterhorn.State.PostListOverlay ( enterFlaggedPostListMode )
import           Matterhorn.State.Teams
import           Matterhorn.State.UrlSelect
import           Matterhorn.Types


onEventMain :: Vty.Event -> MH ()
onEventMain :: Event -> MH ()
onEventMain =
  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
. (KeyConfig -> KeyHandlerMap)
-> (Event -> MH ()) -> Event -> MH Bool
handleKeyboardEvent KeyConfig -> KeyHandlerMap
mainKeybindings (\ Event
ev -> do
      MH ()
resetReturnChannel
      case Event
ev of
          (Vty.EvPaste ByteString
bytes) -> ByteString -> MH ()
handlePaste ByteString
bytes
          Event
_ -> Event -> MH ()
handleEditingInput Event
ev
  )

mainKeybindings :: KeyConfig -> KeyHandlerMap
mainKeybindings :: KeyConfig -> KeyHandlerMap
mainKeybindings = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings [KeyEventHandler]
mainKeyHandlers

mainKeyHandlers :: [KeyEventHandler]
mainKeyHandlers :: [KeyEventHandler]
mainKeyHandlers =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
EnterSelectModeEvent
        Text
"Select a message to edit/reply/delete"
        MH ()
beginMessageSelect

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ReplyRecentEvent
        Text
"Reply to the most recent message"
        MH ()
replyToLatestMessage

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ToggleMessagePreviewEvent Text
"Toggle message preview"
        MH ()
toggleMessagePreview

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ToggleChannelListVisibleEvent Text
"Toggle channel list visibility"
        MH ()
toggleChannelListVisibility

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ToggleExpandedChannelTopicsEvent Text
"Toggle display of expanded channel topics"
        MH ()
toggleExpandedChannelTopics

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextTeamEvent Text
"Switch to the next available team"
        MH ()
nextTeam

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PrevTeamEvent Text
"Switch to the previous available team"
        MH ()
prevTeam

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
MoveCurrentTeamLeftEvent Text
"Move the current team to the left in the team list"
        MH ()
moveCurrentTeamLeft

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
MoveCurrentTeamRightEvent Text
"Move the current team to the right in the team list"
        MH ()
moveCurrentTeamRight

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
InvokeEditorEvent
        Text
"Invoke `$EDITOR` to edit the current message"
        MH ()
invokeExternalEditor

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
EnterFastSelectModeEvent
        Text
"Enter fast channel selection mode"
         MH ()
beginChannelSelect

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
QuitEvent
        Text
"Quit"
        MH ()
requestQuit

    , Text -> Event -> MH () -> KeyEventHandler
staticKb Text
"Tab-complete forward"
         (Key -> [Modifier] -> Event
Vty.EvKey (Char -> Key
Vty.KChar Char
'\t') []) (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Direction -> MH ()
tabComplete Direction
Forwards

    , Text -> Event -> MH () -> KeyEventHandler
staticKb Text
"Tab-complete backward"
         (Key -> [Modifier] -> Event
Vty.EvKey (Key
Vty.KBackTab) []) (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Direction -> MH ()
tabComplete Direction
Backwards

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
ScrollUpEvent
        Text
"Scroll up in the channel input history" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
             -- Up in multiline mode does the usual thing; otherwise we
             -- navigate the history.
             Bool
isMultiline <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Bool TeamState)
-> ChatState -> Const Bool ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Bool TeamState)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool) -> TeamState -> Const Bool TeamState)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const Bool ChatEditState)
-> TeamState -> Const Bool TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const Bool ChatEditState)
 -> TeamState -> Const Bool TeamState)
-> ((Bool -> Const Bool Bool)
    -> ChatEditState -> Const Bool ChatEditState)
-> (Bool -> Const Bool Bool)
-> TeamState
-> Const Bool TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> ChatEditState -> Const Bool ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> ChatEditState -> Const Bool ChatEditState)
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> ChatEditState
-> Const Bool ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline)
             case Bool
isMultiline of
                 Bool
True -> 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
.(ChatEditState -> f ChatEditState) -> TeamState -> f TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> f ChatEditState) -> TeamState -> f TeamState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> ChatEditState -> f ChatEditState)
-> (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))
-> ChatEditState -> f ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor) Event -> Editor Text Name -> EventM Name (Editor Text Name)
forall t n.
(DecodeUtf8 t, Eq t, Monoid t) =>
Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent
                                           (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KUp [])
                 Bool
False -> MH ()
channelHistoryBackward

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        KeyEvent
ScrollDownEvent
        Text
"Scroll down in the channel input history" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
             -- Down in multiline mode does the usual thing; otherwise
             -- we navigate the history.
             Bool
isMultiline <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Bool TeamState)
-> ChatState -> Const Bool ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Bool TeamState)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool) -> TeamState -> Const Bool TeamState)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const Bool ChatEditState)
-> TeamState -> Const Bool TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const Bool ChatEditState)
 -> TeamState -> Const Bool TeamState)
-> ((Bool -> Const Bool Bool)
    -> ChatEditState -> Const Bool ChatEditState)
-> (Bool -> Const Bool Bool)
-> TeamState
-> Const Bool TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> ChatEditState -> Const Bool ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> ChatEditState -> Const Bool ChatEditState)
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> ChatEditState
-> Const Bool ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline)
             case Bool
isMultiline of
                 Bool
True -> 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
.(ChatEditState -> f ChatEditState) -> TeamState -> f TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> f ChatEditState) -> TeamState -> f TeamState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> ChatEditState -> f ChatEditState)
-> (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))
-> ChatEditState -> f ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor) Event -> Editor Text Name -> EventM Name (Editor Text Name)
forall t n.
(DecodeUtf8 t, Eq t, Monoid t) =>
Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent
                                           (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KDown [])
                 Bool
False -> MH ()
channelHistoryForward

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageUpEvent Text
"Page up in the channel message list (enters message select mode)" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
             MH ()
beginMessageSelect

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
SelectOldestMessageEvent Text
"Scroll to top of channel message list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
             MH ()
beginMessageSelect
             MH ()
messageSelectFirst

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextChannelEvent Text
"Change to the next channel in the channel list"
         MH ()
nextChannel

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PrevChannelEvent Text
"Change to the previous channel in the channel list"
         MH ()
prevChannel

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextUnreadChannelEvent Text
"Change to the next channel with unread messages or return to the channel marked '~'"
         MH ()
nextUnreadChannel

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ShowAttachmentListEvent Text
"Show the attachment list"
         MH ()
showAttachmentList

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
NextUnreadUserOrChannelEvent
         Text
"Change to the next channel with unread messages preferring direct messages"
         MH ()
nextUnreadUserOrChannel

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
LastChannelEvent Text
"Change to the most recently-focused channel"
         MH ()
recentChannel

    , Text -> Event -> MH () -> KeyEventHandler
staticKb Text
"Send the current message"
         (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KEnter []) (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
             Bool
isMultiline <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Bool TeamState)
-> ChatState -> Const Bool ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Bool TeamState)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool) -> TeamState -> Const Bool TeamState)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const Bool ChatEditState)
-> TeamState -> Const Bool TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const Bool ChatEditState)
 -> TeamState -> Const Bool TeamState)
-> ((Bool -> Const Bool Bool)
    -> ChatEditState -> Const Bool ChatEditState)
-> (Bool -> Const Bool Bool)
-> TeamState
-> Const Bool TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> ChatEditState -> Const Bool ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> ChatEditState -> Const Bool ChatEditState)
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> ChatEditState
-> Const Bool ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline)
             case Bool
isMultiline of
                 -- Normally, this event causes the current message to
                 -- be sent. But in multiline mode we want to insert a
                 -- newline instead.
                 Bool
True -> Event -> MH ()
handleEditingInput (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KEnter [])
                 Bool
False -> do
                     TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                     ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
                     Text
content <- MH Text
getEditorContent
                     TeamId -> ChannelId -> Text -> MH ()
handleInputSubmission TeamId
tId ChannelId
cId Text
content

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
EnterOpenURLModeEvent Text
"Select and open a URL posted to the current channel"
           MH ()
startUrlSelect

    , 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
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           ChannelId -> MH ()
clearChannelUnreadStatus (ChannelId -> MH ()) -> MH ChannelId -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ToggleMultiLineEvent Text
"Toggle multi-line message compose mode"
           MH ()
toggleMultilineEditing

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
CancelEvent Text
"Cancel autocomplete, message reply, or edit, in that order"
         MH ()
cancelAutocompleteOrReplyOrEdit

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
EnterFlaggedPostsEvent Text
"View currently flagged posts"
         MH ()
enterFlaggedPostListMode
    ]