{-# 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
extraEditorKeybindings :: forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
extraEditorKeybindings 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
                    -- Normally, this event causes the current message to
                    -- be sent. But in multiline mode we want to insert a
                    -- newline instead.
                    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
                -- Up in multiline mode does the usual thing; otherwise we
                -- navigate the history.
                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
                -- Down in multiline mode does the usual thing; otherwise
                -- we navigate the history.
                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
       ]