module Matterhorn.State.Common
  (
  -- * System interface
    openFilePath
  , openWithOpener
  , runLoggedCommand
  , fetchFile
  , fetchFileAtPath

  -- * Posts
  , installMessagesFromPosts
  , updatePostMap

  -- * Utilities
  , postInfoMessage
  , postErrorMessageIO
  , postErrorMessage'
  , addEmoteFormatting
  , removeEmoteFormatting
  , toggleMouseMode

  , fetchMentionedUsers
  , doPendingUserFetches
  , doPendingUserStatusFetches

  , setThreadOrientationByName

  -- Cache management
  , invalidateChannelRenderingCache
  , invalidateMessageRenderingCacheByPostId

  , module Matterhorn.State.Async
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( invalidateCacheEntry, invalidateCache, getVtyHandle )
import           Control.Concurrent ( MVar, putMVar, forkIO )
import qualified Control.Concurrent.STM as STM
import           Control.Exception ( SomeException, try )
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( (.=), (%=), (%~), (.~) )
import           System.Directory ( createDirectoryIfMissing )
import           System.Environment.XDG.BaseDir ( getUserCacheDir )
import           System.Exit ( ExitCode(..) )
import           System.FilePath
import           System.IO ( hGetContents, hFlush, hPutStrLn )
import           System.Process ( proc, std_in, std_out, std_err, StdStream(..)
                                , createProcess, waitForProcess )

import           Network.Mattermost.Endpoints
import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           Matterhorn.FilePaths ( xdgName )
import           Matterhorn.State.Async
import           Matterhorn.Types
import           Matterhorn.Types.Common


-- * Client Messages

-- | Given a collection of posts from the server, save the posts in the
-- global post map. Also convert the posts to Matterhorn's Message type
-- and return them along with the set of all usernames mentioned in the
-- text of the resulting messages.
--
-- This also sets the mFlagged field of each message based on whether
-- its post ID is a flagged post according to crFlaggedPosts at the time
-- of this call.
installMessagesFromPosts :: Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts :: Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts Maybe TeamId
mTId Posts
postCollection = do
  Set PostId
flags <- Getting (Set PostId) ChatState (Set PostId) -> MH (Set PostId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Set PostId) ChatResources)
-> ChatState -> Const (Set PostId) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Set PostId) ChatResources)
 -> ChatState -> Const (Set PostId) ChatState)
-> ((Set PostId -> Const (Set PostId) (Set PostId))
    -> ChatResources -> Const (Set PostId) ChatResources)
-> Getting (Set PostId) ChatState (Set PostId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set PostId -> Const (Set PostId) (Set PostId))
-> ChatResources -> Const (Set PostId) ChatResources
Lens' ChatResources (Set PostId)
crFlaggedPosts)

  -- Add all posts in this collection to the global post cache
  Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
postCollection

  Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
      Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
      Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

  -- Build the ordered list of posts. Note that postsOrder lists the
  -- posts most recent first, but we want most recent last.
  let postsInOrder :: Seq Post
postsInOrder = PostId -> Post
findPost (PostId -> Post) -> Seq PostId -> Seq Post
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Seq PostId -> Seq PostId
forall a. Seq a -> Seq a
Seq.reverse (Seq PostId -> Seq PostId) -> Seq PostId -> Seq PostId
forall a b. (a -> b) -> a -> b
$ Posts -> Seq PostId
postsOrder Posts
postCollection)
      mkClientPost :: Post -> ClientPost
mkClientPost Post
p = Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
p (Post -> PostId
postId (Post -> PostId) -> Maybe Post -> Maybe PostId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Post -> Maybe Post
parent Post
p)
      clientPosts :: Seq ClientPost
clientPosts = Post -> ClientPost
mkClientPost (Post -> ClientPost) -> Seq Post -> Seq ClientPost
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Post
postsInOrder

      addNext :: ClientPost -> (a, Set MentionedUser) -> (a, Set MentionedUser)
addNext ClientPost
cp (a
msgs, Set MentionedUser
us) =
          let (Message
msg, Set MentionedUser
mUsernames) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp
          in (Message -> a -> a
forall a. MessageOps a => Message -> a -> a
addMessage (Set PostId -> Message -> Message
maybeFlag Set PostId
flags Message
msg) a
msgs, Set MentionedUser -> Set MentionedUser -> Set MentionedUser
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set MentionedUser
us Set MentionedUser
mUsernames)
      (Messages
ms, Set MentionedUser
mentions) = (ClientPost
 -> (Messages, Set MentionedUser) -> (Messages, Set MentionedUser))
-> (Messages, Set MentionedUser)
-> Seq ClientPost
-> (Messages, Set MentionedUser)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ClientPost
-> (Messages, Set MentionedUser) -> (Messages, Set MentionedUser)
forall a.
MessageOps a =>
ClientPost -> (a, Set MentionedUser) -> (a, Set MentionedUser)
addNext (Messages
noMessages, Set MentionedUser
forall a. Monoid a => a
mempty) Seq ClientPost
clientPosts

  Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentions
  Messages -> MH Messages
forall (m :: * -> *) a. Monad m => a -> m a
return Messages
ms
    where
        maybeFlag :: Set PostId -> Message -> Message
maybeFlag Set PostId
flagSet Message
msg
          | Just (MessagePostId PostId
pId) <- Message
msgMessage
-> 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, PostId
pId PostId -> Set PostId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PostId
flagSet
            = Message
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool) -> Message -> Identity Message)
-> Bool -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
          | Bool
otherwise = Message
msg
        parent :: Post -> Maybe Post
parent Post
x = do
            PostId
parentId <- Post
xPost -> Getting (Maybe PostId) Post (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) Post (Maybe PostId)
Lens' Post (Maybe PostId)
postRootIdL
            PostId -> HashMap PostId Post -> Maybe Post
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup PostId
parentId (Posts
postCollectionPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL)
        findPost :: PostId -> Post
findPost PostId
pId = case PostId -> HashMap PostId Post -> Maybe Post
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup PostId
pId (Posts -> HashMap PostId Post
postsPosts Posts
postCollection) of
            Maybe Post
Nothing -> [Char] -> Post
forall a. HasCallStack => [Char] -> a
error ([Char] -> Post) -> [Char] -> Post
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: could not find post for post ID " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> PostId -> [Char]
forall a. Show a => a -> [Char]
show PostId
pId
            Just Post
post -> Post
post

-- Add all posts in this collection to the global post cache
updatePostMap :: Maybe TeamId -> Posts -> MH ()
updatePostMap :: Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
postCollection = do
  -- Build a map from post ID to Matterhorn message, then add the new
  -- messages to the global post map. We use the "postsPosts" field for
  -- this because that might contain more messages than the "postsOrder"
  -- list, since the former can contain other messages in threads that
  -- the server sent us, even if those messages are not part of the
  -- ordered post listing of "postsOrder."
  Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
      Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
      Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

  let postMap :: HashMap PostId Message
