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

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( invalidateCache )
import           Brick.Themes ( saveTheme )
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.Common
import           Matterhorn.State.Logging
import           Matterhorn.State.PostListWindow
import           Matterhorn.State.UserListWindow
import           Matterhorn.State.ChannelListWindow
import           Matterhorn.State.ThemeListWindow
import           Matterhorn.State.Messages
import           Matterhorn.State.NotifyPrefs
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 :: forall a. 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 :: forall a. 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 -> a -> Either Text a
forall a. a -> Either Text a
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 = a -> Either Text a
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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 -> a) -> Either Text Text -> Either Text (rest -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> a) -> Either Text rest -> Either Text a
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
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 -> a) -> Either Text Text -> Either Text (rest -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> a) -> Either Text rest -> Either Text a
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
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 -> a) -> Either Text Text -> Either Text (rest -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a Either Text (rest -> a) -> Either Text rest -> Either Text a
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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 -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> Bool -> CmdExec Text
createOrdinaryChannel TeamId
tId 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 -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> Bool -> CmdExec Text
createOrdinaryChannel TeamId
tId 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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 -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
                ChannelId -> MH ()
hideDMChannel ChannelId
cId

  , 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
enterChannelMembersUserList

  , Text -> Text -> CmdArgs (Text, ()) -> CmdExec (Text, ()) -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"write-theme" Text
"Write the current theme to a theme settings file"
    (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, ()) -> do
        Theme
theme <- Getting Theme ChatState Theme -> MH Theme
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Theme ChatResources)
-> ChatState -> Const Theme ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Theme ChatResources)
 -> ChatState -> Const Theme ChatState)
-> ((Theme -> Const Theme Theme)
    -> ChatResources -> Const Theme ChatResources)
-> Getting Theme ChatState Theme
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Theme -> Const Theme Theme)
-> ChatResources -> Const Theme ChatResources
Lens' ChatResources Theme
crThemeOriginal)
        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
$ FilePath -> Theme -> IO ()
saveTheme (Text -> FilePath
T.unpack Text
path) Theme
theme
        CmdExec Text
postInfoMessage CmdExec Text -> CmdExec Text
forall a b. (a -> b) -> a -> b
$ Text
"Current theme written to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path

  , 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
enterChannelListWindowMode

  , 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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
joinChannelByName TeamId
tId 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
setTheme TeamId
tId 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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 -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            if Bool -> Bool
not (Text -> Bool
T.null Text
p) then TeamId -> CmdExec Text
setChannelTopic TeamId
tId Text
p else CmdExec ()
forall a. a -> MH a
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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
changeChannelByName TeamId
tId 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
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            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 -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
tId 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
_ -> do
                        TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ ->
                            Lens' ChatState (EditState Name) -> CmdExec Text
handleInputSubmission (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
addUserByNameToCurrentChannel TeamId
tId 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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
removeUserFromCurrentChannel TeamId
tId 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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 () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"cycle-channel-list-sorting" Text
"Cycle through channel list sorting modes for this team" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
cycleChannelListSortingMode

  , Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"thread-orientation" Text
"Set the orientation of the thread UI" (Text -> CmdArgs Text
LineArg Text
"left|right|above|below") (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \Text
o ->
        CmdExec Text
setThreadOrientationByName Text
o

  , 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, ()) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
changeChannelByName TeamId
tId 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \ ()
_ -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> HelpTopic -> MH ()
showHelpScreen TeamId
tId 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
$ \ ()
_ -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> HelpTopic -> MH ()
showHelpScreen TeamId
tId 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, ()) -> do
          (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
              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 -> TeamId -> HelpTopic -> MH ()
showHelpScreen TeamId
tId 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 -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \ Text
t -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
createGroupChannel TeamId
tId Text
t

  , 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 -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
                Lens' ChatState (EditState Name) -> Text -> CmdExec Text
findAndRunScript (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \ () -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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
$ \Text
t -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
enterSearchResultPostListMode TeamId
tId Text
t

  , 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
$ \()
_ -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> 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, ()
_) -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
            TeamId -> CmdExec Text
renameChannelUrl TeamId
tId 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
$ \Text
path -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
            MessageInterfaceFocus
foc <- Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
-> MH MessageInterfaceFocus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const MessageInterfaceFocus TeamState)
 -> ChatState -> Const MessageInterfaceFocus ChatState)
