{-# 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
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
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
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
]