{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.MessageInterface
( handleMessageInterfaceEvent
, messageInterfaceKeyHandlers
, extraEditorKeyHandlers
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick ( BrickEvent(VtyEvent) )
import Brick.Keybindings
import Brick.Widgets.Edit ( handleEditorEvent )
import qualified Graphics.Vty as Vty
import Lens.Micro.Platform ( Lens' )
import Network.Mattermost.Types ( TeamId )
import Matterhorn.Types
import Matterhorn.Events.SaveAttachmentWindow
import Matterhorn.Events.ManageAttachments
import Matterhorn.Events.MessageSelect
import Matterhorn.Events.UrlSelect
import Matterhorn.State.Attachments
import Matterhorn.State.Editing
import Matterhorn.State.UrlSelect
import Matterhorn.State.MessageSelect
import Matterhorn.State.Channels
handleMessageInterfaceEvent :: TeamId
-> Lens' ChatState (MessageInterface Name i)
-> Vty.Event
-> MH Bool
handleMessageInterfaceEvent :: forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
handleMessageInterfaceEvent TeamId
tId Lens' ChatState (MessageInterface Name i)
which Event
ev = do
MessageInterfaceMode
mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)
case MessageInterfaceMode
mode of
MessageInterfaceMode
Compose ->
[Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
extraEditorKeybindings Lens' ChatState (MessageInterface Name i)
which)
, (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (forall n i.
Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
messageInterfaceKeybindings Lens' ChatState (MessageInterface Name i)
which)
, \Event
e -> do
case Event
e of
(Vty.EvPaste ByteString
bytes) -> Lens' ChatState (EditState Name) -> ByteString -> MH ()
handlePaste (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor) ByteString
bytes
Event
_ -> Lens' ChatState (EditState Name) -> Event -> MH ()
handleEditingInput (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor) Event
e
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
] Event
ev
MessageInterfaceMode
MessageSelect ->
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i) -> Event -> MH Bool
onEventMessageSelect TeamId
tId Lens' ChatState (MessageInterface Name i)
which Event
ev
MessageInterfaceMode
ShowUrlList ->
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventUrlSelect Lens' ChatState (MessageInterface Name i)
which Event
ev
SaveAttachment {} ->
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which Event
ev
MessageInterfaceMode
ManageAttachments ->
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventAttachmentList Lens' ChatState (MessageInterface Name i)
which Event
ev
MessageInterfaceMode
BrowseFiles ->
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventBrowseFile Lens' ChatState (MessageInterface Name i)
which Event
ev
messageInterfaceKeybindings :: Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
messageInterfaceKeybindings :: forall n i.
Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
messageInterfaceKeybindings Lens' ChatState (MessageInterface n i)
which KeyConfig KeyEvent
kc =
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (forall n i.
Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler]
messageInterfaceKeyHandlers Lens' ChatState (MessageInterface n i)
which)
messageInterfaceKeyHandlers :: Lens' ChatState (MessageInterface n i)
-> [MHKeyEventHandler]
messageInterfaceKeyHandlers :: forall n i.
Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler]
messageInterfaceKeyHandlers Lens' ChatState (MessageInterface n i)
which =
[ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EnterSelectModeEvent
Text
"Select a message to edit/reply/delete" forall a b. (a -> b) -> a -> b
$
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect Lens' ChatState (MessageInterface n i)
which
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up in the message list (enters message select mode)" forall a b. (a -> b) -> a -> b
$ do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect Lens' ChatState (MessageInterface n i)
which
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SelectOldestMessageEvent Text
"Scroll to top of message list" forall a b. (a -> b) -> a -> b
$ do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect Lens' ChatState (MessageInterface n i)
which
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst Lens' ChatState (MessageInterface n i)
which
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EnterOpenURLModeEvent Text
"Select and open a URL from the current message list" forall a b. (a -> b) -> a -> b
$
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
startUrlSelect Lens' ChatState (MessageInterface n i)
which
]
extraEditorKeybindings :: Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
Lens' ChatState (MessageInterface Name i)
which KeyConfig KeyEvent
kc =
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
extraEditorKeyHandlers Lens' ChatState (MessageInterface Name i)
which)
extraEditorKeyHandlers :: Lens' ChatState (MessageInterface Name i)
-> [MHKeyEventHandler]
extraEditorKeyHandlers :: forall i.
Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
extraEditorKeyHandlers Lens' ChatState (MessageInterface Name i)
which =
let editWhich :: Lens' ChatState (EditState Name)
editWhich :: Lens' ChatState (EditState Name)
editWhich = Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor
in [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ToggleMultiLineEvent Text
"Toggle multi-line message compose mode" forall a b. (a -> b) -> a -> b
$
Lens' ChatState (EditState Name) -> MH ()
toggleMultilineEditing Lens' ChatState (EditState Name)
editWhich
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CancelEvent Text
"Cancel autocomplete, message reply, or edit, in that order" forall a b. (a -> b) -> a -> b
$
Lens' ChatState (EditState Name) -> MH ()
cancelAutocompleteOrReplyOrEdit Lens' ChatState (EditState Name)
editWhich
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
KeyEvent
InvokeEditorEvent
Text
"Invoke `$EDITOR` to edit the current message" forall a b. (a -> b) -> a -> b
$
Lens' ChatState (EditState Name) -> MH ()
invokeExternalEditor Lens' ChatState (EditState Name)
editWhich
, forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (forall a. ToBinding a => a -> Binding
bind Char
'\t')
Text
"Tab-complete forward" forall a b. (a -> b) -> a -> b
$
Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete Lens' ChatState (EditState Name)
editWhich Direction
Forwards
, forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (forall a. ToBinding a => a -> Binding
bind Key
Vty.KBackTab)
Text
"Tab-complete backward" forall a b. (a -> b) -> a -> b
$
Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete Lens' ChatState (EditState Name)
editWhich Direction
Backwards
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ShowAttachmentListEvent Text
"Show the attachment list" forall a b. (a -> b) -> a -> b
$
forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentList Lens' ChatState (MessageInterface Name i)
which
, forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter)
Text
"Send the current message" forall a b. (a -> b) -> a -> b
$ do
Bool
isMultiline <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline)
case Bool
isMultiline of
Bool
True -> Lens' ChatState (EditState Name) -> Event -> MH ()
handleEditingInput Lens' ChatState (EditState Name)
editWhich (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KEnter [])
Bool
False -> do
Text
content <- Lens' ChatState (EditState Name) -> MH Text
getEditorContent Lens' ChatState (EditState Name)
editWhich
Lens' ChatState (EditState Name) -> Text -> MH ()
handleInputSubmission Lens' ChatState (EditState Name)
editWhich Text
content
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
KeyEvent
ScrollUpEvent
Text
"Scroll up in the channel input history" forall a b. (a -> b) -> a -> b
$ do
Bool
isMultiline <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline)
case Bool
isMultiline of
Bool
True -> forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent
(forall n e. Event -> BrickEvent n e
VtyEvent forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KUp [])
Bool
False -> forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryBackward Lens' ChatState (MessageInterface Name i)
which
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
KeyEvent
ScrollDownEvent
Text
"Scroll down in the channel input history" forall a b. (a -> b) -> a -> b
$ do
Bool
isMultiline <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline)
case Bool
isMultiline of
Bool
True -> forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (Lens' ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor) forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent
(forall n e. Event -> BrickEvent n e
VtyEvent forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KDown [])
Bool
False -> forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryForward Lens' ChatState (MessageInterface Name i)
which
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
KeyEvent
ReplyRecentEvent Text
"Reply to the most recent message" forall a b. (a -> b) -> a -> b
$
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
replyToLatestMessage Lens' ChatState (MessageInterface Name i)
which
]