{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Matterhorn.Command
  ( commandList
  , dispatchCommand
  , printArgSpec
  , toggleMessagePreview
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( invalidateCache )
import qualified Control.Exception as Exn
import qualified Data.Char as Char
import qualified Data.Text as T
import           Lens.Micro.Platform ( (%=) )

import qualified Network.Mattermost.Endpoints as MM
import qualified Network.Mattermost.Exceptions as MM
import qualified Network.Mattermost.Types as MM

import           Matterhorn.State.Attachments
import           Matterhorn.Connection ( connectWebsockets )
import           Matterhorn.Constants ( normalChannelSigil )
import           Matterhorn.HelpTopics
import           Matterhorn.Scripts
import           Matterhorn.State.Help
import           Matterhorn.State.Editing
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Channels
import           Matterhorn.State.ChannelTopicWindow
import           Matterhorn.State.ChannelSelect
import           Matterhorn.State.Logging
import           Matterhorn.State.PostListOverlay
import           Matterhorn.State.UserListOverlay
import           Matterhorn.State.ChannelListOverlay
import           Matterhorn.State.ThemeListOverlay
import           Matterhorn.State.Messages
import           Matterhorn.State.NotifyPrefs
import           Matterhorn.State.Common ( postInfoMessage )
import           Matterhorn.State.Teams
import           Matterhorn.State.Users
import           Matterhorn.Themes ( attrForUsername )
import           Matterhorn.Types


-- | This function skips any initial whitespace and returns the first
-- 'token' (i.e. any sequence of non-whitespace characters) as well as
-- the trailing rest of the string, after any whitespace. This is used
-- for tokenizing the first bits of command input while leaving the
-- subsequent chunks unchanged, preserving newlines and other
-- important formatting.
unwordHead :: Text -> Maybe (Text, Text)
unwordHead :: Text -> Maybe (Text, Text)
unwordHead Text
t =
  let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
Char.isSpace Text
t
      (Text
w, Text
rs)  = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
Char.isSpace Text
t'
  in if Text -> Bool
T.null Text
w
       then Maybe (Text, Text)
forall a. Maybe a
Nothing
       else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
w, (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
Char.isSpace Text
rs)

printArgSpec :: CmdArgs a -> Text
printArgSpec :: CmdArgs a -> Text
printArgSpec CmdArgs a
NoArg = Text
""
printArgSpec (LineArg Text
ts) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
printArgSpec (TokenArg Text
t CmdArgs rest
NoArg) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
printArgSpec (UserArg CmdArgs rest
rs) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
"user" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addSpace (CmdArgs rest -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs rest
rs)
printArgSpec (ChannelArg CmdArgs rest
rs) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"channel>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addSpace (CmdArgs rest -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs rest
rs)
printArgSpec (TokenArg Text
t CmdArgs rest
rs) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addSpace (CmdArgs rest -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs rest
rs)

addSpace :: Text -> Text
addSpace :: Text -> Text
addSpace Text
"" = Text
""
addSpace Text
t = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

matchArgs :: CmdArgs a -> Text -> Either Text a
matchArgs :: CmdArgs a -> Text -> Either Text a
matchArgs CmdArgs a
NoArg Text
t = case Text -> Maybe (Text, Text)
unwordHead Text
t of
  Maybe (Text, Text)
Nothing -> () -> Either Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just (Text
a, Text
as)
    | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
Char.isSpace Text
as) -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Unexpected arguments '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
    | Bool
otherwise -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Unexpected argument '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
matchArgs (LineArg Text
_) Text
t = Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
matchArgs spec :: CmdArgs a
spec@(UserArg CmdArgs rest
rs) Text
t = case Text -> Maybe (Text, Text)
unwordHead Text
t of
  Maybe (Text, Text)
Nothing -> case CmdArgs rest
rs of
    CmdArgs rest
NoArg -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing argument: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
    CmdArgs rest
_     -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing arguments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
  Just (Text
a, Text
as) -> (,) (Text -> rest -> (Text, rest))
-> Either Text Text -> Either Text (rest -> (Text, rest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> (Text, rest))
-> Either Text rest -> Either Text (Text, rest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmdArgs rest -> Text -> Either Text rest
forall a. CmdArgs a -> Text -> Either Text a
matchArgs CmdArgs rest
rs Text
as
matchArgs spec :: CmdArgs a
spec@(ChannelArg CmdArgs rest
rs) Text
t = case Text -> Maybe (Text, Text)
unwordHead Text
t of
  Maybe (Text, Text)
Nothing -> case CmdArgs rest
rs of
    CmdArgs rest
NoArg -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing argument: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
    CmdArgs rest
_     -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing arguments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
  Just (Text
a, Text
as) -> (,) (Text -> rest -> (Text, rest))
-> Either Text Text -> Either Text (rest -> (Text, rest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> (Text, rest))
-> Either Text rest -> Either Text (Text, rest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmdArgs rest -> Text -> Either Text rest
forall a. CmdArgs a -> Text -> Either Text a
matchArgs CmdArgs rest
rs Text
as
matchArgs spec :: CmdArgs a
spec@(TokenArg Text
_ CmdArgs rest
rs) Text
t = case Text -> Maybe (Text, Text)
unwordHead Text
t of
  Maybe (Text, Text)
Nothing -> case CmdArgs rest
rs of
    CmdArgs rest
NoArg -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing argument: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
    CmdArgs rest
_     -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Missing arguments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CmdArgs a -> Text
forall a. CmdArgs a -> Text
printArgSpec CmdArgs a
spec)
  Just (Text
a, Text
as) -> (,) (Text -> rest -> (Text, rest))
-> Either Text Text -> Either Text (rest -> (Text, rest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> (Text, rest))
-> Either Text rest -> Either Text (Text, rest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmdArgs rest -> Text -> Either Text rest
forall a. CmdArgs a -> Text -> Either Text a
matchArgs CmdArgs rest
rs Text
as

commandList :: [Cmd]
commandList :: [Cmd]
commandList =
  [ Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"quit" Text
"Exit Matterhorn" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () -> MH ()
requestQuit

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"right" Text
"Focus on the next channel" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
nextChannel

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"left" Text
"Focus on the previous channel" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
prevChannel

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"create-channel" Text
"Create a new public channel"
    (Text -> CmdArgs Text
LineArg Text
"channel name") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \ Text
name ->
        Bool -> CmdExec Text
createOrdinaryChannel Bool
True Text
name

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"create-private-channel" Text
"Create a new private channel"
    (Text -> CmdArgs Text
LineArg Text
"channel name") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \ Text
name ->
        Bool -> CmdExec Text
createOrdinaryChannel Bool
False Text
name

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"delete-channel" Text
"Delete the current channel"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
beginCurrentChannelDeleteConfirm

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"hide" Text
"Hide the current DM or group channel from the channel list"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () -> do
        TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        ChannelId -> MH ()
hideDMChannel (ChannelId -> MH ()) -> MH ChannelId -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"reconnect" Text
"Force a reconnection attempt to the server"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
connectWebsockets

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"members" Text
"Show the current channel's members"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterChannelMembersUserList

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"leave" Text
"Leave a normal channel or hide a DM channel" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
startLeaveCurrentChannel

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"join" Text
"Find a channel to join" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterChannelListOverlayMode

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"join" Text
"Join the specified channel" (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
ChannelArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \(Text
n, ()) ->
        CmdExec Text
joinChannelByName Text
n

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"theme" Text
"List the available themes" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterThemeListMode

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"theme" Text
"Set the color theme"
    (Text -> CmdArgs () -> CmdArgs (Text, ())
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"theme" CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
themeName, ()) ->
        CmdExec Text
setTheme Text
themeName

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"topic" Text
"Set the current channel's topic (header) interactively"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
openChannelTopicWindow

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"topic" Text
"Set the current channel's topic (header)"
    (Text -> CmdArgs Text
LineArg Text
"topic") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \ Text
p ->
        if Bool -> Bool
not (Text -> Bool
T.null Text
p) then CmdExec Text
setChannelTopic Text
p else CmdExec ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"add-user" Text
"Search for a user to add to the current channel"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterChannelInviteUserList

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"msg" Text
"Search for a user to enter a private chat"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterDMSearchUserList

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"msg" Text
"Chat with the specified user"
    (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
UserArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
name, ()) ->
        CmdExec Text
changeChannelByName Text
name

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"username-attribute" Text
"Display the attribute used to color the specified username"
    (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
UserArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
name, ()) ->
        CmdExec Text
displayUsernameAttribute Text
name

  , Text -> Text -> CmdArgs (Text, Text) -> CmdExec (Text, Text) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"msg" Text
"Go to a user's channel and send the specified message or command"
    (CmdArgs Text -> CmdArgs (Text, Text)
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
UserArg (CmdArgs Text -> CmdArgs (Text, Text))
-> CmdArgs Text -> CmdArgs (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> CmdArgs Text
LineArg Text
"message or command") (CmdExec (Text, Text) -> Cmd) -> CmdExec (Text, Text) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
name, Text
msg) -> do
        UserFetch -> (Maybe UserInfo -> MH ()) -> MH ()
withFetchedUserMaybe (Text -> UserFetch
UserFetchByUsername Text
name) ((Maybe UserInfo -> MH ()) -> MH ())
-> (Maybe UserInfo -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \Maybe UserInfo
foundUser -> do
            case Maybe UserInfo
foundUser of
                Just UserInfo
user -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel UserInfo
user (Maybe (ChannelId -> MH ()) -> MH ())
-> Maybe (ChannelId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ (ChannelId -> MH ()) -> Maybe (ChannelId -> MH ())
forall a. a -> Maybe a
Just ((ChannelId -> MH ()) -> Maybe (ChannelId -> MH ()))
-> (ChannelId -> MH ()) -> Maybe (ChannelId -> MH ())
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId -> do
                    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                    TeamId -> ChannelId -> CmdExec Text
handleInputSubmission TeamId
tId ChannelId
cId Text
msg
                Maybe UserInfo
Nothing -> MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchUser Text
name

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"log-start" Text
"Begin logging debug information to the specified path"
    (Text -> CmdArgs () -> CmdArgs (Text, ())
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"path" CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
path, ()) ->
        FilePath -> MH ()
startLogging (FilePath -> MH ()) -> FilePath -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
path

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"log-snapshot" Text
"Dump the current debug log buffer to the specified path"
    (Text -> CmdArgs () -> CmdArgs (Text, ())
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"path" CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
path, ()) ->
        FilePath -> MH ()
logSnapshot (FilePath -> MH ()) -> FilePath -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
path

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"log-stop" Text
"Stop logging"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
stopLogging

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"log-mark" Text
"Add a custom marker message to the Matterhorn debug log"
    (Text -> CmdArgs Text
LineArg Text
"message") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \ Text
markMsg ->
        LogCategory -> CmdExec Text
mhLog LogCategory
LogUserMark Text
markMsg

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"log-status" Text
"Show current debug logging status"
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
getLogDestination

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"add-user" Text
"Add a user to the current channel"
    (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
UserArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
uname, ()) ->
        CmdExec Text
addUserByNameToCurrentChannel Text
uname

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"remove" Text
"Remove a user from the current channel"
    (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
UserArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
uname, ()) ->
        CmdExec Text
removeUserFromCurrentChannel Text
uname

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"user" Text
"Show users to initiate a private DM chat channel"
    -- n.b. this is identical to "msg", but is provided as an
    -- alternative mental model for useability.
    CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterDMSearchUserList

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"message-preview" Text
"Toggle preview of the current message" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleMessagePreview

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-truncate-verbatim-blocks" Text
"Toggle truncation of verbatim and code blocks" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleVerbatimBlockTruncation

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-channel-list" Text
"Toggle channel list visibility" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleChannelListVisibility

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-message-timestamps" Text
"Toggle message timestamps" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleMessageTimestamps

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-expanded-topics" Text
"Toggle expanded channel topics" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleExpandedChannelTopics

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"focus" Text
"Focus on a channel or user"
    (CmdArgs () -> CmdArgs (Text, ())
forall rest. CmdArgs rest -> CmdArgs (Text, rest)
ChannelArg CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
name, ()) ->
        CmdExec Text
changeChannelByName Text
name

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"focus" Text
"Select from available channels" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
beginChannelSelect

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"help" Text
"Show the main help screen" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ ()
_ ->
        HelpTopic -> MH ()
showHelpScreen HelpTopic
mainHelpTopic

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"shortcuts" Text
"Show keyboard shortcuts" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ ()
_ ->
        HelpTopic -> MH ()
showHelpScreen HelpTopic
mainHelpTopic

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"help" Text
"Show help about a particular topic"
      (Text -> CmdArgs () -> CmdArgs (Text, ())
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"topic" CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
topicName, ()) ->
          case Text -> Maybe HelpTopic
lookupHelpTopic Text
topicName of
              Maybe HelpTopic
Nothing -> MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchHelpTopic Text
topicName
              Just HelpTopic
topic -> HelpTopic -> MH ()
showHelpScreen HelpTopic
topic

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"sh" Text
"List the available shell scripts" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
listScripts

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"group-create" Text
"Create a group chat"
    (Text -> CmdArgs Text
LineArg (Text -> Text
addUserSigil Text
"user" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
"user" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ...]"))
        CmdExec Text
createGroupChannel

  , Text -> Text -> CmdArgs (Text, Text) -> CmdExec (Text, Text) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"sh" Text
"Run a prewritten shell script"
    (Text -> CmdArgs Text -> CmdArgs (Text, Text)
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"script" (Text -> CmdArgs Text
LineArg Text
"message")) (CmdExec (Text, Text) -> Cmd) -> CmdExec (Text, Text) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
script, Text
text) -> do
        TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
        ChannelId -> Text -> CmdExec Text
findAndRunScript ChannelId
cId Text
script Text
text

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"flags" Text
"Open a window of your flagged posts" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterFlaggedPostListMode

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"pinned-posts" Text
"Open a window of this channel's pinned posts" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \ () ->
        MH ()
enterPinnedPostListMode

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"search" Text
"Search for posts with given terms" (Text -> CmdArgs Text
LineArg Text
"terms") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$
        CmdExec Text
enterSearchResultPostListMode

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"notify-prefs" Text
"Edit the current channel's notification preferences" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
enterEditNotifyPrefsMode

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"rename-channel-url" Text
"Rename the current channel's URL name" (Text -> CmdArgs () -> CmdArgs (Text, ())
forall rest. Text -> CmdArgs rest -> CmdArgs (Text, rest)
TokenArg Text
"channel name" CmdArgs ()
NoArg) (CmdExec (Text, ()) -> Cmd) -> CmdExec (Text, ()) -> Cmd
forall a b. (a -> b) -> a -> b
$ \ (Text
name, ()
_) ->
        CmdExec Text
renameChannelUrl Text
name

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"move-team-left" Text
"Move the currently-selected team to the left in the team list" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
moveCurrentTeamLeft

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"move-team-right" Text
"Move the currently-selected team to the right in the team list" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
moveCurrentTeamRight

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"attach" Text
"Attach a given file without browsing" (Text -> CmdArgs Text
LineArg Text
"path") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$
        CmdExec Text
attachFileByPath

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-favorite" Text
"Toggle the favorite status of the current channel" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleChannelFavoriteStatus
  ]

displayUsernameAttribute :: Text -> MH ()
displayUsernameAttribute :: CmdExec Text
displayUsernameAttribute Text
name = do
    let an :: AttrName
an = Text -> AttrName
attrForUsername Text
trimmed
        trimmed :: Text
trimmed = Text -> Text
trimUserSigil Text
name
    CmdExec Text
postInfoMessage CmdExec Text -> CmdExec Text
forall a b. (a -> b) -> a -> b
$ Text
"The attribute used for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
trimmed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      Text
" is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (AttrName -> Text
attrNameToConfig AttrName
an)

execMMCommand :: Text -> Text -> MH ()
execMMCommand :: Text -> CmdExec Text
execMMCommand Text
name Text
rest = do
  TeamId
tId      <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
  ChannelId
cId      <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
  Session
session  <- MH Session
getSession
  EditMode
em       <- Getting EditMode ChatState EditMode -> MH EditMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode)
  let mc :: MinCommand
mc = MinCommand :: ChannelId
-> Text -> Maybe PostId -> Maybe PostId -> TeamId -> MinCommand
MM.MinCommand
             { minComChannelId :: ChannelId
MM.minComChannelId = ChannelId
cId
             , minComCommand :: Text
MM.minComCommand   = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
             , minComParentId :: Maybe PostId
MM.minComParentId  = case EditMode
em of
                 Replying Message
_ Post
p -> PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ Post -> PostId
forall x y. HasId x y => x -> y
MM.getId Post
p
                 Editing Post
p MessageType
_  -> Post -> Maybe PostId
MM.postRootId Post
p
                 EditMode
_            -> Maybe PostId
forall a. Maybe a
Nothing
             , minComRootId :: Maybe PostId
MM.minComRootId  = case EditMode
em of
                 Replying Message
_ Post
p -> Post -> Maybe PostId
MM.postRootId Post
p Maybe PostId -> Maybe PostId -> Maybe PostId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ Post -> PostId
MM.postId Post
p)
                 Editing Post
p MessageType
_  -> Post -> Maybe PostId
MM.postRootId Post
p
                 EditMode
_            -> Maybe PostId
forall a. Maybe a
Nothing
             , minComTeamId :: TeamId
MM.minComTeamId = TeamId
tId
             }
      runCmd :: IO ()
runCmd = IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        IO CommandResponse -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CommandResponse -> IO ()) -> IO CommandResponse -> IO ()
forall a b. (a -> b) -> a -> b
$ MinCommand -> Session -> IO CommandResponse
MM.mmExecuteCommand MinCommand
mc Session
session
      handleHTTP :: HTTPResponseException -> m (Maybe Text)
handleHTTP (MM.HTTPResponseException FilePath
err) =
        Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
T.pack FilePath
err))
        -- XXX: this might be a bit brittle in the future, because it
        -- assumes the shape of an error message. We might want to
        -- think about a better way of discovering this error and
        -- reporting it accordingly?
      handleCmdErr :: MattermostServerError -> m (Maybe Text)
handleCmdErr (MM.MattermostServerError Text
err) =
        let (Text
_, Text
msg) = Text -> Text -> (Text, Text)
T.breakOn Text
": " Text
err in
          Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop Int
2 Text
msg))
      handleMMErr :: MattermostError -> m (Maybe Text)
handleMMErr (MM.MattermostError
                     { mattermostErrorMessage :: MattermostError -> Text
MM.mattermostErrorMessage = Text
msg }) =
        Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg)
  Maybe Text
errMsg <- IO (Maybe Text) -> MH (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> MH (Maybe Text))
-> IO (Maybe Text) -> MH (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (IO ()
runCmd IO () -> IO (Maybe Text) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing) IO (Maybe Text)
-> (HTTPResponseException -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exn.catch` HTTPResponseException -> IO (Maybe Text)
forall (m :: * -> *).
Monad m =>
HTTPResponseException -> m (Maybe Text)
handleHTTP
                                                IO (Maybe Text)
-> (MattermostServerError -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exn.catch` MattermostServerError -> IO (Maybe Text)
forall (m :: * -> *).
Monad m =>
MattermostServerError -> m (Maybe Text)
handleCmdErr
                                                IO (Maybe Text)
-> (MattermostError -> IO (Maybe Text)) -> IO (Maybe Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exn.catch` MattermostError -> IO (Maybe Text)
forall (m :: * -> *). Monad m => MattermostError -> m (Maybe Text)
handleMMErr
  case Maybe Text
errMsg of
    Maybe Text
Nothing -> CmdExec ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Text
err ->
      MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError (Text
"Error running command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err)

dispatchCommand :: Text -> MH ()
dispatchCommand :: CmdExec Text
dispatchCommand Text
cmd =
  case Text -> Maybe (Text, Text)
unwordHead Text
cmd of
    Just (Text
x, Text
xs)
      | [Cmd]
matchingCmds <- [ Cmd
c
                        | c :: Cmd
c@(Cmd Text
name Text
_ CmdArgs a
_ CmdExec a
_) <- [Cmd]
commandList
                        , Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x
                        ] -> [Text] -> [Cmd] -> MH ()
go [] [Cmd]
matchingCmds
      where go :: [Text] -> [Cmd] -> MH ()
go [] [] = do
              Text -> CmdExec Text
execMMCommand Text
x Text
xs
            go [Text]
errs [] = do
              let msg :: Text
msg = (Text
"error running command /" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                         [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e | Text
e <- [Text]
errs ])
              MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
msg
            go [Text]
errs (Cmd Text
_ Text
_ CmdArgs a
spec CmdExec a
exe : [Cmd]
cs) =
              case CmdArgs a -> Text -> Either Text a
forall a. CmdArgs a -> Text -> Either Text a
matchArgs CmdArgs a
spec Text
xs of
                Left Text
e -> [Text] -> [Cmd] -> MH ()
go (Text
eText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
errs) [Cmd]
cs
                Right a
args -> CmdExec a
exe a
args
    Maybe (Text, Text)
_ -> CmdExec ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

toggleMessagePreview :: MH ()
toggleMessagePreview :: MH ()
toggleMessagePreview = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
    (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
configShowMessagePreviewL ((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