{-# 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 :: Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface n i)
which ChatState
st = do
    MessageId
selMsgId <- MessageSelectState -> Maybe MessageId
selectMessageId (MessageSelectState -> Maybe MessageId)
-> MessageSelectState -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting MessageSelectState ChatState MessageSelectState
-> MessageSelectState
forall s a. s -> Getting a s a -> a
^.(MessageInterface n i
 -> Const MessageSelectState (MessageInterface n i))
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
  -> Const MessageSelectState (MessageInterface n i))
 -> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
     -> Const MessageSelectState MessageSelectState)
    -> MessageInterface n i
    -> Const MessageSelectState (MessageInterface n i))
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> MessageInterface n i
-> Const MessageSelectState (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect
    let chanMsgs :: Messages
chanMsgs = ChatState
stChatState -> Getting Messages ChatState Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
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 :: Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which Message -> MH ()
act = do
    Maybe Message
selectedMessage <- 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
selectedMessage of
        Maybe Message
Nothing -> () -> MH ()
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 :: 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.)
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
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 <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) Messages
miMessages)
    let recentMsg :: Maybe Message
recentMsg = Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs

    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Message -> Bool
forall a. Maybe a -> Bool
isJust Maybe Message
recentMsg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
MessageSelect
        (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe Message
recentMsg Maybe Message -> (Message -> Maybe MessageId) -> Maybe MessageId
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which = do
    MessageInterfaceMode
m <- Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MH MessageInterfaceMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i
 -> Const MessageInterfaceMode (MessageInterface n i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
  -> Const MessageInterfaceMode (MessageInterface n i))
 -> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
     -> Const MessageInterfaceMode MessageInterfaceMode)
    -> MessageInterface n i
    -> Const MessageInterfaceMode (MessageInterface n i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
 -> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface n i
-> Const MessageInterfaceMode (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MessageInterfaceMode
m MessageInterfaceMode -> MessageInterfaceMode -> Bool
forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
        (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
flagSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isFlaggable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
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
msgMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mFlagged))
                Maybe PostId
Nothing -> () -> MH ()
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
pinSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPinnable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
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
msgMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mPinned))
                Maybe PostId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

viewSelectedMessage :: TeamId
                    -> Lens' ChatState (MessageInterface n i)
                    -> MH ()
viewSelectedMessage :: TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
viewSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Message -> Bool
isGap Message
msg)) (MH () -> MH ()) -> MH () -> MH ()
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
fillSelectedGap Lens' ChatState (MessageInterface n i)
which = do
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const ChannelId (MessageInterface n i))
-> ChatState -> Const ChannelId ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const ChannelId (MessageInterface n i))
 -> ChatState -> Const ChannelId ChatState)
-> ((ChannelId -> Const ChannelId ChannelId)
    -> MessageInterface n i -> Const ChannelId (MessageInterface n i))