-> ((MessageInterfaceFocus
     -> Const MessageInterfaceFocus MessageInterfaceFocus)
    -> TeamState -> Const MessageInterfaceFocus TeamState)
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus
 -> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus)
            case MessageInterfaceFocus
foc of
                MessageInterfaceFocus
FocusThread ->
                    Lens' ChatState (MessageInterface Name PostId) -> CmdExec Text
forall i. Lens' ChatState (MessageInterface Name i) -> CmdExec Text
attachFileByPath (HasCallStack =>
TeamId -> Lens' ChatState (MessageInterface Name PostId)
TeamId -> Lens' ChatState (MessageInterface Name PostId)
unsafeThreadInterface(TeamId
tId)) Text
path
                MessageInterfaceFocus
FocusCurrentChannel ->
                    TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ ->
                        Lens' ChatState (MessageInterface Name ()) -> CmdExec Text
forall i. Lens' ChatState (MessageInterface Name i) -> CmdExec Text
attachFileByPath (ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface(ChannelId
cId)) Text
path

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-mouse-input" Text
"Toggle whether mouse input is enabled" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        MH ()
toggleMouseMode

  , 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
$ \()
_ -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
toggleChannelFavoriteStatus

  , Text -> Text -> CmdArgs () -> CmdExec () -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-sidebar-group" Text
"Toggle the visibility of the current channel's sidebar group" CmdArgs ()
NoArg (CmdExec () -> Cmd) -> CmdExec () -> Cmd
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
toggleCurrentChannelChannelListGroup

  , let names :: Text
names = Text -> [Text] -> Text
T.intercalate Text
"|" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text, ChannelListGroupLabel) -> Text
forall a b. (a, b) -> a
fst ((Text, ChannelListGroupLabel) -> Text)
-> [(Text, ChannelListGroupLabel)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, ChannelListGroupLabel)]
channelListGroupNames
    in Text -> Text -> CmdArgs Text -> CmdExec Text -> Cmd
forall a. Text -> Text -> CmdArgs a -> CmdExec a -> Cmd
Cmd Text
"toggle-sidebar-group" Text
"Toggle the visibility of the named sidebar group" (Text -> CmdArgs Text
LineArg Text
names) (CmdExec Text -> Cmd) -> CmdExec Text -> Cmd
forall a b. (a -> b) -> a -> b
$ \Text
name -> do
        (TeamId -> MH ()) -> MH ()
withCurrentTeam (Text -> TeamId -> MH ()
toggleCurrentChannelChannelListGroupByName Text
name)
  ]

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 :: MM.TeamId -> Text -> Text -> MH ()
execMMCommand :: TeamId -> Text -> CmdExec Text
execMMCommand TeamId
tId Text
name Text
rest = do
  TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
      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 (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(ChannelId
cId)((EditState Name -> Const EditMode (EditState Name))
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> EditState Name -> Const EditMode (EditState Name))
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> EditState Name -> Const EditMode (EditState Name)
forall n (f :: * -> *).
Functor f =>
(EditMode -> f EditMode) -> EditState n -> f (EditState n)
esEditMode)
      let mc :: MinCommand
mc = 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 a. Maybe a -> Maybe a -> Maybe a
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 a. IO a -> IO a
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 a. a -> m a
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) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
": " Text
err in
              Maybe Text -> m (Maybe Text)
forall a. a -> m a
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 a. a -> m a
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 a. IO a -> MH a
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
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 a. a -> MH a
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 :: MM.TeamId -> Text -> MH ()
dispatchCommand :: TeamId -> CmdExec Text
dispatchCommand TeamId
tId 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
              TeamId -> Text -> CmdExec Text
execMMCommand TeamId
tId 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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

toggleMessagePreview :: MH ()
toggleMessagePreview :: MH ()
toggleMessagePreview = do
    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
    (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