module Matterhorn.Events
  ( onEvent
  , globalKeybindings
  , globalKeyHandlers
  )
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.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.Help
import           Matterhorn.State.Messages
import           Matterhorn.State.Teams ( setTeam )
import           Matterhorn.State.ListOverlay ( listOverlayActivate )
import           Matterhorn.Types

import           Matterhorn.Events.ChannelSelect
import           Matterhorn.Events.ChannelTopicWindow
import           Matterhorn.Events.SaveAttachmentWindow
import           Matterhorn.Events.DeleteChannelConfirm
import           Matterhorn.Events.Keybindings
import           Matterhorn.Events.LeaveChannelConfirm
import           Matterhorn.Events.Main
import           Matterhorn.Events.MessageSelect
import           Matterhorn.Events.ThemeListOverlay
import           Matterhorn.Events.PostListOverlay
import           Matterhorn.Events.ShowHelp
import           Matterhorn.Events.UrlSelect
import           Matterhorn.Events.UserListOverlay
import           Matterhorn.Events.ChannelListOverlay
import           Matterhorn.Events.ReactionEmojiListOverlay
import           Matterhorn.State.Reactions ( toggleReaction )
import           Matterhorn.Events.TabbedWindow
import           Matterhorn.Events.ManageAttachments
import           Matterhorn.Events.EditNotifyPrefs
import           Matterhorn.Events.Websocket
import           Matterhorn.State.Links ( openLinkTarget )

onEvent :: ChatState -> BrickEvent Name MHEvent -> EventM Name (Next ChatState)
onEvent :: ChatState
-> BrickEvent Name MHEvent -> EventM Name (Next ChatState)
onEvent ChatState
st BrickEvent Name MHEvent
ev = ChatState -> MH () -> EventM Name (Next ChatState)
runMHEvent ChatState
st (MH () -> EventM Name (Next ChatState))
-> MH () -> EventM Name (Next 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
    Vty
vty <- EventM Name Vty -> MH Vty
forall a. EventM Name a -> MH a
mh EventM Name Vty
forall n. EventM n Vty
getVtyHandle
    IO () -> MH ()
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) =
    Event -> MH ()
onVtyEvent Event
e
onBrickEvent (MouseUp {}) = do
    LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral Text