postMap = [(PostId, Message)] -> HashMap PostId Message
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
          [ ( PostId
pId
            , (Message, Set MentionedUser) -> Message
forall a b. (a, b) -> a
fst ((Message, Set MentionedUser) -> Message)
-> (Message, Set MentionedUser) -> Message
forall a b. (a -> b) -> a -> b
$ ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
x Maybe PostId
forall a. Maybe a
Nothing)
            )
          | (PostId
pId, Post
x) <- HashMap PostId Post -> [(PostId, Post)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (Posts
postCollectionPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL)
          ]
  (HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap ((HashMap PostId Message -> Identity (HashMap PostId Message))
 -> ChatState -> Identity ChatState)
-> (HashMap PostId Message -> HashMap PostId Message) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= HashMap PostId Message
-> HashMap PostId Message -> HashMap PostId Message
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap PostId Message
postMap

-- | Add a 'ClientMessage' to the current channel's message list
addClientMessage :: ClientMessage -> MH ()
addClientMessage :: ClientMessage -> MH ()
addClientMessage ClientMessage
msg = do
    (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
        TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cid ClientChannel
_ -> do
            UUID
uuid <- MH UUID
generateUUID
            let addCMsg :: ClientChannel -> ClientChannel
addCMsg = (MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
                    (Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage (Message -> Messages -> Messages)
-> Message -> Messages -> Messages
forall a b. (a -> b) -> a -> b
$ ClientMessage -> Message
clientMessageToMessage ClientMessage
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Maybe MessageId -> Identity (Maybe MessageId))
-> Message -> Identity Message
Lens' Message (Maybe MessageId)
mMessageId ((Maybe MessageId -> Identity (Maybe MessageId))
 -> Message -> Identity Message)
-> Maybe MessageId -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (UUID -> MessageId
MessageUUID UUID
uuid))
            (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cid ClientChannel -> ClientChannel
addCMsg

            ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cid
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId

            let msgTy :: LogCategory
msgTy = case ClientMessage
msgClientMessage
-> Getting ClientMessageType ClientMessage ClientMessageType
-> ClientMessageType
forall s a. s -> Getting a s a -> a
^.Getting ClientMessageType ClientMessage ClientMessageType
Lens' ClientMessage ClientMessageType
cmType of
                  ClientMessageType
Error -> LogCategory
LogError
                  ClientMessageType
_     -> LogCategory
LogGeneral

            LogCategory -> Text -> MH ()
mhLog LogCategory
msgTy (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ClientMessage -> [Char]
forall a. Show a => a -> [Char]
show ClientMessage
msg

-- | Add a new 'ClientMessage' representing an error message to
--   the current channel's message list
postInfoMessage :: Text -> MH ()
postInfoMessage :: Text -> MH ()
postInfoMessage Text
info =
    ClientMessage -> MH ()
addClientMessage (ClientMessage -> MH ()) -> MH ClientMessage -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientMessageType -> Text -> MH ClientMessage
forall (m :: * -> *).
MonadIO m =>
ClientMessageType -> Text -> m ClientMessage
newClientMessage ClientMessageType
Informative (Text -> Text
sanitizeUserText' Text
info)

-- | Add a new 'ClientMessage' representing an error message to
--   the current channel's message list
postErrorMessage' :: Text -> MH ()
postErrorMessage' :: Text -> MH ()
postErrorMessage' Text
err =
    ClientMessage -> MH ()
addClientMessage (ClientMessage -> MH ()) -> MH ClientMessage -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientMessageType -> Text -> MH ClientMessage
forall (m :: * -> *).
MonadIO m =>
ClientMessageType -> Text -> m ClientMessage
newClientMessage ClientMessageType
Error (Text -> Text
sanitizeUserText' Text
err)

postErrorMessageIO :: Text -> ChatState -> IO ChatState
postErrorMessageIO :: Text -> ChatState -> IO ChatState
postErrorMessageIO Text
err ChatState
st = do
  case ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId of
      Maybe TeamId
Nothing -> ChatState -> IO ChatState
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
st
      Just TeamId
tId -> do
          case ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId) of
              Maybe ChannelId
Nothing -> ChatState -> IO ChatState
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
st
              Just ChannelId
cId -> do
                  ClientMessage
msg <- ClientMessageType -> Text -> IO ClientMessage
forall (m :: * -> *).
MonadIO m =>
ClientMessageType -> Text -> m ClientMessage
newClientMessage ClientMessageType
Error Text
err
                  UUID
uuid <- IO UUID
generateUUID_IO
                  let addEMsg :: ClientChannel -> ClientChannel
addEMsg = (MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
                          (Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage (Message -> Messages -> Messages)
-> Message -> Messages -> Messages
forall a b. (a -> b) -> a -> b
$ ClientMessage -> Message
clientMessageToMessage ClientMessage
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Maybe MessageId -> Identity (Maybe MessageId))
-> Message -> Identity Message
Lens' Message (Maybe MessageId)
mMessageId ((Maybe MessageId -> Identity (Maybe MessageId))
 -> Message -> Identity Message)
-> Maybe MessageId -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (UUID -> MessageId
MessageUUID UUID
uuid))
                  ChatState -> IO ChatState
forall (m :: * -> *) a. Monad m => a -> m a
return (ChatState -> IO ChatState) -> ChatState -> IO ChatState
forall a b. (a -> b) -> a -> b
$ ChatState
st ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId ClientChannel -> ClientChannel
addEMsg

openFilePath :: FilePath -> MH ()
openFilePath :: [Char] -> MH ()
openFilePath [Char]
path = MH (Either MHError [Char]) -> MH ()
openWithOpener (Either MHError [Char] -> MH (Either MHError [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MHError [Char] -> MH (Either MHError [Char]))
-> Either MHError [Char] -> MH (Either MHError [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either MHError [Char]
forall a b. b -> Either a b
Right [Char]
path)

openWithOpener :: MH (Either MHError String) -> MH ()
openWithOpener :: MH (Either MHError [Char]) -> MH ()
openWithOpener MH (Either MHError [Char])
getTarget = do
    Config
cfg <- Getting Config ChatState Config -> MH Config
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration)
    case Config -> Maybe Text
configURLOpenCommand Config
cfg of
        Maybe Text
Nothing ->
            MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
ConfigOptionMissing Text
"urlOpenCommand"
        Just Text
urlOpenCommand -> do
            Either MHError [Char]
targetResult <- MH (Either MHError [Char])
getTarget

            case Either MHError [Char]
targetResult of
                Left MHError
e -> do
                    MHError -> MH ()
mhError MHError
e
                Right [Char]
target -> do
                    -- Is the URL-opening command interactive? If
                    -- so, pause Matterhorn and run the opener
                    -- interactively. Otherwise run the opener
                    -- asynchronously and continue running Matterhorn
                    -- interactively.
                    case Config -> Bool
configURLOpenCommandInteractive Config
cfg of
                        Bool
False -> do
                            TChan ProgramOutput
outputChan <- Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
-> MH (TChan ProgramOutput)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan ProgramOutput) ChatResources)
 -> ChatState -> Const (TChan ProgramOutput) ChatState)
-> ((TChan ProgramOutput
     -> Const (TChan ProgramOutput) (TChan ProgramOutput))
    -> ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan ProgramOutput
 -> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
                            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                                TChan ProgramOutput
-> [Char]
-> [[Char]]
-> Maybe [Char]
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> [Char]
T.unpack Text
urlOpenCommand)
                                                 [[Char]
target] Maybe [Char]
forall a. Maybe a
Nothing Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
                                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
                        Bool
True -> do
                            -- If there isn't a new message cutoff
                            -- showing in the current channel, set one.
                            -- This way, while the user is gone using
                            -- their interactive URL opener, when they
                            -- return, any messages that arrive in the
                            -- current channel will be displayed as new.
                            (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
                                TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
curChan -> do
                                    let msgs :: Messages
msgs = ClientChannel
curChanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages
                                    case (Message -> Bool) -> Messages -> Maybe Message
findLatestUserMessage Message -> Bool
isEditable Messages
msgs of
                                        Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                        Just Message
m ->
                                            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 (m :: * -> *) a. Monad m => a -> m a
return ()
                                                Just Post
p ->
                                                    case ClientChannel
curChanClientChannel
-> Getting NewMessageIndicator ClientChannel NewMessageIndicator
-> NewMessageIndicator
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const NewMessageIndicator ChannelInfo)
-> ClientChannel -> Const NewMessageIndicator ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const NewMessageIndicator ChannelInfo)
 -> ClientChannel -> Const NewMessageIndicator ClientChannel)