-> Getting ChannelId ChatState ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> MessageInterface n i -> Const ChannelId (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
msg

copyPostLink :: TeamId
             -> Lens' ChatState (MessageInterface n i)
             -> MH ()
copyPostLink :: TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
copyPostLink TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            TeamBaseURL
baseUrl <- TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
            let pId :: PostId
pId = Maybe PostId -> PostId
forall a. HasCallStack => Maybe a -> a
fromJust (MessageId -> Maybe PostId
messageIdPostId (MessageId -> Maybe PostId) -> Maybe MessageId -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Maybe MessageId
_mMessageId Message
msg)
            Text -> MH ()
copyToClipboard (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> PostId -> Text
makePermalink TeamBaseURL
baseUrl PostId
pId
            Lens' ChatState (MessageInterface n i) -> MH ()
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 = ViewMessageWindowTab
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
-> (Int, Int)
-> TabbedWindow ChatState MH Name ViewMessageWindowTab
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)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe
       (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
     -> Identity
          (Maybe
             (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
    -> TeamState -> Identity TeamState)
-> (Maybe
      (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
    -> Identity
         (Maybe
            (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe
   (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
 -> Identity
      (Maybe
         (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState -> Identity TeamState
Lens'
  TeamState
  (Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage ((Maybe
    (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
  -> Identity
       (Maybe
          (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
 -> ChatState -> Identity ChatState)
-> Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall a. a -> Maybe a
Just (Message
m, TabbedWindow ChatState MH Name ViewMessageWindowTab
w)
    ViewMessageWindowTab
-> TabbedWindow ChatState MH Name ViewMessageWindowTab -> MH ()
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> ViewMessageWindowTab
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessageVerbatim Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
        case Blocks -> Maybe Text
findVerbatimChunk (Message
msgMessage -> Getting Blocks Message Blocks -> Blocks
forall s a. s -> Getting a s a -> a
^.Getting Blocks Message Blocks
Lens' Message Blocks
mText) of
            Just Text
txt -> Text -> MH ()
copyToClipboard Text
txt
            Maybe Text
Nothing  -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

openThreadWindow :: TeamId
                 -> Lens' ChatState (MessageInterface n i)
                 -> MH ()
openThreadWindow :: TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
openThreadWindow TeamId
tId Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
            let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
rootMsgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
            case Message
msgMessage
-> Getting (Maybe ChannelId) Message (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe ChannelId) Message (Maybe ChannelId)
Lens' Message (Maybe ChannelId)
mChannelId of
                Maybe ChannelId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just ChannelId
cId -> do
                    -- Leave message selection mode
                    Lens' ChatState (MessageInterface n i) -> MH ()
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessage Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
        Text -> MH ()
copyToClipboard (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Message
msgMessage -> Getting Text Message Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text Message Text
Lens' Message Text
mMarkdownSource

openSelectedMessageURLs :: Lens' ChatState (MessageInterface n i)
                        -> MH ()
openSelectedMessageURLs :: Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageURLs Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let urls :: Seq LinkChoice
urls = Message -> Seq LinkChoice
msgURLs Message
msg
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Seq LinkChoice -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq LinkChoice
urls)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            (LinkChoice -> MH ()) -> Seq LinkChoice -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LinkTarget -> MH ()
openLinkTarget (LinkTarget -> MH ())
-> (LinkChoice -> LinkTarget) -> LinkChoice -> MH ()
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 :: TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
beginConfirmDeleteSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    MessageInterfaceTarget
target <- Getting MessageInterfaceTarget ChatState MessageInterfaceTarget
-> MH MessageInterfaceTarget
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i
 -> Const MessageInterfaceTarget (MessageInterface n i))
-> ChatState -> Const MessageInterfaceTarget ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
  -> Const MessageInterfaceTarget (MessageInterface n i))
 -> ChatState -> Const MessageInterfaceTarget ChatState)
-> ((MessageInterfaceTarget
     -> Const MessageInterfaceTarget MessageInterfaceTarget)
    -> MessageInterface n i
    -> Const MessageInterfaceTarget (MessageInterface n i))
-> Getting MessageInterfaceTarget ChatState MessageInterfaceTarget
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceTarget
 -> Const MessageInterfaceTarget MessageInterfaceTarget)
-> MessageInterface n i
-> Const MessageInterfaceTarget (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceTarget
miTarget)
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isDeletable Message
msg Bool -> Bool -> Bool
&& ChatState -> Message -> Bool
isMine ChatState
st Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
            TeamId -> Mode -> MH ()
pushMode TeamId
tId (Mode -> MH ()) -> Mode -> MH ()
forall a b. (a -> b) -> a -> b
$ MessageInterfaceTarget -> Mode
MessageSelectDeleteConfirm MessageInterfaceTarget
target

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

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

messageSelectDownBy :: Lens' ChatState (MessageInterface n i)
                    -> Int
                    -> MH ()
messageSelectDownBy :: Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectDownBy Lens' ChatState (MessageInterface n i)
which Int
amt =
    Int -> MH () -> MH ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt (MH () -> MH ()) -> MH () -> MH ()
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

messageSelectUpBy :: Lens' ChatState (MessageInterface n i)
                  -> Int
                  -> MH ()
messageSelectUpBy :: Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectUpBy Lens' ChatState (MessageInterface n i)
which Int
amt =
    Int -> MH () -> MH ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt (MH () -> MH ()) -> MH () -> MH ()
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

messageSelectFirst :: Lens' ChatState (MessageInterface n i)
                   -> MH ()
messageSelectFirst :: Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        case Messages -> Maybe Message
getEarliestSelectableMessage Messages
msgs of
          Just Message
firstMsg ->
            (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
firstMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectLast Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
        Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        case Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs of
          Just Message
lastSelMsg ->
            (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
lastSelMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
deleteSelectedMessage Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            case Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost of
                Just Post
p ->
                    AsyncPriority
-> (Session -> IO ()) -> (() -> Maybe (MH ())) -> MH ()
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)
                        (Maybe (MH ()) -> () -> Maybe (MH ())
forall a b. a -> b -> a
const Maybe (MH ())
forall a. Maybe a
Nothing)
                Maybe Post
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

beginReplyCompose :: Lens' ChatState (MessageInterface n i)
                  -> MH ()
beginReplyCompose :: Lens' ChatState (MessageInterface n i) -> MH ()
beginReplyCompose Lens' ChatState (MessageInterface n i)
which = do
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isReplyable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
            let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
rootMsgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
            Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState n -> Identity (EditState n))
 -> MessageInterface n i -> Identity (MessageInterface n i))
-> ((EditMode -> Identity EditMode)
    -> EditState n -> Identity (EditState n))
-> (EditMode -> Identity EditMode)
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n)
forall n. Lens' (EditState n) EditMode
esEditMode ((EditMode -> Identity EditMode)
 -> ChatState -> Identity ChatState)
-> EditMode -> MH ()
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 :: Lens' ChatState (MessageInterface n i) -> MH ()
beginEditMessage Lens' ChatState (MessageInterface n i)
which = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
            Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
            (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState n -> Identity (EditState n))
 -> MessageInterface n i -> Identity (MessageInterface n i))
-> ((EditMode -> Identity EditMode)
    -> EditState n -> Identity (EditState n))
-> (EditMode -> Identity EditMode)
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n)
forall n. Lens' (EditState n) EditMode
esEditMode ((EditMode -> Identity EditMode)
 -> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Post -> MessageType -> EditMode
Editing Post
p (Message
msgMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
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 (UserText -> Text) -> UserText -> Text
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
            (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((Editor Text n -> Identity (Editor Text n))
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (Editor Text n -> Identity (Editor Text n))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState n -> Identity (EditState n))
 -> MessageInterface n i -> Identity (MessageInterface n i))
-> ((Editor Text n -> Identity (Editor Text n))
    -> EditState n -> Identity (EditState n))
-> (Editor Text n -> Identity (Editor Text n))
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text n -> Identity (Editor Text n))
-> EditState n -> Identity (EditState n)
forall n. Lens' (EditState n) (Editor Text n)
esEditor ((Editor Text n -> Identity (Editor Text n))
 -> ChatState -> Identity ChatState)
-> (Editor Text n -> Editor Text n) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (Text -> TextZipper Text -> TextZipper Text
forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
toEdit (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
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 <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
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
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
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 (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
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
        IO StatusOK -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO StatusOK -> IO ()) -> IO StatusOK -> IO ()
forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO StatusOK
doPin PostId
pId Session
session
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing