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

import           Prelude ()
import           Matterhorn.Prelude

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.Events.Keybindings
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 :: TeamId
-> Lens' ChatState (MessageInterface n i) -> Event -> MH Bool
onEventMessageSelect TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    (KeyConfig -> KeyHandlerMap) -> Event -> MH Bool
handleKeyboardEvent (TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig
-> KeyHandlerMap
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig
-> KeyHandlerMap
messageSelectKeybindings TeamId
tId Lens' ChatState (MessageInterface n i)
which)

onEventMessageSelectDeleteConfirm :: TeamId -> Lens' ChatState (MessageInterface Name i) -> Vty.Event -> MH ()
onEventMessageSelectDeleteConfirm :: 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 Lens' ChatState (MessageInterface Name i)
which
    TeamId -> MH ()
popMode TeamId
tId
onEventMessageSelectDeleteConfirm TeamId
_ Lens' ChatState (MessageInterface Name i)
_ (Vty.EvResize {}) = do
    () -> MH ()
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
                         -> KeyHandlerMap
messageSelectKeybindings :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig
-> KeyHandlerMap
messageSelectKeybindings TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings (TeamId
-> Lens' ChatState (MessageInterface n i) -> [KeyEventHandler]
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i) -> [KeyEventHandler]
messageSelectKeyHandlers TeamId
tId Lens' ChatState (MessageInterface n i)
which)

messageSelectKeyHandlers :: TeamId
                         -> Lens' ChatState (MessageInterface n i)
                         -> [KeyEventHandler]
messageSelectKeyHandlers :: TeamId
-> Lens' ChatState (MessageInterface n i) -> [KeyEventHandler]
messageSelectKeyHandlers TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
CancelEvent Text
"Cancel message selection" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
SelectUpEvent Text
"Select the previous message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
SelectDownEvent Text
"Select the next message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollTopEvent Text
"Scroll to top and select the oldest message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollBottomEvent Text
"Scroll to bottom and select the latest message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectLast Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        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 Lens' ChatState (MessageInterface n i)
which Int
messagesPerPageOperation)

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb
        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 Lens' ChatState (MessageInterface n i)
which Int
messagesPerPageOperation)

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
OpenMessageURLEvent Text
"Open all URLs in the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageURLs Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ReplyMessageEvent Text
"Begin composing a reply to the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginReplyCompose Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
EditMessageEvent Text
"Begin editing the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginEditMessage Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
DeleteMessageEvent Text
"Delete the selected message (with confirmation)" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
YankMessageEvent Text
"Copy a verbatim section or message to the clipboard" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessageVerbatim Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
YankWholeMessageEvent Text
"Copy an entire message to the clipboard" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessage Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PinMessageEvent Text
"Toggle whether the selected message is pinned" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
pinSelectedMessage Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
FlagMessageEvent Text
"Flag the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
flagSelectedMessage Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ViewMessageEvent Text
"View the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
OpenThreadEvent Text
"Open the selected message's thread in a thread window" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
FillGapEvent Text
"Fetch messages for the selected gap" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
fillSelectedGap Lens' ChatState (MessageInterface n i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ReactToMessageEvent Text
"Post a reaction to the selected message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 Lens' ChatState (MessageInterface n i)
which))
         case Maybe Message
mMsg of
             Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just Message
m -> TeamId -> Message -> MH ()
enterReactionEmojiListWindowMode TeamId
tId Message
m

    , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
CopyPostLinkEvent Text
"Copy a post's link to the clipboard" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
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 Lens' ChatState (MessageInterface n i)
which
    ]