-> ((NewMessageIndicator
     -> Const NewMessageIndicator NewMessageIndicator)
    -> ChannelInfo -> Const NewMessageIndicator ChannelInfo)
-> Getting NewMessageIndicator ClientChannel NewMessageIndicator
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NewMessageIndicator
 -> Const NewMessageIndicator NewMessageIndicator)
-> ChannelInfo -> Const NewMessageIndicator ChannelInfo
Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator of
                                                        NewMessageIndicator
Hide -> ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((NewMessageIndicator -> Identity NewMessageIndicator)
    -> ClientChannel -> Identity ClientChannel)
-> (NewMessageIndicator -> Identity NewMessageIndicator)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((NewMessageIndicator -> Identity NewMessageIndicator)
    -> ChannelInfo -> Identity ChannelInfo)
-> (NewMessageIndicator -> Identity NewMessageIndicator)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NewMessageIndicator -> Identity NewMessageIndicator)
-> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator ((NewMessageIndicator -> Identity NewMessageIndicator)
 -> ChatState -> Identity ChatState)
-> NewMessageIndicator -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (ServerTime -> NewMessageIndicator
NewPostsAfterServerTime (Post
pPost -> Getting ServerTime Post ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime Post ServerTime
Lens' Post ServerTime
postCreateAtL))
                                                        NewMessageIndicator
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                            -- No need to add a gap here: the websocket
                            -- disconnect/reconnect events will automatically
                            -- handle management of messages delivered while
                            -- suspended.
                            (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume ((ChatState -> IO ChatState) -> MH ())
-> (ChatState -> IO ChatState) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChatState
st -> do
                                Either [Char] ExitCode
result <- [Char] -> [[Char]] -> IO (Either [Char] ExitCode)
runInteractiveCommand (Text -> [Char]
T.unpack Text
urlOpenCommand) [[Char]
target]

                                let waitForKeypress :: IO ()
waitForKeypress = do
                                        [Char] -> IO ()
putStrLn [Char]
"Press any key to return to Matterhorn."
                                        IO Char -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Char
getChar

                                case Either [Char] ExitCode
result of
                                    Right ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                    Left [Char]
err -> do
                                        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"URL opener subprocess " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
urlOpenCommand) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                                                   [Char]
" could not be run: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err
                                        IO ()
waitForKeypress
                                    Right (ExitFailure Int
code) -> do
                                        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"URL opener subprocess " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
forall a. Show a => a -> [Char]
show Text
urlOpenCommand) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                                                   [Char]
" exited with non-zero status " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
code
                                        IO ()
waitForKeypress

                                ChatState -> IO ChatState
forall (m :: * -> *) a. Monad m => a -> m a
return (ChatState -> IO ChatState) -> ChatState -> IO ChatState
forall a b. (a -> b) -> a -> b
$ case ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId of
                                    Maybe TeamId
Nothing -> ChatState
st
                                    Just TeamId
tId -> TeamId -> Mode -> ChatState -> ChatState
pushMode' TeamId
tId Mode
Main ChatState
st

runInteractiveCommand :: String
                      -> [String]
                      -> IO (Either String ExitCode)
runInteractiveCommand :: [Char] -> [[Char]] -> IO (Either [Char] ExitCode)
runInteractiveCommand [Char]
cmd [[Char]]
args = do
    let opener :: CreateProcess
opener = ([Char] -> [[Char]] -> CreateProcess
proc [Char]
cmd [[Char]]
args) { std_in :: StdStream
std_in = StdStream
Inherit
                                 , std_out :: StdStream
std_out = StdStream
Inherit
                                 , std_err :: StdStream
std_err = StdStream
Inherit
                                 }
    Either
  SomeException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
result <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        SomeException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> IO
      (Either
         SomeException
         (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        SomeException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
opener
    case Either
  SomeException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
result of
        Left (SomeException
e::SomeException) -> Either [Char] ExitCode -> IO (Either [Char] ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ExitCode -> IO (Either [Char] ExitCode))
-> Either [Char] ExitCode -> IO (Either [Char] ExitCode)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ExitCode
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ExitCode)
-> [Char] -> Either [Char] ExitCode
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
        Right (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) -> do
            ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
            Either [Char] ExitCode -> IO (Either [Char] ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] ExitCode -> IO (Either [Char] ExitCode))
-> Either [Char] ExitCode -> IO (Either [Char] ExitCode)
forall a b. (a -> b) -> a -> b
$ ExitCode -> Either [Char] ExitCode
forall a b. b -> Either a b
Right ExitCode
ec

runLoggedCommand :: STM.TChan ProgramOutput
                 -- ^ The output channel to send the output to
                 -> String
                 -- ^ The program name
                 -> [String]
                 -- ^ Arguments
                 -> Maybe String
                 -- ^ The stdin to send, if any
                 -> Maybe (MVar ProgramOutput)
                 -- ^ Where to put the program output when it is ready
                 -> IO ()
runLoggedCommand :: TChan ProgramOutput
-> [Char]
-> [[Char]]
-> Maybe [Char]
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan [Char]
cmd [[Char]]
args Maybe [Char]
mInput Maybe (MVar ProgramOutput)
mOutputVar = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    let stdIn :: StdStream
stdIn = StdStream -> ([Char] -> StdStream) -> Maybe [Char] -> StdStream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StdStream
NoStream (StdStream -> [Char] -> StdStream
forall a b. a -> b -> a
const StdStream
CreatePipe) Maybe [Char]
mInput
        opener :: CreateProcess
opener = ([Char] -> [[Char]] -> CreateProcess
proc [Char]
cmd [[Char]]
args) { std_in :: StdStream
std_in = StdStream
stdIn
                                 , std_out :: StdStream
std_out = StdStream
CreatePipe
                                 , std_err :: StdStream
std_err = StdStream
CreatePipe
                                 }
    Either
  SomeException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
