{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.MessageSelect
  ( messageSelectKeybindings
  , messageSelectKeyHandlers
  , onEventMessageSelect
  , onEventMessageSelectDeleteConfirm
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Keybindings
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( Lens', to )

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.State.MessageSelect
import           Matterhorn.State.ReactionEmojiListWindow
import           Matterhorn.Types


messagesPerPageOperation :: Int
messagesPerPageOperation :: Int
messagesPerPageOperation = Int
10

onEventMessageSelect :: TeamId
                     -> Lens' ChatState (MessageInterface n i)
                     -> Vty.Event
                     -> MH Bool
onEventMessageSelect :: forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i) -> Event -> MH Bool
onEventMessageSelect TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
messageSelectKeybindings TeamId
tId (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which)

onEventMessageSelectDeleteConfirm :: TeamId -> Lens' ChatState (MessageInterface Name i) -> Vty.Event -> MH ()
onEventMessageSelectDeleteConfirm :: forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH ()
onEventMessageSelectDeleteConfirm TeamId
tId Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey (Vty.KChar Char
'y') []) = do
    Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
deleteSelectedMessage (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which
    TeamId -> MH ()
popMode TeamId
tId
onEventMessageSelectDeleteConfirm TeamId
_ Lens' ChatState (MessageInterface Name i)
_ (Vty.EvResize {}) = do
    () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onEventMessageSelectDeleteConfirm TeamId
tId Lens' ChatState (MessageInterface Name i)
_ Event
_ = do
    TeamId -> MH ()
popMode TeamId
tId

messageSelectKeybindings :: TeamId
                         -> Lens' ChatState (MessageInterface n i)
                         -> KeyConfig KeyEvent
                         -> KeyDispatcher KeyEvent MH
messageSelectKeybindings :: forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
messageSelectKeybindings TeamId
tId 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 (TeamId
-> Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
messageSelectKeyHandlers TeamId
tId (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which)

messageSelectKeyHandlers :: TeamId
                         -> Lens' ChatState (MessageInterface n i)
                         -> [MHKeyEventHandler]
messageSelectKeyHandlers :: forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> [KeyEventHandler KeyEvent MH]
messageSelectKeyHandlers TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CancelEvent Text
"Cancel message selection" (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 ()
exitMessageSelect (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
SelectUpEvent Text
"Select the previous message" (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 ()
messageSelectUp (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
SelectDownEvent Text
"Select the next message" (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 ()
messageSelectDown (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
ScrollTopEvent Text
"Scroll to top and select the oldest message" (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 ()
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
ScrollBottomEvent Text
"Scroll to bottom and select the latest message" (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 ()
messageSelectLast (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
        (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Move the cursor up by " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
messagesPerPageOperation String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" messages")
        (Lens' ChatState (MessageInterface n i) -> Int -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectUpBy (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which Int
messagesPerPageOperation)

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent
        KeyEvent
PageDownEvent
        (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Move the cursor down by " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
messagesPerPageOperation String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" messages")
        (Lens' ChatState (MessageInterface n i) -> Int -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectDownBy (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which Int
messagesPerPageOperation)

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
OpenMessageURLEvent Text
"Open all URLs in the selected message" (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 ()
openSelectedMessageURLs (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
ReplyMessageEvent Text
"Begin composing a reply to the selected message" (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 ()
beginReplyCompose (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
EditMessageEvent Text
"Begin editing the selected message" (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 ()
beginEditMessage (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
DeleteMessageEvent Text
"Delete the selected message (with confirmation)" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
         TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
beginConfirmDeleteSelectedMessage TeamId
tId (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
YankMessageEvent Text
"Copy a verbatim section or message to the clipboard" (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 ()
yankSelectedMessageVerbatim (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
YankWholeMessageEvent Text
"Copy an entire message to the clipboard" (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 ()
yankSelectedMessage (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
PinMessageEvent Text
"Toggle whether the selected message is pinned" (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 ()
pinSelectedMessage (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
FlagMessageEvent Text
"Flag the selected message" (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 ()
flagSelectedMessage (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
ViewMessageEvent Text
"View the selected message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
         TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
viewSelectedMessage TeamId
tId (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
OpenThreadEvent Text
"Open the selected message's thread in a thread window" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
         TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
openThreadWindow TeamId
tId (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
FillGapEvent Text
"Fetch messages for the selected gap" (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 ()
fillSelectedGap (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
ReactToMessageEvent Text
"Post a reaction to the selected message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
         Maybe Message
mMsg <- Getting (Maybe Message) ChatState (Maybe Message)
-> MH (Maybe Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatState -> Maybe Message)
-> SimpleGetter ChatState (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to (Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which))
         case Maybe Message
mMsg of
             Maybe Message
Nothing -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just Message
m -> TeamId -> Message -> MH ()
enterReactionEmojiListWindowMode TeamId
tId Message
m

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CopyPostLinkEvent Text
"Copy a post's link to the clipboard" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
         TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
copyPostLink TeamId
tId (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
OpenMessageInExternalEditorEvent Text
"Open the message's source in $EDITOR" (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 ()
openSelectedMessageInEditor (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
    ]