{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.MessageSelect
  (
  -- * Message selection mode
    beginMessageSelect
  , flagSelectedMessage
  , pinSelectedMessage
  , viewSelectedMessage
  , fillSelectedGap
  , copyPostLink
  , yankSelectedMessageVerbatim
  , yankSelectedMessage
  , openSelectedMessageURLs
  , beginConfirmDeleteSelectedMessage
  , messageSelectUp
  , messageSelectUpBy
  , messageSelectDown
  , messageSelectDownBy
  , messageSelectFirst
  , messageSelectLast
  , deleteSelectedMessage
  , beginReplyCompose
  , beginEditMessage
  , flagMessage
  , getSelectedMessage
  , openThreadWindow
  , exitMessageSelect
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( invalidateCache )
import           Brick.Widgets.Edit ( applyEdit )
import           Control.Monad ( replicateM_ )
import           Data.Text.Zipper ( clearZipper, insertMany )
import           Data.Maybe ( fromJust )
import           Lens.Micro.Platform

import qualified Network.Mattermost.Endpoints as MM
import           Network.Mattermost.Types

import           Matterhorn.Clipboard ( copyToClipboard )
import           Matterhorn.State.Common
import           Matterhorn.State.Links
import {-# SOURCE #-} Matterhorn.State.Messages ( asyncFetchMessagesForGap )
import           Matterhorn.Types
import           Matterhorn.Types.RichText ( findVerbatimChunk, makePermalink )
import           Matterhorn.Types.Common
import           Matterhorn.Windows.ViewMessage
import qualified Matterhorn.State.ThreadWindow as TW


getSelectedMessage :: Lens' ChatState (MessageInterface n i)
                   -> ChatState
                   -> Maybe Message
getSelectedMessage :: forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface n i)
which ChatState
st = do
    MessageId
selMsgId <- MessageSelectState -> Maybe MessageId
selectMessageId forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect
    let chanMsgs :: Messages
chanMsgs = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
    MessageId -> Messages -> Maybe Message
findMessage MessageId
selMsgId Messages
chanMsgs

withSelectedMessage :: Lens' ChatState (MessageInterface n i)
                    -> (Message -> MH ())
                    -> MH ()
withSelectedMessage :: forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which Message -> MH ()
act = do
    Maybe Message
selectedMessage <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall s a. (s -> a) -> SimpleGetter s a
to (forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface n i)
which))
    case Maybe Message
selectedMessage of
        Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Message
m -> Message -> MH ()
act Message
m

beginMessageSelect :: Lens' ChatState (MessageInterface n i)
                   -> MH ()
beginMessageSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect Lens' ChatState (MessageInterface n i)
which = do
    -- Invalidate the rendering cache since we cache messages to speed
    -- up the selection UI responsiveness. (See Draw.Messages for
    -- caching behavior.)
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache

    -- Get the number of messages in the listing and set the currently
    -- selected message index to be the most recently received message
    -- that corresponds to a Post (i.e. exclude informative messages).
    --
    -- If we can't find one at all, we ignore the mode switch request
    -- and just return.
    Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
    let recentMsg :: Maybe Message
recentMsg = Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Message
recentMsg) forall a b. (a -> b) -> a -> b
$ do
        Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
MessageSelect
        Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe Message
recentMsg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> Maybe MessageId
_mMessageId)

exitMessageSelect :: Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which = do
    MessageInterfaceMode
m <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MessageInterfaceMode
m forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect) forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose

-- | Tell the server that the message we currently have selected
-- should have its flagged state toggled.
flagSelectedMessage :: Lens' ChatState (MessageInterface n i)
                    -> MH ()
flagSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
flagSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isFlaggable Message
msg) forall a b. (a -> b) -> a -> b
$ do
            case Message -> Maybe PostId
messagePostId Message
msg of
                Just PostId
pId -> PostId -> Bool -> MH ()
flagMessage PostId
pId (Bool -> Bool
not (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mFlagged))
                Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Tell the server that the message we currently have selected
-- should have its pinned state toggled.
pinSelectedMessage :: Lens' ChatState (MessageInterface n i)
                   -> MH ()
pinSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
pinSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPinnable Message
msg) forall a b. (a -> b) -> a -> b
$ do
            case Message -> Maybe PostId
messagePostId Message
msg of
                Just PostId
pId -> PostId -> Bool -> MH ()
pinMessage PostId
pId (Bool -> Bool
not (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mPinned))
                Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

viewSelectedMessage :: TeamId
                    -> Lens' ChatState (MessageInterface n i)
                    -> MH ()