result <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        SomeException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> IO
      (Either
         SomeException
         (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO
     (Either
        SomeException
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
opener
    case Either
  SomeException
  (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
result of
        Left (SomeException
e::SomeException) -> do
            let po :: ProgramOutput
po = [Char] -> [[Char]] -> [Char] -> [Char] -> ExitCode -> ProgramOutput
ProgramOutput [Char]
cmd [[Char]]
args [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e) (Int -> ExitCode
ExitFailure Int
1)
            STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan ProgramOutput -> ProgramOutput -> STM ()
forall a. TChan a -> a -> STM ()
STM.writeTChan TChan ProgramOutput
outputChan ProgramOutput
po
            IO ()
-> (MVar ProgramOutput -> IO ())
-> Maybe (MVar ProgramOutput)
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((MVar ProgramOutput -> ProgramOutput -> IO ())
-> ProgramOutput -> MVar ProgramOutput -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar ProgramOutput -> ProgramOutput -> IO ()
forall a. MVar a -> a -> IO ()
putMVar ProgramOutput
po) Maybe (MVar ProgramOutput)
mOutputVar
        Right (Maybe Handle
stdinResult, Just Handle
outh, Just Handle
errh, ProcessHandle
ph) -> do
            case Maybe Handle
stdinResult of
                Just Handle
inh -> do
                    case Maybe [Char]
mInput of
                        Just [Char]
input -> do
                            Handle -> [Char] -> IO ()
hPutStrLn Handle
inh [Char]
input
                            Handle -> IO ()
hFlush Handle
inh
                        Maybe [Char]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe Handle
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
            [Char]
outResult <- Handle -> IO [Char]
hGetContents Handle
outh
            [Char]
errResult <- Handle -> IO [Char]
hGetContents Handle
errh
            let po :: ProgramOutput
po = [Char] -> [[Char]] -> [Char] -> [Char] -> ExitCode -> ProgramOutput
ProgramOutput [Char]
cmd [[Char]]
args [Char]
outResult [Char]
errResult ExitCode
ec
            STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan ProgramOutput -> ProgramOutput -> STM ()
forall a. TChan a -> a -> STM ()
STM.writeTChan TChan ProgramOutput
outputChan ProgramOutput
po
            IO ()
-> (MVar ProgramOutput -> IO ())
-> Maybe (MVar ProgramOutput)
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((MVar ProgramOutput -> ProgramOutput -> IO ())
-> ProgramOutput -> MVar ProgramOutput -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar ProgramOutput -> ProgramOutput -> IO ()
forall a. MVar a -> a -> IO ()
putMVar ProgramOutput
po) Maybe (MVar ProgramOutput)
mOutputVar
        Right (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
_ ->
            [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: createProcess returned unexpected result, report this at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                    [Char]
"https://github.com/matterhorn-chat/matterhorn"

-- | Given a file ID and server session, fetch the file into a temporary
-- location and return its path. The caller is responsible for deleting
-- the file.
fetchFile :: FileId -> Session -> IO String
fetchFile :: FileId -> Session -> IO [Char]
fetchFile FileId
fId Session
sess = do
    -- The link is for an attachment, so fetch it and then
    -- open the local copy.
    FileInfo
info <- FileId -> Session -> IO FileInfo
mmGetMetadataForFile FileId
fId Session
sess
    [Char]
cacheDir <- [Char] -> IO [Char]
getUserCacheDir [Char]
xdgName
    let dir :: [Char]
dir = [Char]
cacheDir [Char] -> [Char] -> [Char]
</> [Char]
"files" [Char] -> [Char] -> [Char]
</> Text -> [Char]
T.unpack (FileId -> Text
forall x. IsId x => x -> Text
idString FileId
fId)
        filename :: [Char]
filename = Text -> [Char]
T.unpack (FileInfo -> Text
fileInfoName FileInfo
info)
        fullPath :: [Char]
fullPath = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
filename

    FileId -> Session -> [Char] -> IO ()
fetchFileAtPath FileId
fId Session
sess [Char]
fullPath
    [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
fullPath

-- | Given a file ID and server session, fetch the file and save it to
-- the specified destination path. The destination path must refer to
-- the path to the file itself, not its parent directory. This function
-- will create only the parent directory in the specified path; it will
-- not create all path entries recursively. If the file already exists,
-- this function will overwrite the file.
--
-- The caller is responsible for catching all exceptions.
fetchFileAtPath :: FileId -> Session -> FilePath -> IO ()
fetchFileAtPath :: FileId -> Session -> [Char] -> IO ()
fetchFileAtPath FileId
fId Session
sess [Char]
fullPath = do
    ByteString
contents <- FileId -> Session -> IO ByteString
mmGetFile FileId
fId Session
sess
    let dir :: [Char]
dir = [Char] -> [Char]
takeDirectory [Char]
fullPath
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
dir
    [Char] -> ByteString -> IO ()
BS.writeFile [Char]
fullPath ByteString
contents

removeEmoteFormatting :: T.Text -> T.Text
removeEmoteFormatting :: Text -> Text
removeEmoteFormatting Text
t
    | Text
"*" Text -> Text -> Bool
`T.isPrefixOf` Text
t Bool -> Bool -> Bool
&&
      Text
"*" Text -> Text -> Bool
`T.isSuffixOf` Text
t = Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
t
    | Bool
otherwise = Text
t

addEmoteFormatting :: T.Text -> T.Text
addEmoteFormatting :: Text -> Text
addEmoteFormatting Text
t = Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"

fetchMentionedUsers :: Set.Set MentionedUser -> MH ()
fetchMentionedUsers :: Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
ms
    | Set MentionedUser -> Bool
forall a. Set a -> Bool
Set.null Set MentionedUser
ms = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = do
        let convertMention :: MentionedUser -> UserFetch
convertMention (UsernameMention Text
u) = Text -> UserFetch
UserFetchByUsername Text
u
            convertMention (UserIdMention UserId
i) = UserId -> UserFetch
UserFetchById UserId
i
        [UserFetch] -> MH ()
scheduleUserFetches ([UserFetch] -> MH ()) -> [UserFetch] -> MH ()
forall a b. (a -> b) -> a -> b
$ MentionedUser -> UserFetch
convertMention (MentionedUser -> UserFetch) -> [MentionedUser] -> [UserFetch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set MentionedUser -> [MentionedUser]
forall a. Set a -> [a]
Set.toList Set MentionedUser
ms

doPendingUserStatusFetches :: MH ()
doPendingUserStatusFetches :: MH ()
doPendingUserStatusFetches = do
    Maybe [UserId]
mz <- MH (Maybe [UserId])
getScheduledUserStatusFetches
    case Maybe [UserId]
mz of
        Maybe [UserId]
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [UserId]
z -> do
            TChan [UserId]
statusChan <- Getting (TChan [UserId]) ChatState (TChan [UserId])
-> MH (TChan [UserId])
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan [UserId]) ChatResources)
-> ChatState -> Const (TChan [UserId]) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan [UserId]) ChatResources)
 -> ChatState -> Const (TChan [UserId]) ChatState)
-> ((TChan [UserId] -> Const (TChan [UserId]) (TChan [UserId]))
    -> ChatResources -> Const (TChan [UserId]) ChatResources)
-> Getting (TChan [UserId]) ChatState (TChan [UserId])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan [UserId] -> Const (TChan [UserId]) (TChan [UserId]))
-> ChatResources -> Const (TChan [UserId]) ChatResources
Lens' ChatResources (TChan [UserId])
crStatusUpdateChan)
            IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan [UserId] -> [UserId] -> STM ()
forall a. TChan a -> a -> STM ()
STM.writeTChan TChan [UserId]
statusChan [UserId]
z

doPendingUserFetches :: MH ()
doPendingUserFetches :: MH ()
doPendingUserFetches = do
    [UserFetch]
fs <- MH [UserFetch]
getScheduledUserFetches

    let getUsername :: UserFetch -> Maybe Text
getUsername (UserFetchByUsername Text
u) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
u
        getUsername UserFetch
_ = Maybe Text
forall a. Maybe a
Nothing

        getUserId :: UserFetch -> Maybe UserId
getUserId (UserFetchById UserId
i) = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
i
        getUserId UserFetch
_ = Maybe UserId
forall a. Maybe a
Nothing

    [Text] -> [UserId] -> MH ()
fetchUsers ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ UserFetch -> Maybe Text
getUsername (UserFetch -> Maybe Text) -> [UserFetch] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserFetch]
fs) ([Maybe UserId] -> [UserId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UserId] -> [UserId]) -> [Maybe UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ UserFetch -> Maybe UserId
getUserId (UserFetch -> Maybe UserId) -> [UserFetch] -> [Maybe UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserFetch]
fs)

