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

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( invalidateCache )
import           Brick.Widgets.Edit ( applyEdit )
import           Data.Text.Zipper ( clearZipper, insertMany )
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           Matterhorn.State.Messages
import           Matterhorn.Types
import           Matterhorn.Types.RichText ( findVerbatimChunk )
import           Matterhorn.Types.Common
import           Matterhorn.Windows.ViewMessage


-- | In these modes, we allow access to the selected message state.
messageSelectCompatibleModes :: [Mode]
messageSelectCompatibleModes :: [Mode]
messageSelectCompatibleModes =
    [ Mode
MessageSelect
    , Mode
MessageSelectDeleteConfirm
    , Mode
ReactionEmojiListOverlay
    ]

getSelectedMessage :: ChatState -> Maybe Message
getSelectedMessage :: ChatState -> Maybe Message
getSelectedMessage ChatState
st
    | Bool -> Bool
not (ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode Mode -> [Mode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Mode]
messageSelectCompatibleModes) = Maybe Message
forall a. Maybe a
Nothing
    | Bool
otherwise = 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
^.(TeamState -> Const MessageSelectState TeamState)
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const MessageSelectState TeamState)
 -> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
     -> Const MessageSelectState MessageSelectState)
    -> TeamState -> Const MessageSelectState TeamState)
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> TeamState -> Const MessageSelectState TeamState
Lens' TeamState MessageSelectState
tsMessageSelect
        let chanMsgs :: Messages
