{-# 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 <- Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MH MessageInterfaceMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface Name i
 -> Const MessageInterfaceMode (MessageInterface Name i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const MessageInterfaceMode (MessageInterface Name i))
 -> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
     -> Const MessageInterfaceMode MessageInterfaceMode)
    -> MessageInterface Name i
    -> Const MessageInterfaceMode (MessageInterface Name i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
 -> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface Name i
-> Const MessageInterfaceMode (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode)
    case MessageInterfaceMode
mode of
        MessageInterfaceMode
Compose ->
            [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
extraEditorKeybindings (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which)
                            , (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
forall n i.
Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
messageInterfaceKeybindings (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which)
                            , \Event
e -> do
                                case Event
e of
                                    (Vty.EvPaste ByteString
bytes) -> Lens' ChatState (EditState Name) -> ByteString -> MH ()
handlePaste ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((EditState Name -> f (EditState Name))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (EditState Name -> f (EditState Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> f (EditState Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor) ByteString
bytes
                                    Event
_ -> Lens' ChatState (EditState Name) -> Event -> MH ()
handleEditingInput ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((EditState Name -> f (EditState Name))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (EditState Name -> f (EditState Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> f (EditState Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor) Event
e
                                Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                            ] Event
ev
        MessageInterfaceMode
MessageSelect ->
            TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i) -> Event -> MH Bool
onEventMessageSelect TeamId
tId (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which Event
ev
        MessageInterfaceMode
ShowUrlList ->
            Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventUrlSelect (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which Event
ev
        SaveAttachment {} ->
            Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventSaveAttachmentWindow (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which Event
ev
        MessageInterfaceMode
ManageAttachments ->
            Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventAttachmentList (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which Event
ev
        MessageInterfaceMode
BrowseFiles ->
            Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventBrowseFile (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
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 =
    KeyConfig KeyEvent
-> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
forall n i.
Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
messageInterfaceKeyHandlers (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which)

messageInterfaceKeyHandlers :: Lens' ChatState (MessageInterface n i)
                            -> [MHKeyEventHandler]
messageInterfaceKeyHandlers :: forall n i.
Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
messageInterfaceKeyHandlers Lens' ChatState (MessageInterface n i)
which =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EnterSelectModeEvent
        Text
"Select a message to edit/reply/delete" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up in the message list (enters message select mode)" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SelectOldestMessageEvent Text
"Scroll to top of message list" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
EnterOpenURLModeEvent Text
"Select and open a URL from the current message list" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
startUrlSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
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 =
    KeyConfig KeyEvent
-> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
forall i.
Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
extraEditorKeyHandlers (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which)

extraEditorKeyHandlers :: Lens' ChatState (MessageInterface Name i)
                       -> [MHKeyEventHandler]
extraEditorKeyHandlers :: forall i.
Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
extraEditorKeyHandlers Lens' ChatState (MessageInterface Name i)
which =
    let editWhich :: Lens' ChatState (EditState Name)
        editWhich :: Lens' ChatState (EditState Name)
editWhich = (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((EditState Name -> f (EditState Name))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (EditState Name -> f (EditState Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> f (EditState Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor
    in [ KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ToggleMultiLineEvent Text
"Toggle multi-line message compose mode" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
              Lens' ChatState (EditState Name) -> MH ()
toggleMultilineEditing (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CancelEvent Text
"Cancel autocomplete, message reply, or edit, in that order" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
            Lens' ChatState (EditState Name) -> MH ()
cancelAutocompleteOrReplyOrEdit (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
           KeyEvent
InvokeEditorEvent
           Text
"Invoke `$EDITOR` to edit the current message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
           Lens' ChatState (EditState Name) -> MH ()
invokeExternalEditor (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich

       , Binding -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'\t')
            Text
"Tab-complete forward" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
            Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
Traversal' ChatState (EditState Name)
editWhich Direction
Forwards

       , Binding -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KBackTab)
            Text
"Tab-complete backward" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
            Traversal' ChatState (EditState Name) -> Direction -> MH ()
tabComplete (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
Traversal' ChatState (EditState Name)
editWhich Direction
Backwards

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ShowAttachmentListEvent Text
"Show the attachment list" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
            Lens' ChatState (MessageInterface Name i) -> MH ()
forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentList (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

       , Binding -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter)
            Text
"Send the current message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
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 ((EditState Name -> Const Bool (EditState Name))
-> ChatState -> Const Bool ChatState
Lens' ChatState (EditState Name)
editWhich((EditState Name -> Const Bool (EditState Name))
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> EditState Name -> Const Bool (EditState Name)
forall n (f :: * -> *).
Functor f =>
(EphemeralEditState -> f EphemeralEditState)
-> EditState n -> f (EditState n)
esEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> EditState Name -> Const Bool (EditState Name))
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> EditState Name
-> Const Bool (EditState Name)
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 -> Lens' ChatState (EditState Name) -> Event -> MH ()
handleEditingInput (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
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 (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich
                        Lens' ChatState (EditState Name) -> Text -> MH ()
handleInputSubmission (EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich Text
content

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
           KeyEvent
ScrollUpEvent
           Text
"Scroll up in the channel input history" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
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 ((EditState Name -> Const Bool (EditState Name))
-> ChatState -> Const Bool ChatState
Lens' ChatState (EditState Name)
editWhich((EditState Name -> Const Bool (EditState Name))
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> EditState Name -> Const Bool (EditState Name)
forall n (f :: * -> *).
Functor f =>
(EphemeralEditState -> f EphemeralEditState)
-> EditState n -> f (EditState n)
esEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> EditState Name -> Const Bool (EditState Name))
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> EditState Name
-> Const Bool (EditState Name)
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)
-> (BrickEvent Name Any -> EventM Name (Editor Text Name) ())
-> BrickEvent Name Any
-> MH ()
forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom ((EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich((EditState Name -> f (EditState Name))
 -> ChatState -> f ChatState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> EditState Name -> f (EditState Name))
-> (Editor Text Name -> f (Editor Text Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> f (Editor Text Name))
-> EditState Name -> f (EditState Name)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> EditState n -> f (EditState n)
esEditor) BrickEvent Name Any -> EventM Name (Editor Text Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent
                                              (Event -> BrickEvent Name Any
forall n e. Event -> BrickEvent n e
VtyEvent (Event -> BrickEvent Name Any) -> Event -> BrickEvent Name Any
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KUp [])
                    Bool
False -> Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryBackward (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
           KeyEvent
ScrollDownEvent
           Text
"Scroll down in the channel input history" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
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 ((EditState Name -> Const Bool (EditState Name))
-> ChatState -> Const Bool ChatState
Lens' ChatState (EditState Name)
editWhich((EditState Name -> Const Bool (EditState Name))
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> EditState Name -> Const Bool (EditState Name)
forall n (f :: * -> *).
Functor f =>
(EphemeralEditState -> f EphemeralEditState)
-> EditState n -> f (EditState n)
esEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> EditState Name -> Const Bool (EditState Name))
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> EditState Name
-> Const Bool (EditState Name)
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)
-> (BrickEvent Name Any -> EventM Name (Editor Text Name) ())
-> BrickEvent Name Any
-> MH ()
forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom ((EditState Name -> f (EditState Name)) -> ChatState -> f ChatState
Lens' ChatState (EditState Name)
editWhich((EditState Name -> f (EditState Name))
 -> ChatState -> f ChatState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> EditState Name -> f (EditState Name))
-> (Editor Text Name -> f (Editor Text Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> f (Editor Text Name))
-> EditState Name -> f (EditState Name)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> EditState n -> f (EditState n)
esEditor) BrickEvent Name Any -> EventM Name (Editor Text Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent
                                              (Event -> BrickEvent Name Any
forall n e. Event -> BrickEvent n e
VtyEvent (Event -> BrickEvent Name Any) -> Event -> BrickEvent Name Any
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KDown [])
                    Bool
False -> Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
inputHistoryForward (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

       , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
           KeyEvent
ReplyRecentEvent Text
"Reply to the most recent message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
           Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
replyToLatestMessage (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which
       ]