-- | Given a list of usernames, ensure that we have a user record for
-- each one in the state, either by confirming that a local record
-- exists or by issuing a request for user records.
fetchUsers :: [Text] -> [UserId] -> MH ()
fetchUsers :: [Text] -> [UserId] -> MH ()
fetchUsers [Text]
rawUsernames [UserId]
uids = 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
    Session
session <- MH Session
getSession
    let usernames :: [Text]
usernames = Text -> Text
trimUserSigil (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rawUsernames
        missingUsernames :: [Text]
missingUsernames = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isMissing [Text]
usernames
        isMissing :: Text -> Bool
isMissing Text
n = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
n
                          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isSpecialMention Text
n
                          , Maybe UserInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserInfo -> Bool) -> Maybe UserInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> ChatState -> Maybe UserInfo
userByUsername Text
n ChatState
st
                          ]
        missingIds :: [UserId]
missingIds = (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UserId
i -> Maybe UserInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserInfo -> Bool) -> Maybe UserInfo -> Bool
forall a b. (a -> b) -> a -> b
$ UserId -> ChatState -> Maybe UserInfo
userById UserId
i ChatState
st) [UserId]
uids

    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
missingUsernames) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"fetchUsers: getting " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
missingUsernames

    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [UserId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserId]
missingIds) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"fetchUsers: getting " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [UserId] -> [Char]
forall a. Show a => a -> [Char]
show [UserId]
missingIds

    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
