{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.MessageSelect
(
beginMessageSelect
, flagSelectedMessage
, pinSelectedMessage
, viewSelectedMessage
, openSelectedMessageInEditor
, 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 qualified Data.Text as T
import Data.Text.Zipper ( clearZipper, insertMany )
import Data.Maybe ( fromJust )
import Lens.Micro.Platform
import qualified System.Environment as Sys
import System.IO (hClose, hPutStr)
import qualified System.IO.Temp as Sys
import qualified System.Process as Sys
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 (MessageSelectState -> Maybe MessageId)
-> MessageSelectState -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting MessageSelectState ChatState MessageSelectState
-> MessageSelectState
forall s a. s -> Getting a s a -> a
^.(MessageInterface n i
-> Const MessageSelectState (MessageInterface n i))
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
-> Const MessageSelectState (MessageInterface n i))
-> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
-> Const MessageSelectState MessageSelectState)
-> MessageInterface n i
-> Const MessageSelectState (MessageInterface n i))
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> MessageInterface n i
-> Const MessageSelectState (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect
let chanMsgs :: Messages
chanMsgs = ChatState
stChatState -> Getting Messages ChatState Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 <- Getting (Maybe Message) ChatState (Maybe Message)
-> MH (Maybe Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatState -> Maybe Message)
-> SimpleGetter ChatState (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to (Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which))
case Maybe Message
selectedMessage of
Maybe Message
Nothing -> () -> MH ()
forall a. a -> MH a
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
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState ()
forall n s. Ord n => EventM n s ()
invalidateCache
Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
let recentMsg :: Maybe Message
recentMsg = Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Message -> Bool
forall a. Maybe a -> Bool
isJust Maybe Message
recentMsg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
MessageSelect
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe Message
recentMsg Maybe Message -> (Message -> Maybe MessageId) -> Maybe MessageId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 <- Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MH MessageInterfaceMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i
-> Const MessageInterfaceMode (MessageInterface n i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
-> Const MessageInterfaceMode (MessageInterface n i))
-> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
-> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface n i
-> Const MessageInterfaceMode (MessageInterface n i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
-> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface n i
-> Const MessageInterfaceMode (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MessageInterfaceMode
m MessageInterfaceMode -> MessageInterfaceMode -> Bool
forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose
flagSelectedMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
flagSelectedMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
flagSelectedMessage Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isFlaggable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
case Message -> Maybe PostId
messagePostId Message
msg of
Just PostId
pId -> PostId -> Bool -> MH ()
flagMessage PostId
pId (Bool -> Bool
not (Message
msgMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mFlagged))
Maybe PostId
Nothing -> () -> MH ()
forall a. a -> MH a
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPinnable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
case Message -> Maybe PostId
messagePostId Message
msg of
Just PostId
pId -> PostId -> Bool -> MH ()
pinMessage PostId
pId (Bool -> Bool
not (Message
msgMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mPinned))
Maybe PostId
Nothing -> () -> MH ()
forall a. a -> MH a
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Message -> Bool
isGap Message
msg)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
msg
openSelectedMessageInEditor :: Lens' ChatState (MessageInterface n i)
-> MH ()
openSelectedMessageInEditor :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageInEditor Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Message -> Bool
isGap Message
msg)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ Message -> Lens' ChatState (MessageInterface n i) -> MH ()
forall n i.
Message -> Lens' ChatState (MessageInterface n i) -> MH ()
openMessageInEditor Message
msg (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
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 <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const ChannelId (MessageInterface n i))
-> ChatState -> Const ChannelId ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const ChannelId (MessageInterface n i))
-> ChatState -> Const ChannelId ChatState)
-> ((ChannelId -> Const ChannelId ChannelId)
-> MessageInterface n i -> Const ChannelId (MessageInterface n i))
-> Getting ChannelId ChatState ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> MessageInterface n i -> Const ChannelId (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(ChannelId -> f ChannelId)
-> MessageInterface n i -> f (MessageInterface n i)
miChannelId)
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
msg
copyPostLink :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
copyPostLink :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
copyPostLink TeamId
tId Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
TeamBaseURL
baseUrl <- TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
let pId :: PostId
pId = Maybe PostId -> PostId
forall a. HasCallStack => Maybe a -> a
fromJust (MessageId -> Maybe PostId
messageIdPostId (MessageId -> Maybe PostId) -> Maybe MessageId -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Maybe MessageId
_mMessageId Message
msg)
Text -> MH ()
copyToClipboard (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamBaseURL -> PostId -> Text
makePermalink TeamBaseURL
baseUrl PostId
pId
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
viewMessage :: TeamId -> Message -> MH ()
viewMessage :: TeamId -> Message -> MH ()
viewMessage TeamId
tId Message
m = do
let w :: TabbedWindow ChatState MH Name ViewMessageWindowTab
w = ViewMessageWindowTab
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
-> (Int, Int)
-> TabbedWindow ChatState MH Name ViewMessageWindowTab
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
a
-> TabbedWindowTemplate s m n a
-> (Int, Int)
-> TabbedWindow s m n a
tabbedWindow ViewMessageWindowTab
VMTabMessage (TeamId
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId) (Int
78, Int
25)
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState)
-> ((Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Identity
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState -> Identity TeamState)
-> (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Identity
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Identity
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState -> Identity TeamState
Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage ((Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Identity
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> ChatState -> Identity ChatState)
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall a. a -> Maybe a
Just (Message
m, TabbedWindow ChatState MH Name ViewMessageWindowTab
w)
ViewMessageWindowTab
-> TabbedWindow ChatState MH Name ViewMessageWindowTab -> MH ()
forall a s (m :: * -> *) n.
(Eq a, Show a) =>
a -> TabbedWindow s m n a -> m ()
runTabShowHandlerFor (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> ViewMessageWindowTab
forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState MH Name ViewMessageWindowTab
w) TabbedWindow ChatState MH Name ViewMessageWindowTab
w
TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
ViewMessage
openMessageInEditor :: Message -> Lens' ChatState (MessageInterface n i) -> MH ()
openMessageInEditor :: forall n i.
Message -> Lens' ChatState (MessageInterface n i) -> MH ()
openMessageInEditor Message
m Lens' ChatState (MessageInterface n i)
which = do
Maybe String
mEnv <- IO (Maybe String) -> MH (Maybe String)
forall a. IO a -> MH a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> MH (Maybe String))
-> IO (Maybe String) -> MH (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Sys.lookupEnv String
"EDITOR"
let editorProgram :: String
editorProgram = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"vi" String -> String
forall a. a -> a
id Maybe String
mEnv
case Message
mMessage -> 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
Maybe Post
Nothing -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Post
p -> do
(ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume ((ChatState -> IO ChatState) -> MH ())
-> (ChatState -> IO ChatState) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChatState
s -> do
String -> (String -> Handle -> IO ChatState) -> IO ChatState
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
Sys.withSystemTempFile String
"matterhorn_editor.md" ((String -> Handle -> IO ChatState) -> IO ChatState)
-> (String -> Handle -> IO ChatState) -> IO ChatState
forall a b. (a -> b) -> a -> b
$ \String
tmpFileName Handle
tmpFileHandle -> do
Handle -> String -> IO ()
hPutStr Handle
tmpFileHandle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ UserText -> Text
unsafeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
p
Handle -> IO ()
hClose Handle
tmpFileHandle
IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ExitCode
Sys.system (String
editorProgram String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tmpFileName)
ChatState -> IO ChatState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
s
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
yankSelectedMessageVerbatim :: Lens' ChatState (MessageInterface n i)
-> MH ()
yankSelectedMessageVerbatim :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
yankSelectedMessageVerbatim Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
case Blocks -> Maybe Text
findVerbatimChunk (Message
msgMessage -> Getting Blocks Message Blocks -> Blocks
forall s a. s -> Getting a s a -> a
^.Getting Blocks Message Blocks
Lens' Message Blocks
mText) of
Just Text
txt -> Text -> MH ()
copyToClipboard Text
txt
Maybe Text
Nothing -> () -> MH ()
forall a. a -> MH a
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isPostMessage Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
rootMsgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
case Message
msgMessage
-> Getting (Maybe ChannelId) Message (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe ChannelId) Message (Maybe ChannelId)
Lens' Message (Maybe ChannelId)
mChannelId of
Maybe ChannelId
Nothing -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ChannelId
cId -> do
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
Text -> MH ()
copyToClipboard (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Message
msgMessage -> Getting Text Message Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text Message Text
Lens' Message Text
mMarkdownSource
openSelectedMessageURLs :: Lens' ChatState (MessageInterface n i)
-> MH ()
openSelectedMessageURLs :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedMessageURLs Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let urls :: Seq LinkChoice
urls = Message -> Seq LinkChoice
msgURLs Message
msg
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Seq LinkChoice -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq LinkChoice
urls)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
(LinkChoice -> MH ()) -> Seq LinkChoice -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LinkTarget -> MH ()
openLinkTarget (LinkTarget -> MH ())
-> (LinkChoice -> LinkTarget) -> LinkChoice -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkChoice -> LinkTarget
_linkTarget) Seq LinkChoice
urls
beginConfirmDeleteSelectedMessage :: TeamId
-> Lens' ChatState (MessageInterface n i)
-> MH ()
beginConfirmDeleteSelectedMessage :: forall n i.
TeamId -> Lens' ChatState (MessageInterface n i) -> MH ()
beginConfirmDeleteSelectedMessage TeamId
tId Lens' ChatState (MessageInterface n i)
which = do
ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
MessageInterfaceTarget
target <- Getting MessageInterfaceTarget ChatState MessageInterfaceTarget
-> MH MessageInterfaceTarget
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i
-> Const MessageInterfaceTarget (MessageInterface n i))
-> ChatState -> Const MessageInterfaceTarget ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
-> Const MessageInterfaceTarget (MessageInterface n i))
-> ChatState -> Const MessageInterfaceTarget ChatState)
-> ((MessageInterfaceTarget
-> Const MessageInterfaceTarget MessageInterfaceTarget)
-> MessageInterface n i
-> Const MessageInterfaceTarget (MessageInterface n i))
-> Getting MessageInterfaceTarget ChatState MessageInterfaceTarget
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceTarget
-> Const MessageInterfaceTarget MessageInterfaceTarget)
-> MessageInterface n i
-> Const MessageInterfaceTarget (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceTarget -> f MessageInterfaceTarget)
-> MessageInterface n i -> f (MessageInterface n i)
miTarget)
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isDeletable Message
msg Bool -> Bool -> Bool
&& ChatState -> Message -> Bool
isMine ChatState
st Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
TeamId -> Mode -> MH ()
pushMode TeamId
tId (Mode -> MH ()) -> Mode -> MH ()
forall a b. (a -> b) -> a -> b
$ MessageInterfaceTarget -> Mode
MessageSelectDeleteConfirm MessageInterfaceTarget
target
messageSelectUp :: Lens' ChatState (MessageInterface n i)
-> MH ()
messageSelectUp :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp Lens' ChatState (MessageInterface n i)
which =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getPrevMessageId Maybe MessageId
selected Messages
msgs
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall a. Maybe a -> Maybe a -> Maybe a
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
let nextMsgId :: Maybe MessageId
nextMsgId = Maybe MessageId -> Messages -> Maybe MessageId
getNextMessageId Maybe MessageId
selected Messages
msgs
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Maybe MessageId
nextMsgId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall a. Maybe a -> Maybe a -> Maybe a
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 =
Int -> MH () -> MH ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectDown (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
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 =
Int -> MH () -> MH ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
amt (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
messageSelectUp (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
case Messages -> Maybe Message
getEarliestSelectableMessage Messages
msgs of
Just Message
firstMsg ->
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
firstMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall a. Maybe a -> Maybe a -> Maybe a
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 =
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
let selected :: Maybe MessageId
selected = Message -> Maybe MessageId
_mMessageId Message
msg
Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
case Messages -> Maybe Message
getLatestSelectableMessage Messages
msgs of
Just Message
lastSelMsg ->
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageSelectState -> f MessageSelectState)
-> MessageInterface n i -> f (MessageInterface n i)
miMessageSelect ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
lastSelMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall a. Maybe a -> Maybe a -> Maybe a
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 <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
case Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost of
Just Post
p ->
AsyncPriority
-> (Session -> IO ()) -> (() -> Maybe (MH ())) -> MH ()
forall a.
AsyncPriority -> (Session -> IO a) -> (a -> Maybe (MH ())) -> MH ()
doAsyncMM AsyncPriority
Preempt
(\Session
s -> PostId -> Session -> IO ()
MM.mmDeletePost (Post -> PostId
postId Post
p) Session
s)
(Maybe (MH ()) -> () -> Maybe (MH ())
forall a b. a -> b -> a
const Maybe (MH ())
forall a. Maybe a
Nothing)
Maybe Post
Nothing -> () -> MH ()
forall a. a -> MH a
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
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isReplyable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Message
rootMsg <- Message -> MH Message
getReplyRootMessage Message
msg
let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
rootMsgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor((EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i))
-> ((EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n))
-> (EditMode -> Identity EditMode)
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n)
forall n (f :: * -> *).
Functor f =>
(EditMode -> f EditMode) -> EditState n -> f (EditState n)
esEditMode ((EditMode -> Identity EditMode)
-> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Post -> EditMode
Replying Message
rootMsg Post
p
beginEditMessage :: Lens' ChatState (MessageInterface n i)
-> MH ()
beginEditMessage :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginEditMessage Lens' ChatState (MessageInterface n i)
which = do
ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
forall n i.
Lens' ChatState (MessageInterface n i)
-> (Message -> MH ()) -> MH ()
withSelectedMessage (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which ((Message -> MH ()) -> MH ()) -> (Message -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Message
msg ->
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatState -> Message -> Bool
isMine ChatState
st Message
msg Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
let p :: Post
p = Maybe Post -> Post
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Post -> Post) -> Maybe Post -> Post
forall a b. (a -> b) -> a -> b
$ Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((EditMode -> Identity EditMode)
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (EditMode -> Identity EditMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor((EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i))
-> ((EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n))
-> (EditMode -> Identity EditMode)
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Identity EditMode)
-> EditState n -> Identity (EditState n)
forall n (f :: * -> *).
Functor f =>
(EditMode -> f EditMode) -> EditState n -> f (EditState n)
esEditMode ((EditMode -> Identity EditMode)
-> ChatState -> Identity ChatState)
-> EditMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Post -> MessageType -> EditMode
Editing Post
p (Message
msgMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
Lens' Message MessageType
mType)
let sanitized :: Text
sanitized = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
p
let toEdit :: Text
toEdit = if Message -> Bool
isEmote Message
msg
then Text -> Text
removeEmoteFormatting Text
sanitized
else Text
sanitized
(MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState)
-> ((Editor Text n -> Identity (Editor Text n))
-> MessageInterface n i -> Identity (MessageInterface n i))
-> (Editor Text n -> Identity (Editor Text n))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor((EditState n -> Identity (EditState n))
-> MessageInterface n i -> Identity (MessageInterface n i))
-> ((Editor Text n -> Identity (Editor Text n))
-> EditState n -> Identity (EditState n))
-> (Editor Text n -> Identity (Editor Text n))
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text n -> Identity (Editor Text n))
-> EditState n -> Identity (EditState n)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> EditState n -> f (EditState n)
esEditor ((Editor Text n -> Identity (Editor Text n))
-> ChatState -> Identity ChatState)
-> (Editor Text n -> Editor Text n) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (Text -> TextZipper Text -> TextZipper Text
forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany Text
toEdit (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper)
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing