module Matterhorn.State.MessageSelect
(
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
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
EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
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)
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 ()
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)
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 ()
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
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