viewSelectedMessage :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
viewSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Message -> Bool
isGap Message
msg)) forall a b. (a -> b) -> a -> b
$ TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
msg

-- This will only work for channel message selection, not thread message
-- selection, since there will never be gap entries in the thread view.
-- But this is generalized enough that it looks like it should work for
-- thread views, but it won't because asyncFetchMessagesForGap only
-- works for channel message selection (and should).
fillSelectedGap :: Lens' ChatState (MessageInterface n i)
                -> MH ()
fillSelectedGap :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
fillSelectedGap Lens' ChatState (MessageInterface n i)
which = do
    ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
msg) forall a b. (a -> b) -> a -> b
$ ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
msg

copyPostLink :: TeamId
             -> Lens' ChatState (MessageInterface n i)
             -> MH ()
copyPostLink :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
copyPostLink TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) forall a b. (a -> b) -> a -> b
$ do
            TeamBaseURL
baseUrl <- TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
            let pId :: PostId
pId = forall a. HasCallStack => Maybe a -> a
fromJust (MessageId -> Maybe PostId
messageIdPostId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Maybe MessageId
_mMessageId Message
msg)
            Text -> MH ()
copyToClipboard forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> PostId -> Text
makePermalink TeamBaseURL
baseUrl PostId
pId
            forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which

viewMessage :: TeamId -> Message -> MH ()
viewMessage :: TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
m = do
    let w :: TabbedWindow ChatState MH Name ViewMessageWindowTab
w = forall a s (m :: * -> *) n.
(Show a, Eq a) =>
a
-> TabbedWindowTemplate s m n a
-> (Int, Int)
-> TabbedWindow s m n a
tabbedWindow ViewMessageWindowTab
VMTabMessage (TeamId
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId) (Int
78, Int
25)
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
  TeamState
  (Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Message
m, TabbedWindow ChatState MH Name ViewMessageWindowTab
w)
    forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState MH Name ViewMessageWindowTab
w) TabbedWindow ChatState MH Name ViewMessageWindowTab
w
    TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
ViewMessage

yankSelectedMessageVerbatim :: Lens' ChatState (MessageInterface n i)
                            -> MH ()
yankSelectedMessageVerbatim :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessageVerbatim Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
        case Blocks -> Maybe Text
findVerbatimChunk (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Blocks
mText) of
            Just Text
txt -> Text -> MH ()
copyToClipboard Text
txt
            Maybe Text
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

openThreadWindow :: TeamId
                 -> Lens' ChatState (MessageInterface n i)
                 -> MH ()
openThreadWindow :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
openThreadWindow TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) forall a b. (a -> b) -> a -> b
$ do
            Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
            let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
            case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId of
                Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just ChannelId
cId -> do
                    -- Leave message selection mode
                    forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
                    TeamId -> ChannelId -> PostId -> MH ()
TW.openThreadWindow TeamId
tId ChannelId
cId (Post -> PostId
postId Post
p)

yankSelectedMessage :: Lens' ChatState (MessageInterface n i)
                    -> MH ()
yankSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
        Text -> MH ()
copyToClipboard forall a b. (a -> b) -> a -> b
$ Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Text
mMarkdownSource

openSelectedMessageURLs :: Lens' ChatState (MessageInterface n i)
                        -> MH ()
openSelectedMessageURLs :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageURLs Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let urls :: Seq LinkChoice
urls = Message -> Seq LinkChoice
msgURLs Message
msg
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq LinkChoice
urls)) forall a b. (a -> b) -> a -> b
$ do
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LinkTarget -> MH ()
openLinkTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkChoice -> LinkTarget
_linkTarget) Seq LinkChoice
urls

beginConfirmDeleteSelectedMessage :: TeamId
                                  -> Lens' ChatState (MessageInterface n i)
                                  -> MH ()
beginConfirmDeleteSelectedMessage :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
beginConfirmDeleteSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    MessageInterfaceTarget
target <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceTarget
miTarget)
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isDeletable Message
msg Bool -> Bool -> Bool
&& ChatState -> Message -> Bool
isMine ChatState
st Message
msg) forall a b. (a -> b) -> a -> b
$
            TeamId -> Mode -> MH ()
pushMode TeamId
tId forall a b. (a -> b) -> a -> b
$ MessageInterfaceTarget -> Mode
MessageSelectDeleteConfirm MessageInterfaceTarget
target

messageSelectUp :: Lens' ChatState (MessageInterface n i)
                -> MH ()
messageSelectUp :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getPrevMessageId Maybe MessageId
selected Messages
msgs
        Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)

messageSelectDown :: Lens' ChatState (MessageInterface n i)
                  -> MH ()
messageSelectDown :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getNextMessageId Maybe MessageId
selected Messages
msgs
        Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)

messageSelectDownBy :: Lens' ChatState (MessageInterface n i)
                    -> Int
                    -> MH ()
messageSelectDownBy :: forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectDownBy Lens' ChatState (MessageInterface n i)
which Int
amt =
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt forall a b. (a -> b) -> a -> b
$ forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown Lens' ChatState (MessageInterface n i)
which

messageSelectUpBy :: Lens' ChatState (MessageInterface n i)
                  -> Int
                  -> MH ()
messageSelectUpBy :: forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectUpBy Lens' ChatState (MessageInterface n i)
which Int
amt =
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt forall a b. (a -> b) -> a -> b
$ forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which

messageSelectFirst :: Lens' ChatState (MessageInterface n i)
                   -> MH ()
messageSelectFirst :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        case Messages -> Maybe Message
getEarliestSelectableMessage Messages
msgs of
          Just Message
firstMsg ->
            Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
firstMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
          Maybe Message
Nothing -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError Text
"No first message found from current message?!"

messageSelectLast :: Lens' ChatState (MessageInterface n i)
                  -> MH ()
messageSelectLast :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectLast Lens' ChatState (MessageInterface n i)
which =
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        case Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs of
          Just Message
lastSelMsg ->
            Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
lastSelMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
          Maybe Message
Nothing -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError Text
"No last message found from current message?!"

deleteSelectedMessage :: Lens' ChatState (MessageInterface n i)
                      -> MH ()
deleteSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
deleteSelectedMessage Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
msg) forall a b. (a -> b) -> a -> b
$ do
            forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost of
                Just Post
p ->
                    forall a.
AsyncPriority -> (Session -> IO a) -> (a -> Maybe (MH ())) -> MH ()
doAsyncMM AsyncPriority
Preempt
                        (\Session
s -> PostId -> Session -> IO ()
MM.mmDeletePost (Post -> PostId
postId Post
p) Session
s)
                        (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
                Maybe Post
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

beginReplyCompose :: Lens' ChatState (MessageInterface n i)
                  -> MH ()
beginReplyCompose :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginReplyCompose Lens' ChatState (MessageInterface n i)
which = do
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isReplyable Message
msg) forall a b. (a -> b) -> a -> b
$ do
            Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
            let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
            forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Post -> EditMode
Replying Message
rootMsg Post
p

beginEditMessage :: Lens' ChatState (MessageInterface n i)
                 -> MH ()
beginEditMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginEditMessage Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
msg) forall a b. (a -> b) -> a -> b
$ do
            let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
            forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Post -> MessageType -> EditMode
Editing Post
p (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType)
            -- If the post that we're editing is an emote, we need
            -- to strip the formatting because that's only there to
            -- indicate that the post is an emote. This is annoying and
            -- can go away one day when there is an actual post type
            -- value of "emote" that we can look at. Note that the
            -- removed formatting needs to be reinstated just prior to
            -- issuing the API call to update the post.
            let sanitized :: Text
sanitized = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
p
            let toEdit :: Text
toEdit = if Message -> Bool
isEmote Message
msg
                         then Text -> Text
removeEmoteFormatting Text
sanitized
                         else Text
sanitized
            Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
toEdit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper)

-- | Tell the server that we have flagged or unflagged a message.
flagMessage :: PostId -> Bool -> MH ()
flagMessage :: PostId -> Bool -> MH ()
flagMessage PostId
pId Bool
f = do
    Session
session <- MH Session
getSession
    UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
        let doFlag :: UserId -> PostId -> Session -> IO ()
doFlag = if Bool
f then UserId -> PostId -> Session -> IO ()
MM.mmFlagPost else UserId -> PostId -> Session -> IO ()
MM.mmUnflagPost
        UserId -> PostId -> Session -> IO ()
doFlag UserId
myId PostId
pId Session
session
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Tell the server that we have pinned or unpinned a message.
pinMessage :: PostId -> Bool -> MH ()
pinMessage :: PostId -> Bool -> MH ()
pinMessage PostId
pId Bool
f = do
    Session
session <- MH Session
getSession
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
        let doPin :: PostId -> Session -> IO StatusOK
doPin = if Bool
f then PostId -> Session -> IO StatusOK
MM.mmPinPostToChannel else PostId -> Session -> IO StatusOK
MM.mmUnpinPostToChannel
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO StatusOK
doPin PostId
pId Session
session
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing