module Matterhorn.Events
( onEvent
, setWindowSize
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import qualified Data.Text as T
import GHC.Exception ( fromException )
import qualified Graphics.Vty as Vty
import Lens.Micro.Platform ( (.=), _2, singular, _Just )
import qualified System.IO.Error as IO
import qualified Network.Mattermost.Types as MM
import qualified Network.Mattermost.Endpoints as MM
import Network.Mattermost.Exceptions ( mattermostErrorMessage )
import Matterhorn.Connection
import Matterhorn.Constants ( userSigil, normalChannelSigil )
import Matterhorn.HelpTopics
import Matterhorn.State.ChannelList
import Matterhorn.State.Channels
import Matterhorn.State.Common
import Matterhorn.State.Messages
import Matterhorn.Types
import Matterhorn.Events.ChannelSelect
import Matterhorn.Events.ChannelTopicWindow
import Matterhorn.Events.DeleteChannelConfirm
import Matterhorn.Events.Global
import Matterhorn.Events.LeaveChannelConfirm
import Matterhorn.Events.Main
import Matterhorn.Events.MessageSelect
import Matterhorn.Events.ThemeListWindow
import Matterhorn.Events.PostListWindow
import Matterhorn.Events.ShowHelp
import Matterhorn.Events.UserListWindow
import Matterhorn.Events.ChannelListWindow
import Matterhorn.Events.ReactionEmojiListWindow
import Matterhorn.Events.TabbedWindow
import Matterhorn.Events.Mouse
import Matterhorn.Events.EditNotifyPrefs
import Matterhorn.Events.Websocket
onEvent :: BrickEvent Name MHEvent -> EventM Name ChatState ()
onEvent :: BrickEvent Name MHEvent -> EventM Name ChatState ()
onEvent BrickEvent Name MHEvent
ev = MH () -> EventM Name ChatState ()
runMHEvent (MH () -> EventM Name ChatState ())
-> MH () -> EventM Name ChatState ()
forall a b. (a -> b) -> a -> b
$ do
BrickEvent Name MHEvent -> MH ()
onBrickEvent BrickEvent Name MHEvent
ev
MH ()
doPendingUserFetches
MH ()
doPendingUserStatusFetches
onBrickEvent :: BrickEvent Name MHEvent -> MH ()
onBrickEvent :: BrickEvent Name MHEvent -> MH ()
onBrickEvent (AppEvent MHEvent
e) =
MHEvent -> MH ()
onAppEvent MHEvent
e
onBrickEvent (VtyEvent (Vty.EvKey (Vty.KChar Char
'l') [Modifier
Vty.MCtrl])) = do
(Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent ((Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState)
-> Maybe (BrickEvent Name MHEvent) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (BrickEvent Name MHEvent)
forall a. Maybe a
Nothing
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
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
$ Vty -> IO ()
Vty.refresh Vty
vty
onBrickEvent (VtyEvent Event
e) = do
(Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent ((Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState)
-> Maybe (BrickEvent Name MHEvent) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (BrickEvent Name MHEvent)
forall a. Maybe a
Nothing
Event -> MH ()
onVtyEvent Event
e
onBrickEvent e :: BrickEvent Name MHEvent
e@(MouseDown Name
n Button
_ [Modifier]
_ Location
_) = do
Maybe (BrickEvent Name MHEvent)
lastClick <- Getting
(Maybe (BrickEvent Name MHEvent))
ChatState
(Maybe (BrickEvent Name MHEvent))
-> MH (Maybe (BrickEvent Name MHEvent))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
(Maybe (BrickEvent Name MHEvent))
ChatState
(Maybe (BrickEvent Name MHEvent))
Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent
let shouldHandle :: Bool
shouldHandle = case Maybe (BrickEvent Name MHEvent)
lastClick of
Maybe (BrickEvent Name MHEvent)
Nothing -> Bool
True
Just (MouseDown Name
prevN Button
_ [Modifier]
_ Location
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name
prevN Name -> Name -> Bool
forall a. SemEq a => a -> a -> Bool
`semeq` Name
n
Maybe (BrickEvent Name MHEvent)
_ -> Bool
False
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldHandle (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
(Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent ((Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState)
-> Maybe (BrickEvent Name MHEvent) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= BrickEvent Name MHEvent -> Maybe (BrickEvent Name MHEvent)
forall a. a -> Maybe a
Just BrickEvent Name MHEvent
e
(TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Mode
mode <- TeamId -> MH Mode
getTeamMode TeamId
tId
TeamId -> Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode TeamId
tId Mode
mode BrickEvent Name MHEvent
e
onBrickEvent (MouseUp {}) = do
(Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent ((Maybe (BrickEvent Name MHEvent)
-> Identity (Maybe (BrickEvent Name MHEvent)))
-> ChatState -> Identity ChatState)
-> Maybe (BrickEvent Name MHEvent) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (BrickEvent Name MHEvent)
forall a. Maybe a
Nothing
MH ()
mhContinueWithoutRedraw
onAppEvent :: MHEvent -> MH ()
onAppEvent :: MHEvent -> MH ()
onAppEvent MHEvent
RefreshWebsocketEvent =
MH ()
connectWebsockets
onAppEvent MHEvent
WebsocketDisconnect = do
(ConnectionStatus -> Identity ConnectionStatus)
-> ChatState -> Identity ChatState
Lens' ChatState ConnectionStatus
csConnectionStatus ((ConnectionStatus -> Identity ConnectionStatus)
-> ChatState -> Identity ChatState)
-> ConnectionStatus -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ConnectionStatus
Disconnected
MH ()
disconnectChannels
onAppEvent MHEvent
WebsocketConnect = do
(ConnectionStatus -> Identity ConnectionStatus)
-> ChatState -> Identity ChatState
Lens' ChatState ConnectionStatus
csConnectionStatus ((ConnectionStatus -> Identity ConnectionStatus)
-> ChatState -> Identity ChatState)
-> ConnectionStatus -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ConnectionStatus
Connected
MH ()
refreshChannelsAndUsers
MH ()
refreshClientConfig
(TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
fetchVisibleIfNeeded
onAppEvent (RateLimitExceeded Int
winSz) =
MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError (Text -> MHError) -> Text -> MHError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
let s :: String
s = if Int
winSz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s"
in String
"The server's API request rate limit was exceeded; Matterhorn will " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"retry the failed request in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
winSz String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" second" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
". Please contact your Mattermost administrator " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"about API rate limiting issues."
onAppEvent MHEvent
RateLimitSettingsMissing =
MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError (Text -> MHError) -> Text -> MHError
forall a b. (a -> b) -> a -> b
$
Text
"A request was rate-limited but could not be retried due to rate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"limit settings missing"
onAppEvent MHEvent
RequestDropped =
MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError (Text -> MHError) -> Text -> MHError
forall a b. (a -> b) -> a -> b
$
Text
"An API request was retried and dropped due to a rate limit. Matterhorn " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"may now be inconsistent with the server. Please contact your " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Mattermost administrator about API rate limiting issues."
onAppEvent MHEvent
BGIdle =
(Maybe (Maybe Int) -> Identity (Maybe (Maybe Int)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (Maybe Int))
csWorkerIsBusy ((Maybe (Maybe Int) -> Identity (Maybe (Maybe Int)))
-> ChatState -> Identity ChatState)
-> Maybe (Maybe Int) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Maybe Int)
forall a. Maybe a
Nothing
onAppEvent (BGBusy Maybe Int
n) =
(Maybe (Maybe Int) -> Identity (Maybe (Maybe Int)))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe (Maybe Int))
csWorkerIsBusy ((Maybe (Maybe Int) -> Identity (Maybe (Maybe Int)))
-> ChatState -> Identity ChatState)
-> Maybe (Maybe Int) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
n
onAppEvent (WSEvent WebsocketEvent
we) =
WebsocketEvent -> MH ()
handleWebsocketEvent WebsocketEvent
we
onAppEvent (WSActionResponse WebsocketActionResponse
r) =
WebsocketActionResponse -> MH ()
handleWebsocketActionResponse WebsocketActionResponse
r
onAppEvent (RespEvent MH ()
f) = MH ()
f
onAppEvent (WebsocketParseError String
e) = do
let msg :: Text
msg = Text
"A websocket message could not be parsed:\n " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
String -> Text
T.pack String
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"
MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
msg
onAppEvent (IEvent InternalEvent
e) = do
InternalEvent -> MH ()
handleIEvent InternalEvent
e
handleIEvent :: InternalEvent -> MH ()
handleIEvent :: InternalEvent -> MH ()
handleIEvent (DisplayError MHError
e) =
Text -> MH ()
postErrorMessage' (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ MHError -> Text
formatMHError MHError
e
handleIEvent (LoggingStarted String
path) =
Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Logging to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LogDestination Maybe String
dest) =
case Maybe String
dest of
Maybe String
Nothing ->
Text -> MH ()
postInfoMessage Text
"Logging is currently disabled. Enable it with /log-start."
Just String
path ->
Text -> MH ()
postInfoMessage (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
"Logging to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path
handleIEvent (LogSnapshotSucceeded String
path) =
Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Log snapshot written to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LoggingStopped String
path) =
Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Stopped logging to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LogStartFailed String
path String
err) =
Text -> MH ()
postErrorMessage' (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not start logging to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
", error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
handleIEvent (LogSnapshotFailed String
path String
err) =
Text -> MH ()
postErrorMessage' (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not write log snapshot to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
", error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
formatMHError :: MHError -> T.Text
formatMHError :: MHError -> Text
formatMHError (GenericError Text
msg) =
Text
msg
formatMHError (NoSuchChannel Text
chan) =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"No such channel: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
chan
formatMHError (NoSuchUser Text
user) =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"No such user: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
user
formatMHError (AmbiguousName Text
name) =
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"The input " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" matches both channels ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"and users. Try using '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' or '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' to disambiguate."
formatMHError (ServerError MattermostError
e) =
MattermostError -> Text
mattermostErrorMessage MattermostError
e
formatMHError (ClipboardError Text
msg) =
Text
msg
formatMHError (ConfigOptionMissing Text
opt) =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Config option " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
opt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" missing"
formatMHError (ProgramExecutionFailed Text
progName Text
logPath) =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"An error occurred when running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
progName String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
"; see " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
logPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for details."
formatMHError (NoSuchScript Text
name) =
Text
"No script named " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was found"
formatMHError (NoSuchHelpTopic Text
topic) =
let knownTopics :: [Text]
knownTopics = (Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (HelpTopic -> Text) -> HelpTopic -> Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HelpTopic -> Text
helpTopicName (HelpTopic -> Text) -> [HelpTopic] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HelpTopic]
helpTopics
in Text
"Unknown help topic: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
topic Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
([Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Available topics are:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
knownTopics)
formatMHError (AttachmentException SomeException
e) =
case SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (IOError
ioe :: IO.IOError) ->
if IOError -> Bool
IO.isDoesNotExistError IOError
ioe
then Text
"Error attaching, file does not exist!"
else if IOError -> Bool
IO.isPermissionError IOError
ioe
then Text
"Error attaching, lacking permissions to read file!"
else Text
"Unable to attach the requested file. Check that it exists and has proper permissions."
Maybe IOError
Nothing -> Text
"Unknown error attaching file!\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Please report this error at https://github.com/matterhorn-chat/matterhorn/issues"
formatMHError (BadAttachmentPath Text
msg) =
Text
msg
formatMHError (AsyncErrEvent SomeException
e) =
Text
"An unexpected error has occurred! The exception encountered was:\n " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"
onVtyEvent :: Vty.Event -> MH ()
onVtyEvent :: Event -> MH ()
onVtyEvent =
MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> (Event -> MH Bool) -> Event -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ Event -> MH Bool
handleResizeEvent
, (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
globalKeybindings
, Event -> MH Bool
handleTeamModeEvent
]
handleResizeEvent :: Vty.Event -> MH Bool
handleResizeEvent :: Event -> MH Bool
handleResizeEvent (Vty.EvResize Int
w Int
h) = do
Int -> Int -> MH ()
setWindowSize Int
w Int
h
Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleResizeEvent Event
_ =
Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
setWindowSize :: Int -> Int -> MH ()
setWindowSize :: Int -> Int -> MH ()
setWindowSize Int
w Int
h = do
(ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> (((Int, Int) -> Identity (Int, Int))
-> ChatResources -> Identity ChatResources)
-> ((Int, Int) -> Identity (Int, Int))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Int, Int) -> Identity (Int, Int))
-> ChatResources -> Identity ChatResources
Lens' ChatResources (Int, Int)
crWindowSize (((Int, Int) -> Identity (Int, Int))
-> ChatState -> Identity ChatState)
-> (Int, Int) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int
w, Int
h)
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
(TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
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 ()
makeVisible (Name -> EventM Name ChatState ())
-> Name -> EventM Name ChatState ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
SelectedChannelListEntry TeamId
tId
handleTeamModeEvent :: Vty.Event -> MH Bool
handleTeamModeEvent :: Event -> MH Bool
handleTeamModeEvent Event
e = do
(TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
Mode
mode <- TeamId -> MH Mode
getTeamMode TeamId
tId
TeamId -> Mode -> Event -> MH ()
teamEventHandlerByMode TeamId
tId Mode
mode Event
e
Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
teamEventHandlerByMode :: MM.TeamId -> Mode -> Vty.Event -> MH ()
teamEventHandlerByMode :: TeamId -> Mode -> Event -> MH ()
teamEventHandlerByMode TeamId
tId Mode
mode Event
e =
case Mode
mode of
Mode
Main -> TeamId -> Event -> MH ()
onEventMain TeamId
tId Event
e
ShowHelp HelpTopic
_ -> MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH Bool
onEventShowHelp TeamId
tId Event
e
Mode
ChannelSelect -> MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH ()
onEventChannelSelect TeamId
tId Event
e
Mode
LeaveChannelConfirm -> TeamId -> Event -> MH ()
onEventLeaveChannelConfirm TeamId
tId Event
e
MessageSelectDeleteConfirm MessageInterfaceTarget
target ->
case MessageInterfaceTarget
target of
MITeamThread TeamId
tmId ->
TeamId
-> Lens' ChatState (MessageInterface Name PostId) -> Event -> MH ()
forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH ()
onEventMessageSelectDeleteConfirm TeamId
tId (HasCallStack =>
TeamId -> Lens' ChatState (MessageInterface Name PostId)
TeamId -> Lens' ChatState (MessageInterface Name PostId)
unsafeThreadInterface(TeamId
tmId)) Event
e
MIChannel ChannelId
cId ->
TeamId
-> Lens' ChatState (MessageInterface Name ()) -> Event -> MH ()
forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH ()
onEventMessageSelectDeleteConfirm TeamId
tId (ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface(ChannelId
cId)) Event
e
Mode
DeleteChannelConfirm -> TeamId -> Event -> MH ()
onEventDeleteChannelConfirm TeamId
tId Event
e
Mode
ThemeListWindow -> TeamId -> Event -> MH ()
onEventThemeListWindow TeamId
tId Event
e
PostListWindow PostListContents
_ -> TeamId -> Event -> MH ()
onEventPostListWindow TeamId
tId Event
e
Mode
UserListWindow -> TeamId -> Event -> MH ()
onEventUserListWindow TeamId
tId Event
e
Mode
ChannelListWindow -> TeamId -> Event -> MH ()
onEventChannelListWindow TeamId
tId Event
e
Mode
ReactionEmojiListWindow -> TeamId -> Event -> MH ()
onEventReactionEmojiListWindow TeamId
tId Event
e
Mode
ViewMessage -> MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ (Lens'
ChatState (TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> TeamId -> Event -> MH Bool
forall a.
(Show a, Eq a) =>
Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> Event -> MH Bool
handleTabbedWindowEvent
(TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> TeamState -> f TeamState)
-> (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState -> f TeamState
Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage((Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState -> f TeamState)
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> TeamState
-> f TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Lens
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular ((Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Message,
TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
Traversal
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
_Just(((Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Message,
TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Message,
TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TabbedWindow ChatState MH Name ViewMessageWindowTab
-> f (TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
_2)
TeamId
tId Event
e)
Mode
EditNotifyPrefs -> MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH Bool
onEventEditNotifyPrefs TeamId
tId Event
e
Mode
ChannelTopicWindow -> TeamId -> Event -> MH ()
onEventChannelTopicWindow TeamId
tId Event
e
refreshClientConfig :: MH ()
refreshClientConfig :: MH ()
refreshClientConfig = do
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
ClientConfig
cfg <- Maybe Text -> Session -> IO ClientConfig
MM.mmGetClientConfiguration (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"old") Session
session
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
$ do
(Maybe ClientConfig -> Identity (Maybe ClientConfig))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe ClientConfig)
csClientConfig ((Maybe ClientConfig -> Identity (Maybe ClientConfig))
-> ChatState -> Identity ChatState)
-> Maybe ClientConfig -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ClientConfig -> Maybe ClientConfig
forall a. a -> Maybe a
Just ClientConfig
cfg
Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
forall a. Maybe a
Nothing