"MOUSE UP EVENT"
    (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
onBrickEvent e :: BrickEvent Name MHEvent
e@(MouseDown Name
n Button
button [Modifier]
modifier Location
clickLoc) = 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
"MOUSE EVENT: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Name, Button, [Modifier]) -> String
forall a. Show a => a -> String
show (Name
n, Button
button, [Modifier]
modifier)
    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
        LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral Text
"Handling mouse event"
        (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
        Name -> Button -> [Modifier] -> Location -> MH ()
onMouseDown Name
n Button
button [Modifier]
modifier Location
clickLoc

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
    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
formatError 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

-- Handle mouse click events.
--
-- Note that the handler for each case may need to check the application
-- mode before handling the click. This is because some mouse events
-- only make sense when the UI is displaying certain contents. While
-- it's true that we probably wouldn't even get the click events in the
-- first place (because the UI element would only cause a click event
-- to be reported if it was actually rendered), there are cases when we
-- can get clicks on UI elements that *are* clickable even though those
-- clicks don't make sense for the application mode. A concrete example
-- of this is when we display the current channel's contents in one
-- layer, in monochrome, and then display a modal dialog box on top of
-- that. We probably *should* ignore clicks on the lower layer because
-- that's not the mode the application is in, but getting that right
-- could be hard because we'd have to figure out all possible modes
-- where those lower-layer clicks would be nonsensical. We don't bother
-- doing that in the harder cases; instead we just handle the clicks
-- and do what we would ordinarily do, assuming that there's no real
-- harm done. The worst that could happen is that a user could click
-- accidentally on a grayed-out URL (in a message, say) next to a modal
-- dialog box and then see the URL get opened. That would be weird, but
-- it isn't the end of the world.
onMouseDown :: Name -> Vty.Button -> [Vty.Modifier] -> Location -> MH()
onMouseDown :: Name -> Button -> [Modifier] -> Location -> MH ()
onMouseDown (ClickableChannelListEntry ChannelId
channelId) Button
Vty.BLeft [] Location
_ = do
    Mode -> MH () -> MH ()
whenMode Mode
Main (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        MH ()
resetReturnChannel
        ChannelId -> MH ()
setFocus ChannelId
channelId
        Mode -> MH ()
setMode Mode
Main
onMouseDown (ClickableTeamListEntry TeamId
teamId) Button
Vty.BLeft [] Location
_ =
    -- We deliberately handle this event in all modes; this allows us to
    -- switch the UI to another team regardless of what state it is in,
    -- which is by design since all teams have their own UI states.
    TeamId -> MH ()
setTeam TeamId
teamId
onMouseDown (ClickableURLInMessage MessageId
_ Int
_ LinkTarget
t) Button
Vty.BLeft [] Location
_ =
    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
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
onMouseDown (ClickableURL Name
_ Int
_ LinkTarget
t) Button
Vty.BLeft [] Location
_ =
    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
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
onMouseDown (ClickableUsernameInMessage MessageId
_ Int
_ Text
username) Button
Vty.BLeft [] Location
_ =
    Text -> MH ()
changeChannelByName (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
username
onMouseDown (ClickableUsername Name
_ Int
_ Text
username) Button
Vty.BLeft [] Location
_ =
    Text -> MH ()
changeChannelByName (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
username
onMouseDown (ClickableURLListEntry Int
_ LinkTarget
t) Button
Vty.BLeft [] Location
_ =
    -- Only handle URL list entry clicks when viewing the URL list
    Mode -> MH () -> MH ()
whenMode Mode
UrlSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        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
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
onMouseDown (ChannelSelectEntry ChannelSelectMatch
match) Button
Vty.BLeft [] Location
_ =
    Mode -> MH () -> MH ()
whenMode Mode
ChannelSelect (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Mode -> MH ()
setMode Mode
Main
        ChannelId -> MH ()
setFocus (ChannelId -> MH ()) -> ChannelId -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelListEntry -> ChannelId
channelListEntryChannelId (ChannelListEntry -> ChannelId) -> ChannelListEntry -> ChannelId
forall a b. (a -> b) -> a -> b
$ ChannelSelectMatch -> ChannelListEntry
matchEntry ChannelSelectMatch
match
onMouseDown (ClickableReactionInMessage PostId
pId Text
t Set UserId
uIds) Button
Vty.BLeft [] Location
_ =
    MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ PostId -> Text -> Set UserId -> MH ()
toggleReaction PostId
pId Text
t Set UserId
uIds
onMouseDown (ClickableReaction PostId
pId Text
t Set UserId
uIds) Button
Vty.BLeft [] Location
_ =
    MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ PostId -> Text -> Set UserId -> MH ()
toggleReaction PostId
pId Text
t Set UserId
uIds
onMouseDown (ReactionEmojiListOverlayEntry (Bool, Text)
val) Button
Vty.BLeft [] Location
_ =
    Mode -> MH () -> MH ()
whenMode Mode
ReactionEmojiListOverlay (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Lens' ChatState (ListOverlayState (Bool, Text) ())
-> (Bool, Text) -> MH ()
forall a b. Lens' ChatState (ListOverlayState a b) -> a -> MH ()
listOverlayActivate ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState (Bool, Text) ()
     -> f (ListOverlayState (Bool, Text) ()))
    -> TeamState -> f TeamState)
-> (ListOverlayState (Bool, Text) ()
    -> f (ListOverlayState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState (Bool, Text) ()
 -> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState (Bool, Text) ())
tsReactionEmojiListOverlay) (Bool, Text)
val
onMouseDown Name
_ Button
_ [Modifier]
_ Location
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

formatError :: MHError -> T.Text
formatError :: MHError -> Text
formatError (GenericError Text
msg) =
    Text
msg
formatError (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
formatError (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
formatError (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."
formatError (ServerError MattermostError
e) =
    MattermostError -> Text
mattermostErrorMessage MattermostError
e
formatError (ClipboardError Text
msg) =
    Text
msg
formatError (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"
formatError (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."
formatError (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"
formatError (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)
formatError (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"
          -- this case shouldn't be reached
formatError (BadAttachmentPath Text
msg) =
    Text
msg
formatError (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 Event
e = do
    case Event
e of
        (Vty.EvResize Int
_ Int
_) ->
            -- On resize, invalidate the entire rendering cache since
            -- many things depend on the window size.
            --
            -- Note: we fall through after this because it is sometimes
            -- important for modes to have their own additional logic
            -- to run when a resize occurs, so we don't want to stop
            -- processing here.
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
        Event
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    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
$ (KeyConfig -> KeyHandlerMap)
-> (Event -> MH ()) -> Event -> MH Bool
handleKeyboardEvent KeyConfig -> KeyHandlerMap
globalKeybindings Event -> MH ()
handleGlobalEvent Event
e

handleGlobalEvent :: Vty.Event -> MH ()
handleGlobalEvent :: Event -> MH ()
handleGlobalEvent Event
e = do
    Mode
mode <- Getting Mode ChatState Mode -> MH Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode)
    Mode -> Event -> MH ()
globalHandlerByMode Mode
mode Event
e

globalHandlerByMode :: Mode -> Vty.Event -> MH ()
globalHandlerByMode :: Mode -> Event -> MH ()
globalHandlerByMode Mode
mode =
    case Mode
mode of
        Mode
Main                       -> Event -> MH ()
onEventMain
        ShowHelp HelpTopic
_ Mode
_               -> 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
onEventShowHelp
        Mode
ChannelSelect              -> 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
onEventChannelSelect
        Mode
UrlSelect                  -> 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
onEventUrlSelect
        Mode
LeaveChannelConfirm        -> Event -> MH ()
onEventLeaveChannelConfirm
        Mode
MessageSelect              -> Event -> MH ()
onEventMessageSelect
        Mode
MessageSelectDeleteConfirm -> Event -> MH ()
onEventMessageSelectDeleteConfirm
        Mode
DeleteChannelConfirm       -> Event -> MH ()
onEventDeleteChannelConfirm
        Mode
ThemeListOverlay           -> Event -> MH ()
onEventThemeListOverlay
        PostListOverlay PostListContents
_          -> Event -> MH ()
onEventPostListOverlay
        Mode
UserListOverlay            -> Event -> MH ()
onEventUserListOverlay
        Mode
ChannelListOverlay         -> Event -> MH ()
onEventChannelListOverlay
        Mode
ReactionEmojiListOverlay   -> Event -> MH ()
onEventReactionEmojiListOverlay
        Mode
ViewMessage                -> 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
. Lens' ChatState (TabbedWindow ViewMessageWindowTab)
-> Event -> MH Bool
forall a.
(Show a, Eq a) =>
Lens' ChatState (TabbedWindow a) -> Event -> MH Bool
handleTabbedWindowEvent
                                             ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> TeamState -> f TeamState)
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> TeamState -> f TeamState
Lens'
  TeamState (Maybe (Message, TabbedWindow ViewMessageWindowTab))
tsViewedMessage((Maybe (Message, TabbedWindow ViewMessageWindowTab)
  -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
 -> TeamState -> f TeamState)
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> Maybe (Message, TabbedWindow ViewMessageWindowTab)
    -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> TeamState
-> f TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Message, TabbedWindow ViewMessageWindowTab)
  (Message, TabbedWindow ViewMessageWindowTab)
-> Lens
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     (Message, TabbedWindow ViewMessageWindowTab)
     (Message, TabbedWindow ViewMessageWindowTab)
forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
Traversal
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Maybe (Message, TabbedWindow ViewMessageWindowTab))
  (Message, TabbedWindow ViewMessageWindowTab)
  (Message, TabbedWindow ViewMessageWindowTab)
_Just(((Message, TabbedWindow ViewMessageWindowTab)
  -> f (Message, TabbedWindow ViewMessageWindowTab))
 -> Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> f (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> ((TabbedWindow ViewMessageWindowTab
     -> f (TabbedWindow ViewMessageWindowTab))
    -> (Message, TabbedWindow ViewMessageWindowTab)
    -> f (Message, TabbedWindow ViewMessageWindowTab))
-> (TabbedWindow ViewMessageWindowTab
    -> f (TabbedWindow ViewMessageWindowTab))
-> Maybe (Message, TabbedWindow ViewMessageWindowTab)
-> f (Maybe (Message, TabbedWindow ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TabbedWindow ViewMessageWindowTab
 -> f (TabbedWindow ViewMessageWindowTab))
-> (Message, TabbedWindow ViewMessageWindowTab)
-> f (Message, TabbedWindow ViewMessageWindowTab)
forall s t a b. Field2 s t a b => Lens s t a b
_2)
        Mode
ManageAttachments          -> Event -> MH ()
onEventManageAttachments
        Mode
ManageAttachmentsBrowseFiles -> Event -> MH ()
onEventManageAttachments
        Mode
EditNotifyPrefs            -> 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
onEventEditNotifyPrefs
        Mode
ChannelTopicWindow         -> Event -> MH ()
onEventChannelTopicWindow
        SaveAttachmentWindow LinkChoice
_     -> Event -> MH ()
onEventSaveAttachmentWindow

globalKeybindings :: KeyConfig -> KeyHandlerMap
globalKeybindings :: KeyConfig -> KeyHandlerMap
globalKeybindings = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings [KeyEventHandler]
globalKeyHandlers

globalKeyHandlers :: [KeyEventHandler]
globalKeyHandlers :: [KeyEventHandler]
globalKeyHandlers =
    [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ShowHelpEvent
        Text
"Show this help screen"
        (HelpTopic -> MH ()
showHelpScreen HelpTopic
mainHelpTopic)
    ]

-- | Refresh client-accessible server configuration information. This
-- is usually triggered when a reconnect event for the WebSocket to the
-- server occurs.
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 (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