{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.MessageSelect
(
beginMessageSelect
, flagSelectedMessage
, pinSelectedMessage
, viewSelectedMessage
, fillSelectedGap
, copyPostLink
, yankSelectedMessageVerbatim
, yankSelectedMessage
, openSelectedMessageURLs
, beginConfirmDeleteSelectedMessage
, messageSelectUp
, messageSelectUpBy
, messageSelectDown
, messageSelectDownBy
, messageSelectFirst
, messageSelectLast
, deleteSelectedMessage
, beginReplyCompose
, beginEditMessage
, flagMessage
, getSelectedMessage
, openThreadWindow
, exitMessageSelect
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick ( invalidateCache )
import Brick.Widgets.Edit ( applyEdit )
import Control.Monad ( replicateM_ )
import Data.Text.Zipper ( clearZipper, insertMany )
import Data.Maybe ( fromJust )
import Lens.Micro.Platform
import qualified Network.Mattermost.Endpoints as MM
import Network.Mattermost.Types
import Matterhorn.Clipboard ( copyToClipboard )
import Matterhorn.State.Common
import Matterhorn.State.Links
import {-# SOURCE #-} Matterhorn.State.Messages ( asyncFetchMessagesForGap )
import Matterhorn.Types
import Matterhorn.Types.RichText ( findVerbatimChunk, makePermalink )
import Matterhorn.Types.Common
import Matterhorn.Windows.ViewMessage
import qualified Matterhorn.State.ThreadWindow as TW
getSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> ChatState
-> Maybe Message
getSelectedMessage :: forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface n i)
which ChatState
st = do
MessageId
selMsgId <- MessageSelectState -> Maybe MessageId
selectMessageId forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect
let chanMsgs :: Messages
chanMsgs = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
MessageId -> Messages -> Maybe Message
findMessage MessageId
selMsgId Messages
chanMsgs
withSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> (Message -> MH ())
-> MH ()
withSelectedMessage :: forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which Message -> MH ()
act = do
Maybe Message
selectedMessage <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall s a. (s -> a) -> SimpleGetter s a
to (forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface n i)
which))
case Maybe Message
selectedMessage of
Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
m -> Message -> MH ()
act Message
m
beginMessageSelect :: Lens' ChatState (MessageInterface n i)
-> MH ()
beginMessageSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect Lens' ChatState (MessageInterface n i)
which = do
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
let recentMsg :: Maybe Message
recentMsg = Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Message
recentMsg) forall a b. (a -> b) -> a -> b
$ do
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
MessageSelect
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe Message
recentMsg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> Maybe MessageId
_mMessageId)
exitMessageSelect :: Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which = do
MessageInterfaceMode
m <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MessageInterfaceMode
m forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect) forall a b. (a -> b) -> a -> b
$
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose
flagSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
flagSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
flagSelectedMessage Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isFlaggable Message
msg) forall a b. (a -> b) -> a -> b
$ do
case Message -> Maybe PostId
messagePostId Message
msg of
Just PostId
pId -> PostId -> Bool -> MH ()
flagMessage PostId
pId (Bool -> Bool
not (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mFlagged))
Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
pinSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
pinSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
pinSelectedMessage Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPinnable Message
msg) forall a b. (a -> b) -> a -> b
$ do
case Message -> Maybe PostId
messagePostId Message
msg of
Just PostId
pId -> PostId -> Bool -> MH ()
pinMessage PostId
pId (Bool -> Bool
not (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mPinned))
Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
viewSelectedMessage :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
viewSelectedMessage :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
viewSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Message -> Bool
isGap Message
msg)) forall a b. (a -> b) -> a -> b
$ TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
msg
fillSelectedGap :: Lens' ChatState (MessageInterface n i)
-> MH ()
fillSelectedGap :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
fillSelectedGap Lens' ChatState (MessageInterface n i)
which = do
ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
msg) forall a b. (a -> b) -> a -> b
$ ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
msg
copyPostLink :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
copyPostLink :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
copyPostLink TeamId
tId Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) forall a b. (a -> b) -> a -> b
$ do
TeamBaseURL
baseUrl <- TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
let pId :: PostId
pId = forall a. HasCallStack => Maybe a -> a
fromJust (MessageId -> Maybe PostId
messageIdPostId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Maybe MessageId
_mMessageId Message
msg)
Text -> MH ()
copyToClipboard forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> PostId -> Text
makePermalink TeamBaseURL
baseUrl PostId
pId
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
viewMessage :: TeamId -> Message -> MH ()
viewMessage :: TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
m = do
let w :: TabbedWindow ChatState MH Name ViewMessageWindowTab
w = forall a s (m :: * -> *) n.
(Show a, Eq a) =>
a
-> TabbedWindowTemplate s m n a
-> (Int, Int)
-> TabbedWindow s m n a
tabbedWindow ViewMessageWindowTab
VMTabMessage (TeamId
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId) (Int
78, Int
25)
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Message
m, TabbedWindow ChatState MH Name ViewMessageWindowTab
w)
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState MH Name ViewMessageWindowTab
w) TabbedWindow ChatState MH Name ViewMessageWindowTab
w
TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
ViewMessage
yankSelectedMessageVerbatim :: Lens' ChatState (MessageInterface n i)
-> MH ()
yankSelectedMessageVerbatim :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessageVerbatim Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
case Blocks -> Maybe Text
findVerbatimChunk (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Blocks
mText) of
Just Text
txt -> Text -> MH ()
copyToClipboard Text
txt
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
openThreadWindow :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
openThreadWindow :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
openThreadWindow TeamId
tId Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) forall a b. (a -> b) -> a -> b
$ do
Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId of
Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
cId -> do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
TeamId -> ChannelId -> PostId -> MH ()
TW.openThreadWindow TeamId
tId ChannelId
cId (Post -> PostId
postId Post
p)
yankSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
yankSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessage Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
Text -> MH ()
copyToClipboard forall a b. (a -> b) -> a -> b
$ Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Text
mMarkdownSource
openSelectedMessageURLs :: Lens' ChatState (MessageInterface n i)
-> MH ()
openSelectedMessageURLs :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageURLs Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let urls :: Seq LinkChoice
urls = Message -> Seq LinkChoice
msgURLs Message
msg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq LinkChoice
urls)) forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LinkTarget -> MH ()
openLinkTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkChoice -> LinkTarget
_linkTarget) Seq LinkChoice
urls
beginConfirmDeleteSelectedMessage :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
beginConfirmDeleteSelectedMessage :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
beginConfirmDeleteSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which = do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
MessageInterfaceTarget
target <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceTarget
miTarget)
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isDeletable Message
msg Bool -> Bool -> Bool
&& ChatState -> Message -> Bool
isMine ChatState
st Message
msg) forall a b. (a -> b) -> a -> b
$
TeamId -> Mode -> MH ()
pushMode TeamId
tId forall a b. (a -> b) -> a -> b
$ MessageInterfaceTarget -> Mode
MessageSelectDeleteConfirm MessageInterfaceTarget
target
messageSelectUp :: Lens' ChatState (MessageInterface n i)
-> MH ()
messageSelectUp :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getPrevMessageId Maybe MessageId
selected Messages
msgs
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
messageSelectDown :: Lens' ChatState (MessageInterface n i)
-> MH ()
messageSelectDown :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getNextMessageId Maybe MessageId
selected Messages
msgs
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
messageSelectDownBy :: Lens' ChatState (MessageInterface n i)
-> Int
-> MH ()
messageSelectDownBy :: forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectDownBy Lens' ChatState (MessageInterface n i)
which Int
amt =
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt forall a b. (a -> b) -> a -> b
$ forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown Lens' ChatState (MessageInterface n i)
which
messageSelectUpBy :: Lens' ChatState (MessageInterface n i)
-> Int
-> MH ()
messageSelectUpBy :: forall n i. Lens' ChatState (MessageInterface n i) -> Int -> MH ()
messageSelectUpBy Lens' ChatState (MessageInterface n i)
which Int
amt =
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt forall a b. (a -> b) -> a -> b
$ forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which
messageSelectFirst :: Lens' ChatState (MessageInterface n i)
-> MH ()
messageSelectFirst :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectFirst Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
case Messages -> Maybe Message
getEarliestSelectableMessage Messages
msgs of
Just Message
firstMsg ->
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
firstMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
Maybe Message
Nothing -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError Text
"No first message found from current message?!"
messageSelectLast :: Lens' ChatState (MessageInterface n i)
-> MH ()
messageSelectLast :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectLast Lens' ChatState (MessageInterface n i)
which =
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
case Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs of
Just Message
lastSelMsg ->
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
lastSelMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
selected)
Maybe Message
Nothing -> LogCategory -> Text -> MH ()
mhLog LogCategory
LogError Text
"No last message found from current message?!"
deleteSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
deleteSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
deleteSelectedMessage Lens' ChatState (MessageInterface n i)
which = do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
msg) forall a b. (a -> b) -> a -> b
$ do
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost of
Just Post
p ->
forall a.
AsyncPriority -> (Session -> IO a) -> (a -> Maybe (MH ())) -> MH ()
doAsyncMM AsyncPriority
Preempt
(\Session
s -> PostId -> Session -> IO ()
MM.mmDeletePost (Post -> PostId
postId Post
p) Session
s)
(forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
Maybe Post
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
beginReplyCompose :: Lens' ChatState (MessageInterface n i)
-> MH ()
beginReplyCompose :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginReplyCompose Lens' ChatState (MessageInterface n i)
which = do
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isReplyable Message
msg) forall a b. (a -> b) -> a -> b
$ do
Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
rootMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Post -> EditMode
Replying Message
rootMsg Post
p
beginEditMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
beginEditMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginEditMessage Lens' ChatState (MessageInterface n i)
which = do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage Lens' ChatState (MessageInterface n i)
which forall a b. (a -> b) -> a -> b
$ \Message
msg ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
msg) forall a b. (a -> b) -> a -> b
$ do
let p :: Post
p = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect Lens' ChatState (MessageInterface n i)
which
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Post -> MessageType -> EditMode
Editing Post
p (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType)
let sanitized :: Text
sanitized = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
p
let toEdit :: Text
toEdit = if Message -> Bool
isEmote Message
msg
then Text -> Text
removeEmoteFormatting Text
sanitized
else Text
sanitized
Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
toEdit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper)
flagMessage :: PostId -> Bool -> MH ()
flagMessage :: PostId -> Bool -> MH ()
flagMessage PostId
pId Bool
f = do
Session
session <- MH Session
getSession
UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
let doFlag :: UserId -> PostId -> Session -> IO ()
doFlag = if Bool
f then UserId -> PostId -> Session -> IO ()
MM.mmFlagPost else UserId -> PostId -> Session -> IO ()
MM.mmUnflagPost
UserId -> PostId -> Session -> IO ()
doFlag UserId
myId PostId
pId Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
pinMessage :: PostId -> Bool -> MH ()
pinMessage :: PostId -> Bool -> MH ()
pinMessage PostId
pId Bool
f = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
let doPin :: PostId -> Session -> IO StatusOK
doPin = if Bool
f then PostId -> Session -> IO StatusOK
MM.mmPinPostToChannel else PostId -> Session -> IO StatusOK
MM.mmUnpinPostToChannel
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO StatusOK
doPin PostId
pId Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing