module Matterhorn.State.Common
(
openFilePath
, openWithOpener
, runLoggedCommand
, fetchFile
, fetchFileAtPath
, installMessagesFromPosts
, updatePostMap
, postInfoMessage
, postErrorMessageIO
, postErrorMessage'
, addEmoteFormatting
, removeEmoteFormatting
, toggleMouseMode
, fetchMentionedUsers
, doPendingUserFetches
, doPendingUserStatusFetches
, setThreadOrientationByName
, 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.ByteString.Lazy as BSL
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 )
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
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)
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 a. a -> MH a
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
Text
hostname <- Getting Text ChatState Text -> MH Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState)
-> ((Text -> Const Text Text)
-> ChatResources -> Const Text ChatResources)
-> Getting Text ChatState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources)
-> ((Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData)
-> (Text -> Const Text Text)
-> ChatResources
-> Const Text ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData
Lens' ConnectionData Text
cdHostnameL)
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 = Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname 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 a b. (a -> b -> b) -> b -> Seq a -> b
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 a. a -> MH a
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 -> String -> Post
forall a. HasCallStack => String -> a
error (String -> Post) -> String -> Post
forall a b. (a -> b) -> a -> b
$ String
"BUG: could not find post for post ID " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PostId -> String
forall a. Show a => a -> String
show PostId
pId
Just Post
post -> Post
post
updatePostMap :: Maybe TeamId -> Posts -> MH ()
updatePostMap :: Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
postCollection = do
Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall a. a -> MH a
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
Text
hostname <- Getting Text ChatState Text -> MH Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState)
-> ((Text -> Const Text Text)
-> ChatResources -> Const Text ChatResources)
-> Getting Text ChatState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources)
-> ((Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData)
-> (Text -> Const Text Text)
-> ChatResources
-> Const Text ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData
Lens' ConnectionData Text
cdHostnameL)
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 (Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname 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 => HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap PostId Message
postMap
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ChatState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry (Name -> EventM Name ChatState ())
-> Name -> EventM Name ChatState ()
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClientMessage -> String
forall a. Show a => a -> String
show ClientMessage
msg
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)
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 a. a -> IO a
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 a. a -> IO a
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 a. a -> IO a
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 :: String -> MH ()
openFilePath String
path = MH (Either MHError String) -> MH ()
openWithOpener (Either MHError String -> MH (Either MHError String)
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MHError String -> MH (Either MHError String))
-> Either MHError String -> MH (Either MHError String)
forall a b. (a -> b) -> a -> b
$ String -> Either MHError String
forall a b. b -> Either a b
Right String
path)
openWithOpener :: MH (Either MHError String) -> MH ()
openWithOpener :: MH (Either MHError String) -> MH ()
openWithOpener MH (Either MHError String)
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 String
targetResult <- MH (Either MHError String)
getTarget
let cmdWords :: [Text]
cmdWords = Text -> [Text]
T.words Text
urlOpenCommand
([String]
cmds, [String]
args) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 (Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
cmdWords)
cmd :: String
cmd = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmds then String
"$BROWSER" else [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
cmds
case Either MHError String
targetResult of
Left MHError
e -> do
MHError -> MH ()
mhError MHError
e
Right String
target -> do
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
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan String
cmd
([String]
args [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
target])
Maybe ByteString
forall a. Maybe a
Nothing Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
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
Bool
True -> 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
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages
case (Message -> Bool) -> Messages -> Maybe Message
findLatestUserMessage Message -> Bool
isEditable Messages
msgs of
Maybe Message
Nothing -> () -> MH ()
forall a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume ((ChatState -> IO ChatState) -> MH ())
-> (ChatState -> IO ChatState) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChatState
st -> do
Either String ExitCode
result <- String -> [String] -> IO (Either String ExitCode)
runInteractiveCommand String
cmd ([String]
args [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
target])
let waitForKeypress :: IO ()
waitForKeypress = do
String -> IO ()
putStrLn String
"Press any key to return to Matterhorn."
IO Char -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Char
getChar
case Either String ExitCode
result of
Right ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left String
err -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"URL opener subprocess " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Text -> String
forall a. Show a => a -> String
show Text
urlOpenCommand) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" could not be run: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
IO ()
waitForKeypress
Right (ExitFailure Int
code) -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"URL opener subprocess " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Text -> String
forall a. Show a => a -> String
show Text
urlOpenCommand) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
" exited with non-zero status " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
code
IO ()
waitForKeypress
ChatState -> IO ChatState
forall a. a -> IO a
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 :: String -> [String] -> IO (Either String ExitCode)
runInteractiveCommand String
cmd [String]
args = do
let opener :: CreateProcess
opener = (String -> [String] -> CreateProcess
proc String
cmd [String]
args) { std_in = Inherit
, std_out = Inherit
, std_err = 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 String ExitCode -> IO (Either String ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ExitCode -> IO (Either String ExitCode))
-> Either String ExitCode -> IO (Either String ExitCode)
forall a b. (a -> b) -> a -> b
$ String -> Either String ExitCode
forall a b. a -> Either a b
Left (String -> Either String ExitCode)
-> String -> Either String ExitCode
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) -> do
ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
Either String ExitCode -> IO (Either String ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ExitCode -> IO (Either String ExitCode))
-> Either String ExitCode -> IO (Either String ExitCode)
forall a b. (a -> b) -> a -> b
$ ExitCode -> Either String ExitCode
forall a b. b -> Either a b
Right ExitCode
ec
runLoggedCommand :: STM.TChan ProgramOutput
-> String
-> [String]
-> Maybe BSL.ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand :: TChan ProgramOutput
-> String
-> [String]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan String
cmd [String]
args Maybe ByteString
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
-> (ByteString -> StdStream) -> Maybe ByteString -> StdStream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StdStream
NoStream (StdStream -> ByteString -> StdStream
forall a b. a -> b -> a
const StdStream
CreatePipe) Maybe ByteString
mInput
opener :: CreateProcess
opener = (String -> [String] -> CreateProcess
proc String
cmd [String]
args) { std_in = stdIn
, std_out = CreatePipe
, std_err = 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 = String -> [String] -> String -> String -> ExitCode -> ProgramOutput
ProgramOutput String
cmd [String]
args String
"" (SomeException -> String
forall a. Show a => a -> String
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 a. a -> IO a
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 ByteString
mInput of
Just ByteString
input -> do
Handle -> ByteString -> IO ()
BSL.hPut Handle
inh ByteString
input
Handle -> IO ()
hFlush Handle
inh
Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe Handle
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
String
outResult <- Handle -> IO String
hGetContents Handle
outh
String
errResult <- Handle -> IO String
hGetContents Handle
errh
let po :: ProgramOutput
po = String -> [String] -> String -> String -> ExitCode -> ProgramOutput
ProgramOutput String
cmd [String]
args String
outResult String
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 a. a -> IO a
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)
_ ->
String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"BUG: createProcess returned unexpected result, report this at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"https://github.com/matterhorn-chat/matterhorn"
fetchFile :: FileId -> Session -> IO String
fetchFile :: FileId -> Session -> IO String
fetchFile FileId
fId Session
sess = do
FileInfo
info <- FileId -> Session -> IO FileInfo
mmGetMetadataForFile FileId
fId Session
sess
String
cacheDir <- String -> IO String
getUserCacheDir String
xdgName
let dir :: String
dir = String
cacheDir String -> String -> String
</> String
"files" String -> String -> String
</> Text -> String
T.unpack (FileId -> Text
forall x. IsId x => x -> Text
idString FileId
fId)
filename :: String
filename = Text -> String
T.unpack (FileInfo -> Text
fileInfoName FileInfo
info)
fullPath :: String
fullPath = String
dir String -> String -> String
</> String
filename
FileId -> Session -> String -> IO ()
fetchFileAtPath FileId
fId Session
sess String
fullPath
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
fullPath
fetchFileAtPath :: FileId -> Session -> FilePath -> IO ()
fetchFileAtPath :: FileId -> Session -> String -> IO ()
fetchFileAtPath FileId
fId Session
sess String
fullPath = do
ByteString
contents <- FileId -> Session -> IO ByteString
mmGetFile FileId
fId Session
sess
let dir :: String
dir = String -> String
takeDirectory String
fullPath
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
String -> ByteString -> IO ()
BS.writeFile String
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 = HasCallStack => Text -> Text
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 a. a -> MH a
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 a. a -> MH a
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 a. IO a -> MH a
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)
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 a. [a] -> 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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"fetchUsers: getting " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
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 a. [a] -> 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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"fetchUsers: getting " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [UserId] -> String
forall a. Show a => a -> String
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 a. [a] -> 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 a. [a] -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
missingUsernames of
Bool
True -> MH () -> IO (MH ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall a. a -> MH a
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 a. a -> IO a
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserId]
missingIds of
Bool
True -> MH () -> IO (MH ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MH () -> IO (MH ())) -> MH () -> IO (MH ())
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall a. a -> MH a
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 a. a -> IO a
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 a. a -> IO a
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 a b. MH a -> MH b -> MH b
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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ChatState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry (Name -> EventM Name ChatState ())
-> Name -> EventM Name ChatState ()
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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ChatState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry (Name -> EventM Name ChatState ())
-> Name -> EventM Name ChatState ()
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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ChatState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry (Name -> EventM Name ChatState ())
-> Name -> EventM Name ChatState ()
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 a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Invalid orientation: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
o
Maybe ThreadOrientation -> MH (Maybe ThreadOrientation)
forall a. a -> MH a
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 a. a -> MH a
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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState ()
forall n s. Ord n => EventM n s ()
invalidateCache
toggleMouseMode :: MH ()
toggleMouseMode :: MH ()
toggleMouseMode = do
Vty
vty <- EventM Name ChatState Vty -> MH Vty
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState Vty
forall n s. EventM n s 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 a. IO a -> MH a
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."