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.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 =
[ MessageSelect
, MessageSelectDeleteConfirm
, ReactionEmojiListOverlay
]
getSelectedMessage :: ChatState -> Maybe Message
getSelectedMessage st
| not (appMode st `elem` messageSelectCompatibleModes) = Nothing
| otherwise = do
selMsgId <- selectMessageId $ st^.csMessageSelect
let chanMsgs = st ^. csCurrentChannel . ccContents . cdMessages
findMessage selMsgId chanMsgs
beginMessageSelect :: MH ()
beginMessageSelect = do
chanMsgs <- use(csCurrentChannel . ccContents . cdMessages)
let recentMsg = getLatestSelectableMessage chanMsgs
when (isJust recentMsg) $ do
setMode MessageSelect
csMessageSelect .= MessageSelectState (recentMsg >>= _mMessageId)
flagSelectedMessage :: MH ()
flagSelectedMessage = do
selected <- use (to getSelectedMessage)
case selected of
Just msg
| isFlaggable msg, Just pId <- messagePostId msg ->
flagMessage pId (not (msg^.mFlagged))
_ -> return ()
pinSelectedMessage :: MH ()
pinSelectedMessage = do
selected <- use (to getSelectedMessage)
case selected of
Just msg
| isPinnable msg, Just pId <- messagePostId msg ->
pinMessage pId (not (msg^.mPinned))
_ -> return ()
viewSelectedMessage :: MH ()
viewSelectedMessage = do
selected <- use (to getSelectedMessage)
case selected of
Just msg
| not (isGap msg) -> viewMessage msg
_ -> return ()
fillSelectedGap :: MH ()
fillSelectedGap = do
selected <- use (to getSelectedMessage)
case selected of
Just msg
| isGap msg -> do cId <- use csCurrentChannelId
asyncFetchMessagesForGap cId msg
_ -> return ()
viewMessage :: Message -> MH ()
viewMessage m = do
let w = tabbedWindow VMTabMessage viewMessageWindowTemplate MessageSelect (78, 25)
csViewedMessage .= Just (m, w)
runTabShowHandlerFor (twValue w) w
setMode ViewMessage
yankSelectedMessageVerbatim :: MH ()
yankSelectedMessageVerbatim = do
selectedMessage <- use (to getSelectedMessage)
case selectedMessage of
Nothing -> return ()
Just m -> do
setMode Main
case findVerbatimChunk (m^.mText) of
Just txt -> copyToClipboard txt
Nothing -> return ()
yankSelectedMessage :: MH ()
yankSelectedMessage = do
selectedMessage <- use (to getSelectedMessage)
case selectedMessage of
Nothing -> return ()
Just m -> do
setMode Main
copyToClipboard $ m^.mMarkdownSource
openSelectedMessageURLs :: MH ()
openSelectedMessageURLs = whenMode MessageSelect $ do
mCurMsg <- use (to getSelectedMessage)
curMsg <- case mCurMsg of
Nothing -> error "BUG: openSelectedMessageURLs: no selected message available"
Just m -> return m
let urls = msgURLs curMsg
when (not (null urls)) $ do
openedAll <- and <$> mapM (openLinkTarget . _linkTarget) urls
case openedAll of
True -> return ()
False ->
mhError $ ConfigOptionMissing "urlOpenCommand"
beginConfirmDeleteSelectedMessage :: MH ()
beginConfirmDeleteSelectedMessage = do
st <- use id
selected <- use (to getSelectedMessage)
case selected of
Just msg | isDeletable msg && isMine st msg ->
setMode MessageSelectDeleteConfirm
_ -> return ()
messageSelectUp :: MH ()
messageSelectUp = do
mode <- gets appMode
selected <- use (csMessageSelect.to selectMessageId)
case selected of
Just _ | mode == MessageSelect -> do
chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)
let nextMsgId = getPrevMessageId selected chanMsgs
csMessageSelect .= MessageSelectState (nextMsgId <|> selected)
_ -> return ()
messageSelectDown :: MH ()
messageSelectDown = do
selected <- use (csMessageSelect.to selectMessageId)
case selected of
Just _ -> whenMode MessageSelect $ do
chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)
let nextMsgId = getNextMessageId selected chanMsgs
csMessageSelect .= MessageSelectState (nextMsgId <|> selected)
_ -> return ()
messageSelectDownBy :: Int -> MH ()
messageSelectDownBy amt
| amt <= 0 = return ()
| otherwise =
messageSelectDown >> messageSelectDownBy (amt - 1)
messageSelectUpBy :: Int -> MH ()
messageSelectUpBy amt
| amt <= 0 = return ()
| otherwise =
messageSelectUp >> messageSelectUpBy (amt - 1)
messageSelectFirst :: MH ()
messageSelectFirst = do
selected <- use (csMessageSelect.to selectMessageId)
case selected of
Just _ -> whenMode MessageSelect $ do
chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)
case getEarliestSelectableMessage chanMsgs of
Just firstMsg ->
csMessageSelect .= MessageSelectState (firstMsg^.mMessageId <|> selected)
Nothing -> mhLog LogError "No first message found from current message?!"
_ -> return ()
messageSelectLast :: MH ()
messageSelectLast = do
selected <- use (csMessageSelect.to selectMessageId)
case selected of
Just _ -> whenMode MessageSelect $ do
chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)
case getLatestSelectableMessage chanMsgs of
Just lastSelMsg ->
csMessageSelect .= MessageSelectState (lastSelMsg^.mMessageId <|> selected)
Nothing -> mhLog LogError "No last message found from current message?!"
_ -> return ()
deleteSelectedMessage :: MH ()
deleteSelectedMessage = do
selectedMessage <- use (to getSelectedMessage)
st <- use id
cId <- use csCurrentChannelId
case selectedMessage of
Just msg | isMine st msg && isDeletable msg ->
case msg^.mOriginalPost of
Just p ->
doAsyncChannelMM Preempt cId
(\s _ -> MM.mmDeletePost (postId p) s)
(\_ _ -> Just $ do
csEditState.cedEditMode .= NewPost
setMode Main)
Nothing -> return ()
_ -> return ()
beginReplyCompose :: MH ()
beginReplyCompose = do
selected <- use (to getSelectedMessage)
case selected of
Just msg | isReplyable msg -> do
rootMsg <- getReplyRootMessage msg
let Just p = rootMsg^.mOriginalPost
setMode Main
csEditState.cedEditMode .= Replying rootMsg p
_ -> return ()
beginEditMessage :: MH ()
beginEditMessage = do
selected <- use (to getSelectedMessage)
st <- use id
case selected of
Just msg | isMine st msg && isEditable msg -> do
let Just p = msg^.mOriginalPost
setMode Main
csEditState.cedEditMode .= Editing p (msg^.mType)
let sanitized = sanitizeUserText $ postMessage p
let toEdit = if isEmote msg
then removeEmoteFormatting sanitized
else sanitized
csEditState.cedEditor %= applyEdit (insertMany toEdit . clearZipper)
_ -> return ()
flagMessage :: PostId -> Bool -> MH ()
flagMessage pId f = do
session <- getSession
myId <- gets myUserId
doAsyncWith Normal $ do
let doFlag = if f then MM.mmFlagPost else MM.mmUnflagPost
doFlag myId pId session
return Nothing
pinMessage :: PostId -> Bool -> MH ()
pinMessage pId f = do
session <- getSession
doAsyncWith Normal $ do
let doPin = if f then MM.mmPinPostToChannel else MM.mmUnpinPostToChannel
void $ doPin pId session
return Nothing