chanMsgs = ChatState
st ChatState -> Getting Messages ChatState Messages -> Messages
forall s a. s -> Getting a s a -> a
^. (ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel ((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages
        MessageId -> Messages -> Maybe Message
findMessage MessageId
selMsgId Messages
chanMsgs

beginMessageSelect :: MH ()
beginMessageSelect :: MH ()
beginMessageSelect = 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 current channel 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
chanMsgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use((ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel ((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages)
    let recentMsg :: Maybe Message
recentMsg = Messages -> Maybe Message
getLatestSelectableMessage Messages
chanMsgs

    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
        Mode -> MH ()
setMode Mode
MessageSelect
        (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((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)

-- | Tell the server that the message we currently have selected
-- should have its flagged state toggled.
flagSelectedMessage :: MH ()
flagSelectedMessage :: MH ()
flagSelectedMessage = do
  Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
  case Maybe Message
selected of
    Just Message
msg
      | Message -> Bool
isFlaggable Message
msg, Just PostId
pId <- Message -> Maybe PostId
messagePostId Message
msg ->
        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 Message
_        -> () -> 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 :: MH ()
pinSelectedMessage :: MH ()
pinSelectedMessage = do
  Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
  case Maybe Message
selected of
    Just Message
msg
      | Message -> Bool
isPinnable Message
msg, Just PostId
pId <- Message -> Maybe PostId
messagePostId Message
msg ->
        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 Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

viewSelectedMessage :: MH ()
viewSelectedMessage :: MH ()
viewSelectedMessage = do
  Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
  case Maybe Message
selected of
    Just Message
msg
      | Bool -> Bool
not (Message -> Bool
isGap Message
msg) -> Message -> MH ()
viewMessage Message
msg
    Maybe Message
_        -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

fillSelectedGap :: MH ()
fillSelectedGap :: MH ()
fillSelectedGap = do
  Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
  case Maybe Message
selected of
    Just Message
msg
      | Message -> Bool
isGap Message
msg -> do TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                        ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
                        ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
msg
    Maybe Message
_        -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

viewMessage :: Message -> MH ()
viewMessage :: Message -> MH ()
viewMessage Message
m = do
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    let w :: TabbedWindow ViewMessageWindowTab
w = ViewMessageWindowTab
-> TabbedWindowTemplate ViewMessageWindowTab
-> Mode
-> (Int, Int)
-> TabbedWindow ViewMessageWindowTab
forall a.
(Show a, Eq a) =>
a -> TabbedWindowTemplate a -> Mode -> (Int, Int) -> TabbedWindow a
tabbedWindow ViewMessageWindowTab
VMTabMessage (TeamId -> TabbedWindowTemplate ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId) Mode
MessageSelect (Int
78, Int
25)
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe (Message, TabbedWindow ViewMessageWindowTab)
     -> Identity (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
    -> TeamState -> Identity TeamState)
-> (Maybe (Message, TabbedWindow ViewMessageWindowTab)
    -> Identity (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> Identity (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> TeamState -> Identity TeamState
Lens'
  TeamState (Maybe (Message, TabbedWindow ViewMessageWindowTab))
tsViewedMessage ((Maybe (Message, TabbedWindow ViewMessageWindowTab)
  -> Identity (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
 -> ChatState -> Identity ChatState)
-> Maybe (Message, TabbedWindow ViewMessageWindowTab) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Message, TabbedWindow ViewMessageWindowTab)
-> Maybe (Message, TabbedWindow ViewMessageWindowTab)
forall a. a -> Maybe a
Just (Message
m, TabbedWindow ViewMessageWindowTab
w)
    ViewMessageWindowTab -> TabbedWindow ViewMessageWindowTab -> MH ()
forall a. (Eq a, Show a) => a -> TabbedWindow a -> MH ()
runTabShowHandlerFor (TabbedWindow ViewMessageWindowTab -> ViewMessageWindowTab
forall a. TabbedWindow a -> a
twValue TabbedWindow ViewMessageWindowTab
w) TabbedWindow ViewMessageWindowTab
w
    Mode -> MH ()
setMode Mode
ViewMessage

yankSelectedMessageVerbatim :: MH ()
yankSelectedMessageVerbatim :: MH ()
yankSelectedMessageVerbatim = 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 ChatState -> Maybe Message
getSelectedMessage)
    case Maybe Message
selectedMessage of
        Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Message
m -> do
            Mode -> MH ()
setMode Mode
Main
            case Blocks -> Maybe Text
findVerbatimChunk (Message
mMessage -> 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 ()

yankSelectedMessage :: MH ()
yankSelectedMessage :: MH ()
yankSelectedMessage = 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 ChatState -> Maybe Message
getSelectedMessage)
    case Maybe Message
selectedMessage of
        Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Message
m -> do
            Mode -> MH ()
setMode Mode
Main
            Text -> MH ()
copyToClipboard (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Message
mMessage -> Getting Text Message Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text Message Text
Lens' Message Text
mMarkdownSource

openSelectedMessageURLs :: MH ()
openSelectedMessageURLs :: MH ()
openSelectedMessageURLs = Mode -> MH () -> MH ()
whenMode Mode
MessageSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Message
mCurMsg <- 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 ChatState -> Maybe Message
getSelectedMessage)
    Message
curMsg <- case Maybe Message
mCurMsg of
        Maybe Message
Nothing -> [Char] -> MH Message
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: openSelectedMessageURLs: no selected message available"
        Just Message
m -> Message -> MH Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
m

    let urls :: Seq LinkChoice
urls = Message -> Seq LinkChoice
msgURLs Message
curMsg
    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
        Bool
openedAll <- Seq Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Seq Bool -> Bool) -> MH (Seq Bool) -> MH Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LinkChoice -> MH Bool) -> Seq LinkChoice -> MH (Seq Bool)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LinkTarget -> MH Bool
openLinkTarget (LinkTarget -> MH Bool)
-> (LinkChoice -> LinkTarget) -> LinkChoice -> MH Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkChoice -> LinkTarget
_linkTarget) Seq LinkChoice
urls
        case Bool
openedAll of
            Bool
True -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Bool
False ->
                MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
ConfigOptionMissing Text
"urlOpenCommand"

beginConfirmDeleteSelectedMessage :: MH ()
beginConfirmDeleteSelectedMessage :: MH ()
beginConfirmDeleteSelectedMessage = 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
    Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
    case Maybe Message
selected of
        Just Message
msg | Message -> Bool
isDeletable Message
msg Bool -> Bool -> Bool
&& ChatState -> Message -> Bool
isMine ChatState
st Message
msg ->
            Mode -> MH ()
setMode Mode
MessageSelectDeleteConfirm
        Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

messageSelectUp :: MH ()
messageSelectUp :: MH ()
messageSelectUp = do
    Mode
mode <- Getting Mode ChatState Mode -> MH Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode)
    Maybe MessageId
selected <- Getting (Maybe MessageId) ChatState (Maybe MessageId)
-> MH (Maybe MessageId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe MessageId) TeamState)
-> ChatState -> Const (Maybe MessageId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe MessageId) TeamState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> TeamState -> Const (Maybe MessageId) TeamState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
-> TeamState -> Const (Maybe MessageId) TeamState
Lens' TeamState MessageSelectState
tsMessageSelect((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> TeamState -> Const (Maybe MessageId) TeamState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> (Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
-> TeamState
-> Const (Maybe MessageId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Maybe MessageId)
-> SimpleGetter MessageSelectState (Maybe MessageId)
forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
    case Maybe MessageId
selected of
        Just MessageId
_ | Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
MessageSelect -> do
            Messages
chanMsgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages)
            let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getPrevMessageId Maybe MessageId
selected Messages
chanMsgs
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((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)
        Maybe MessageId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

messageSelectDown :: MH ()
messageSelectDown :: MH ()
messageSelectDown = do
    Maybe MessageId
selected <- Getting (Maybe MessageId) ChatState (Maybe MessageId)
-> MH (Maybe MessageId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe MessageId) TeamState)
-> ChatState -> Const (Maybe MessageId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe MessageId) TeamState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> TeamState -> Const (Maybe MessageId) TeamState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
-> TeamState -> Const (Maybe MessageId) TeamState
Lens' TeamState MessageSelectState
tsMessageSelect((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> TeamState -> Const (Maybe MessageId) TeamState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> (Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
-> TeamState
-> Const (Maybe MessageId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Maybe MessageId)
-> SimpleGetter MessageSelectState (Maybe MessageId)
forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
    case Maybe MessageId
selected of
        Just MessageId
_ -> Mode -> MH () -> MH ()
whenMode Mode
MessageSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Messages
chanMsgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages)
            let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getNextMessageId Maybe MessageId
selected Messages
chanMsgs
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((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)
        Maybe MessageId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

messageSelectDownBy :: Int -> MH ()
messageSelectDownBy :: Int -> MH ()
messageSelectDownBy Int
amt
    | Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        MH ()
messageSelectDown MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MH ()
messageSelectDownBy (Int
amt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

messageSelectUpBy :: Int -> MH ()
messageSelectUpBy :: Int -> MH ()
messageSelectUpBy Int
amt
    | Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
      MH ()
messageSelectUp MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MH ()
messageSelectUpBy (Int
amt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

messageSelectFirst :: MH ()
messageSelectFirst :: MH ()
messageSelectFirst = do
    Maybe MessageId
selected <- Getting (Maybe MessageId) ChatState (Maybe MessageId)
-> MH (Maybe MessageId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe MessageId) TeamState)
-> ChatState -> Const (Maybe MessageId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe MessageId) TeamState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> TeamState -> Const (Maybe MessageId) TeamState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
-> TeamState -> Const (Maybe MessageId) TeamState
Lens' TeamState MessageSelectState
tsMessageSelect((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> TeamState -> Const (Maybe MessageId) TeamState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> (Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
-> TeamState
-> Const (Maybe MessageId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Maybe MessageId)
-> SimpleGetter MessageSelectState (Maybe MessageId)
forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
    case Maybe MessageId
selected of
        Just MessageId
_ -> Mode -> MH () -> MH ()
whenMode Mode
MessageSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Messages
chanMsgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages)
            case Messages -> Maybe Message
getEarliestSelectableMessage Messages
chanMsgs of
              Just Message
firstMsg ->
                (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((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?!"
        Maybe MessageId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

messageSelectLast :: MH ()
messageSelectLast :: MH ()
messageSelectLast = do
    Maybe MessageId
selected <- Getting (Maybe MessageId) ChatState (Maybe MessageId)
-> MH (Maybe MessageId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe MessageId) TeamState)
-> ChatState -> Const (Maybe MessageId) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe MessageId) TeamState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> TeamState -> Const (Maybe MessageId) TeamState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
-> TeamState -> Const (Maybe MessageId) TeamState
Lens' TeamState MessageSelectState
tsMessageSelect((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> TeamState -> Const (Maybe MessageId) TeamState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> (Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
-> TeamState
-> Const (Maybe MessageId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Maybe MessageId)
-> SimpleGetter MessageSelectState (Maybe MessageId)
forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
    case Maybe MessageId
selected of
        Just MessageId
_ -> Mode -> MH () -> MH ()
whenMode Mode
MessageSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            Messages
chanMsgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages)
            case Messages -> Maybe Message
getLatestSelectableMessage Messages
chanMsgs of
              Just Message
lastSelMsg ->
                (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((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?!"
        Maybe MessageId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

deleteSelectedMessage :: MH ()
deleteSelectedMessage :: MH ()
deleteSelectedMessage = 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 ChatState -> Maybe Message
getSelectedMessage)
    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
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    case Maybe Message
selectedMessage of
        Just Message
msg | ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
msg ->
            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 ->
                  DoAsyncChannelMM ()
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
                      (\Session
s ChannelId
_ -> PostId -> Session -> IO ()
MM.mmDeletePost (Post -> PostId
postId Post
p) Session
s)
                      (\ChannelId
_ ()
_ -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                          (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> TeamState -> Identity TeamState)
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EditMode -> Identity EditMode)
    -> ChatEditState -> Identity ChatEditState)
-> (EditMode -> Identity EditMode)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EditMode
cedEditMode ((EditMode -> Identity EditMode)
 -> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditMode
NewPost
                          Mode -> MH ()
setMode Mode
Main)
              Maybe Post
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

beginReplyCompose :: MH ()
beginReplyCompose :: MH ()
beginReplyCompose = do
    Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
    case Maybe Message
selected of
        Just Message
msg | Message -> Bool
isReplyable Message
msg -> do
            Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
            let Just Post
p = 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
            Mode -> MH ()
setMode Mode
Main
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> TeamState -> Identity TeamState)
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EditMode -> Identity EditMode)
    -> ChatEditState -> Identity ChatEditState)
-> (EditMode -> Identity EditMode)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EditMode
cedEditMode ((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
        Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

beginEditMessage :: MH ()
beginEditMessage :: MH ()
beginEditMessage = do
    Maybe Message
selected <- 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 ChatState -> Maybe Message
getSelectedMessage)
    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
    case Maybe Message
selected of
        Just Message
msg | ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
msg -> do
            let Just Post
p = 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
            Mode -> MH ()
setMode Mode
Main
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
    -> TeamState -> Identity TeamState)
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((EditMode -> Identity EditMode)
    -> ChatEditState -> Identity ChatEditState)
-> (EditMode -> Identity EditMode)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState EditMode
cedEditMode ((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
            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> TeamState -> Identity TeamState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> ChatEditState -> Identity ChatEditState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Identity (Editor Text Name))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> ChatState -> Identity ChatState)
-> (Editor Text Name -> Editor Text Name) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
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)
        Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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