missingUsernames) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [UserId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserId]
missingIds)) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            MH ()
act1 <- case [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
missingUsernames of
                Bool
True -> MH () -> IO (MH ())
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Bool
False -> do
                    Seq User
results <- Seq Text -> Session -> IO (Seq User)
mmGetUsersByUsernames ([Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList [Text]
missingUsernames) Session
session
                    MH () -> IO (MH ())
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ do
                        Seq User -> (User -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq User
results (\User
u -> UserInfo -> MH ()
addNewUser (UserInfo -> MH ()) -> UserInfo -> MH ()
forall a b. (a -> b) -> a -> b
$ User -> Bool -> UserInfo
userInfoFromUser User
u Bool
True)

            MH ()
act2 <- case [UserId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserId]
missingIds of
                Bool
True -> MH () -> IO (MH ())
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Bool
False -> do
                    Seq User
results <- Seq UserId -> Session -> IO (Seq User)
mmGetUsersByIds ([UserId] -> Seq UserId
forall a. [a] -> Seq a
Seq.fromList [UserId]
missingIds) Session
session
                    MH () -> IO (MH ())
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ do
                        Seq User -> (User -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq User
results (\User
u -> UserInfo -> MH ()
addNewUser (UserInfo -> MH ()) -> UserInfo -> MH ()
forall a b. (a -> b) -> a -> b
$ User -> Bool -> UserInfo
userInfoFromUser User
u Bool
True)

            Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ MH ()
act1 MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
act2

invalidateChannelRenderingCache :: ChannelId -> MH ()
invalidateChannelRenderingCache :: ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ Name -> Name
MessageInterfaceMessages (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
MessageInput ChannelId
cId
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ Name -> Name
MessageInterfaceMessages (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
ThreadMessageInput ChannelId
cId

invalidateMessageRenderingCacheByPostId :: PostId -> MH ()
invalidateMessageRenderingCacheByPostId :: PostId -> MH ()
invalidateMessageRenderingCacheByPostId PostId
pId = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ MessageId -> Name
RenderedMessage (MessageId -> Name) -> MessageId -> Name
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
pId

setThreadOrientationByName :: T.Text -> MH ()
setThreadOrientationByName :: Text -> MH ()
setThreadOrientationByName Text
o = do
    let o' :: Text
o' = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
o
    Maybe ThreadOrientation
new <- case Text
o' of
        Text
"above" -> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadOrientation -> MH (Maybe ThreadOrientation))
-> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall a b. (a -> b) -> a -> b
$ ThreadOrientation -> Maybe ThreadOrientation
forall a. a -> Maybe a
Just ThreadOrientation
ThreadAbove
        Text
"below" -> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadOrientation -> MH (Maybe ThreadOrientation))
-> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall a b. (a -> b) -> a -> b
$ ThreadOrientation -> Maybe ThreadOrientation
forall a. a -> Maybe a
Just ThreadOrientation
ThreadBelow
        Text
"left"  -> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadOrientation -> MH (Maybe ThreadOrientation))
-> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall a b. (a -> b) -> a -> b
$ ThreadOrientation -> Maybe ThreadOrientation
forall a. a -> Maybe a
Just ThreadOrientation
ThreadLeft
        Text
"right" -> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadOrientation -> MH (Maybe ThreadOrientation))
-> Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall a b. (a -> b) -> a -> b
$ ThreadOrientation -> Maybe ThreadOrientation
forall a. a -> Maybe a
Just ThreadOrientation
ThreadRight
        Text
_ -> do
            Text -> MH ()
postErrorMessage' (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid orientation: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
o
            Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThreadOrientation
forall a. Maybe a
Nothing

    case Maybe ThreadOrientation
new of
        Maybe ThreadOrientation
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ThreadOrientation
n -> do
            (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
 -> ChatState -> Identity ChatState)
-> ((ThreadOrientation -> Identity ThreadOrientation)
    -> ChatResources -> Identity ChatResources)
-> (ThreadOrientation -> Identity ThreadOrientation)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Identity Config)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Identity Config)
 -> ChatResources -> Identity ChatResources)
-> ((ThreadOrientation -> Identity ThreadOrientation)
    -> Config -> Identity Config)
-> (ThreadOrientation -> Identity ThreadOrientation)
-> ChatResources
-> Identity ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadOrientation -> Identity ThreadOrientation)
-> Config -> Identity Config
Lens' Config ThreadOrientation
configThreadOrientationL ((ThreadOrientation -> Identity ThreadOrientation)
 -> ChatState -> Identity ChatState)
-> ThreadOrientation -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ThreadOrientation
n
            Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Thread orientation set to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o'
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

toggleMouseMode :: MH ()
toggleMouseMode :: MH ()
toggleMouseMode = do
    Vty
vty <- EventM Name Vty -> MH Vty
forall a. EventM Name a -> MH a
mh EventM Name Vty
forall n. EventM n Vty
getVtyHandle
    (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
 -> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
    -> ChatResources -> Identity ChatResources)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Identity Config)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Identity Config)
 -> ChatResources -> Identity ChatResources)
-> ((Bool -> Identity Bool) -> Config -> Identity Config)
-> (Bool -> Identity Bool)
-> ChatResources
-> Identity ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
configMouseModeL ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> (Bool -> Bool) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
    Bool
newMode <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Bool ChatResources)
-> ChatState -> Const Bool ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Bool ChatResources)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> ChatResources -> Const Bool ChatResources)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configMouseModeL)
    IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ Output -> Mode -> Bool -> IO ()
Vty.setMode (Vty -> Output
Vty.outputIface Vty
vty) Mode
Vty.Mouse Bool
newMode
    Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ if Bool
newMode
                      then Text
"Mouse input is now enabled."
                      else Text
"Mouse input is now disabled."