{-# LANGUAGE BangPatterns, OverloadedStrings, TemplateHaskell, ExistentialQuantification #-}

    {-|
    Module      : Client.Commands
    Description : Implementation of slash commands
    Copyright   : (c) Eric Mertens, 2016
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module renders the lines used in the channel mask list. A mask list
    can show channel bans, quiets, invites, and exceptions.
    -}

module Client.Commands
  ( CommandResult(..)
  , execute
  , executeUserCommand
  , commandExpansion
  , tabCompletion
  -- * Commands
  , CommandSection(..)
  , Command(..)
  , CommandImpl(..)
  , commands
  , commandsList
  ) where

import Client.Commands.Arguments.Parser (parse)
import Client.Commands.Arguments.Spec (optionalArg, optionalNumberArg, remainingArg, simpleToken, extensionArg, mapArgEnv, Args)
import Client.Commands.Docs (clientDocs, cmdDoc)
import Client.Commands.Exec
import Client.Commands.Interpolation (resolveMacroExpansions, Macro(Macro), MacroSpec(MacroSpec), ExpansionChunk)
import Client.Commands.Recognizer (fromCommands, keys, recognize, Recognition(Exact), Recognizer)
import Client.Commands.WordCompletion (caseText, plainWordCompleteMode, wordComplete)
import Client.Configuration
import Client.State
import Client.State.Extensions (clientCommandExtension, clientStartExtensions)
import Client.State.Focus
import Client.State.Help (hsQuery, helpQueryToText)
import Client.State.Network (csNick, isChannelIdentifier, sendMsg)
import Client.State.Url
import Control.Applicative (liftA2, (<|>))
import Control.Exception (displayException, try)
import Control.Lens
import Control.Monad (guard, foldM)
import Data.Foldable (foldl', toList)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (getZonedTime)
import Irc.Commands (ircPrivmsg)
import Irc.Identifier (idText)
import Irc.Message (IrcMsg(Privmsg))
import Irc.RawIrcMsg (parseRawIrcMsg)
import RtsStats (getStats)
import System.Process.Typed (proc, runProcess_)

import Client.Commands.Certificate (newCertificateCommand)
import Client.Commands.Channel (channelCommands)
import Client.Commands.Chat (chatCommands, chatCommand', executeChat)
import Client.Commands.Connection (connectionCommands)
import Client.Commands.Help (cmdHelp)
import Client.Commands.Operator (operatorCommands)
import Client.Commands.Queries (queryCommands)
import Client.Commands.TabCompletion
import Client.Commands.Toggles (togglesCommands)
import Client.Commands.Types
import Client.Commands.Window (windowCommands, focusNames)
import Client.Commands.ZNC (zncCommands)
import Data.Maybe (maybeToList)

-- | Interpret the given chat message or command. Leading @/@ indicates a
-- command. Otherwise if a channel or user query is focused a chat message will
-- be sent. Leading spaces before the @/@ are ignored when checking for
-- commands.
execute ::
  String           {- ^ chat or command -} ->
  ClientState      {- ^ client state    -} ->
  IO CommandResult {- ^ command result  -}
execute :: String -> ClientState -> IO CommandResult
execute String
str ClientState
st =
  let st' :: ClientState
st' = ASetter ClientState ClientState (Maybe Text) (Maybe Text)
-> Maybe Text -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Text) (Maybe Text)
Lens' ClientState (Maybe Text)
clientErrorMsg Maybe Text
forall a. Maybe a
Nothing ClientState
st in
  case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
str of
    []          -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
    Char
'/':String
command -> Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand Maybe Text
forall a. Maybe a
Nothing String
command ClientState
st'
    String
_           -> Focus -> String -> ClientState -> IO CommandResult
executeChat (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st') String
str ClientState
st'

-- | Execute command provided by user, resolve aliases if necessary.
--
-- The last disconnection time is stored in text form and is available
-- for substitutions in macros. It is only provided when running startup
-- commands during a reconnect event.
executeUserCommand ::
  Maybe Text       {- ^ disconnection time -} ->
  String           {- ^ command            -} ->
  ClientState      {- ^ client state       -} ->
  IO CommandResult {- ^ command result     -}
executeUserCommand :: Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand = Maybe Focus
-> Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommandIn Maybe Focus
forall a. Maybe a
Nothing

executeMacro ::
  Maybe Focus ->
  Maybe Text ->
  [[ExpansionChunk]] ->
  ClientState ->
  [String] ->
  IO CommandResult
executeMacro :: Maybe Focus
-> Maybe Text
-> [[ExpansionChunk]]
-> ClientState
-> [String]
-> IO CommandResult
executeMacro Maybe Focus
focusOverride Maybe Text
discoTime [[ExpansionChunk]]
cmdExs ClientState
st [String]
args =
  case ([ExpansionChunk] -> Maybe Text)
-> [[ExpansionChunk]] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
args)) [[ExpansionChunk]]
cmdExs of
    Maybe [Text]
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"macro expansions failed" ClientState
st
    Just [Text]
cmds -> [Text] -> ClientState -> IO CommandResult
process [Text]
cmds ClientState
st
  where
    resolveMacro :: [Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro [Text]
args' = (Text -> Maybe Text)
-> (Integer -> Maybe Text) -> [ExpansionChunk] -> Maybe Text
forall (f :: * -> *).
Alternative f =>
(Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions (Maybe Focus -> Maybe Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Focus
focusOverride Maybe Text
discoTime ClientState
st) ([Text] -> Integer -> Maybe Text
forall a. [a] -> Integer -> Maybe a
expandInt [Text]
args')
    expandInt :: [a] -> Integer -> Maybe a
    expandInt :: forall a. [a] -> Integer -> Maybe a
expandInt [a]
args' Integer
i = Getting (First a) [a] a -> [a] -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index [a] -> Traversal' [a] (IxValue [a])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Integer -> Index [a]
forall a. Num a => Integer -> a
fromInteger Integer
i)) [a]
args'
    process :: [Text] -> ClientState -> IO CommandResult
process [] ClientState
st0 = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st0
    process (Text
c:[Text]
cs) ClientState
st0 =
      do CommandResult
res <- Maybe Bool
-> Maybe Focus -> String -> ClientState -> IO CommandResult
executeCommand Maybe Bool
forall a. Maybe a
Nothing Maybe Focus
focusOverride (Text -> String
Text.unpack Text
c) ClientState
st0
         case CommandResult
res of
           CommandSuccess ClientState
st1 -> [Text] -> ClientState -> IO CommandResult
process [Text]
cs ClientState
st1
           CommandFailure ClientState
st1 -> [Text] -> ClientState -> IO CommandResult
process [Text]
cs ClientState
st1 -- ?
           CommandQuit ClientState
st1    -> CommandResult -> IO CommandResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st1)

-- | Execute command provided by user, resolve aliases if necessary,
-- optionally in the provided focus instead of the current one.
--
-- The last disconnection time is stored in text form and is available
-- for substitutions in macros. It is only provided when running startup
-- commands during a reconnect event.
executeUserCommandIn ::
  Maybe Focus      {- ^ focus override     -} ->
  Maybe Text       {- ^ disconnection time -} ->
  String           {- ^ command            -} ->
  ClientState      {- ^ client state       -} ->
  IO CommandResult {- ^ command result     -}
executeUserCommandIn :: Maybe Focus
-> Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommandIn Maybe Focus
focusOverride Maybe Text
discoTime String
command ClientState
st = do
  let key :: Text
key = (Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') (String -> Text
Text.pack String
command)
      rest :: String
rest = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') String
command)
  case LensLike'
  (Const (Recognition Macro)) ClientState (Recognizer Macro)
-> (Recognizer Macro -> Recognition Macro)
-> ClientState
-> Recognition Macro
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const (Recognition Macro) Configuration)
-> ClientState -> Const (Recognition Macro) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognition Macro) Configuration)
 -> ClientState -> Const (Recognition Macro) ClientState)
-> ((Recognizer Macro
     -> Const (Recognition Macro) (Recognizer Macro))
    -> Configuration -> Const (Recognition Macro) Configuration)
-> LensLike'
     (Const (Recognition Macro)) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro -> Const (Recognition Macro) (Recognizer Macro))
-> Configuration -> Const (Recognition Macro) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) (Text -> Recognizer Macro -> Recognition Macro
forall a. Text -> Recognizer a -> Recognition a
recognize Text
key) ClientState
st of
    Exact (Macro Text
_ (MacroSpec forall r. Args r [String]
spec) [[ExpansionChunk]]
cmdExs) ->
      case ClientState
-> Args ClientState [String] -> String -> Maybe [String]
forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState [String]
forall r. Args r [String]
spec String
rest of
        Maybe [String]
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad macro arguments" ClientState
st
        Just [String]
args -> Maybe Focus
-> Maybe Text
-> [[ExpansionChunk]]
-> ClientState
-> [String]
-> IO CommandResult
executeMacro Maybe Focus
focusOverride Maybe Text
discoTime [[ExpansionChunk]]
cmdExs ClientState
st [String]
args
    Recognition Macro
_ -> Maybe Bool
-> Maybe Focus -> String -> ClientState -> IO CommandResult
executeCommand Maybe Bool
forall a. Maybe a
Nothing Maybe Focus
focusOverride String
command ClientState
st

-- | Compute the replacement value for the given expansion variable.
commandExpansion ::
  Maybe Focus {- ^ focus override     -} ->
  Maybe Text  {- ^ disconnect time    -} ->
  ClientState {- ^ client state       -} ->
  Text        {- ^ expansion variable -} ->
  Maybe Text  {- ^ expansion value    -}
commandExpansion :: Maybe Focus -> Maybe Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Focus
focusOverride Maybe Text
discoTime ClientState
st Text
v =
  case Text
v of
    Text
"network" -> Focus -> Maybe Text
focusNetwork Focus
focus
    Text
"channel" -> Getting (First Text) Focus Identifier
-> (Identifier -> Text) -> Focus -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
Getting (First r) s a -> (a -> r) -> m (Maybe r)
previews (((Text, Identifier) -> Const (First Text) (Text, Identifier))
-> Focus -> Const (First Text) Focus
Prism' Focus (Text, Identifier)
_ChannelFocus (((Text, Identifier) -> Const (First Text) (Text, Identifier))
 -> Focus -> Const (First Text) Focus)
-> ((Identifier -> Const (First Text) Identifier)
    -> (Text, Identifier) -> Const (First Text) (Text, Identifier))
-> Getting (First Text) Focus Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Const (First Text) Identifier)
-> (Text, Identifier) -> Const (First Text) (Text, Identifier)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Text, Identifier) (Text, Identifier) Identifier Identifier
_2) Identifier -> Text
idText Focus
focus
    Text
"nick"    -> do Text
net <- Focus -> Maybe Text
focusNetwork Focus
focus
                    NetworkState
cs  <- Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st
                    Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (LensLike' (Const Text) NetworkState Identifier
-> (Identifier -> Text) -> NetworkState -> Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Text) NetworkState Identifier
Lens' NetworkState Identifier
csNick Identifier -> Text
idText NetworkState
cs)
    Text
"disconnect" -> Maybe Text
discoTime
    Text
_         -> Maybe Text
forall a. Maybe a
Nothing
  where focus :: Focus
focus = Focus -> Maybe Focus -> Focus
forall a. a -> Maybe a -> a
fromMaybe (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) Maybe Focus
focusOverride

-- | Respond to the TAB key being pressed. This can dispatch to a command
-- specific completion mode when relevant. Otherwise this will complete
-- input based on the users of the channel related to the current buffer.
tabCompletion ::
  Bool             {- ^ reversed       -} ->
  ClientState      {- ^ client state   -} ->
  IO CommandResult {- ^ command result -}
tabCompletion :: Bool -> ClientState -> IO CommandResult
tabCompletion Bool
isReversed ClientState
st =
  case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int, String) -> String
forall a b. (a, b) -> b
snd ((Int, String) -> String) -> (Int, String) -> String
forall a b. (a -> b) -> a -> b
$ ClientState -> (Int, String)
clientLine ClientState
st of
    Char
'/':String
command -> Maybe Bool
-> Maybe Focus -> String -> ClientState -> IO CommandResult
executeCommand (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
isReversed) Maybe Focus
forall a. Maybe a
Nothing String
command ClientState
st
    String
_           -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st

data ContextFreeCommand = forall a. ContextFreeCommand
  { ContextFreeCommand -> ArgsContext
cfCmdCtx  :: ArgsContext
  , ()
cfCmdArgs :: Args ArgsContext a
  , ()
cfCmdExec :: ClientState -> a -> IO CommandResult
  , ContextFreeCommand
-> Bool -> ClientState -> String -> IO CommandResult
cfCmdTab  :: Bool -> ClientState -> String -> IO CommandResult
  }

executeContextFreeCommand :: ContextFreeCommand -> Maybe Bool -> String -> IO CommandResult
executeContextFreeCommand :: ContextFreeCommand -> Maybe Bool -> String -> IO CommandResult
executeContextFreeCommand ContextFreeCommand{cfCmdCtx :: ContextFreeCommand -> ArgsContext
cfCmdCtx=ArgsContext
ctx, cfCmdArgs :: ()
cfCmdArgs=Args ArgsContext a
spec, cfCmdExec :: ()
cfCmdExec=ClientState -> a -> IO CommandResult
exec, cfCmdTab :: ContextFreeCommand
-> Bool -> ClientState -> String -> IO CommandResult
cfCmdTab=Bool -> ClientState -> String -> IO CommandResult
tab} Maybe Bool
tabComplete String
args =
  case Maybe Bool
tabComplete of
    Just Bool
isReversed -> Bool -> ClientState -> String -> IO CommandResult
tab Bool
isReversed (ArgsContext -> ClientState
argsContextSt ArgsContext
ctx) String
args
    Maybe Bool
Nothing ->
      case ArgsContext -> Args ArgsContext a -> String -> Maybe a
forall r a. r -> Args r a -> String -> Maybe a
parse ArgsContext
ctx Args ArgsContext a
spec String
args of
        Maybe a
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad command arguments" (ArgsContext -> ClientState
argsContextSt ArgsContext
ctx)
        Just a
arg -> ClientState -> a -> IO CommandResult
exec (ArgsContext -> ClientState
argsContextSt ArgsContext
ctx) a
arg

cfCmdAsArgs :: ContextFreeCommand -> Args ArgsContext (ClientState -> IO CommandResult)
cfCmdAsArgs :: ContextFreeCommand
-> Args ArgsContext (ClientState -> IO CommandResult)
cfCmdAsArgs ContextFreeCommand{cfCmdArgs :: ()
cfCmdArgs=Args ArgsContext a
spec, cfCmdExec :: ()
cfCmdExec=ClientState -> a -> IO CommandResult
exec} = (a -> ClientState -> IO CommandResult)
-> Args ArgsContext a
-> Args ArgsContext (ClientState -> IO CommandResult)
forall a b.
(a -> b) -> Ap (Arg ArgsContext) a -> Ap (Arg ArgsContext) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientState -> a -> IO CommandResult)
-> a -> ClientState -> IO CommandResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientState -> a -> IO CommandResult
exec) Args ArgsContext a
spec

-- | Look up a command or macro by name and return a @ContextFreeCommand@s.
prepareMacro :: Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareMacro :: Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareMacro Focus
focus String
cmd ClientState
st =
  case LensLike'
  (Const (Recognition Macro)) ClientState (Recognizer Macro)
-> (Recognizer Macro -> Recognition Macro)
-> ClientState
-> Recognition Macro
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const (Recognition Macro) Configuration)
-> ClientState -> Const (Recognition Macro) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognition Macro) Configuration)
 -> ClientState -> Const (Recognition Macro) ClientState)
-> ((Recognizer Macro
     -> Const (Recognition Macro) (Recognizer Macro))
    -> Configuration -> Const (Recognition Macro) Configuration)
-> LensLike'
     (Const (Recognition Macro)) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro -> Const (Recognition Macro) (Recognizer Macro))
-> Configuration -> Const (Recognition Macro) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) (Text -> Recognizer Macro -> Recognition Macro
forall a. Text -> Recognizer a -> Recognition a
recognize (Text -> Recognizer Macro -> Recognition Macro)
-> Text -> Recognizer Macro -> Recognition Macro
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
cmd) ClientState
st of
    Exact (Macro Text
_ (MacroSpec forall r. Args r [String]
args) [[ExpansionChunk]]
chunks) -> ContextFreeCommand -> Either Text ContextFreeCommand
forall a b. b -> Either a b
Right (ContextFreeCommand -> Either Text ContextFreeCommand)
-> ContextFreeCommand -> Either Text ContextFreeCommand
forall a b. (a -> b) -> a -> b
$ ContextFreeCommand
      { cfCmdCtx :: ArgsContext
cfCmdCtx=ArgsContext {argsContextSt :: ClientState
argsContextSt=ClientState
st, argsContextFocus :: Focus
argsContextFocus=Focus
focus}
      , cfCmdArgs :: Args ArgsContext [String]
cfCmdArgs=Args ArgsContext [String]
forall r. Args r [String]
args
      , cfCmdExec :: ClientState -> [String] -> IO CommandResult
cfCmdExec=Maybe Focus
-> Maybe Text
-> [[ExpansionChunk]]
-> ClientState
-> [String]
-> IO CommandResult
executeMacro (Focus -> Maybe Focus
forall a. a -> Maybe a
Just Focus
focus) Maybe Text
forall a. Maybe a
Nothing [[ExpansionChunk]]
chunks
      , cfCmdTab :: Bool -> ClientState -> String -> IO CommandResult
cfCmdTab=(\Bool
rev ClientState
st' String
_ -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
rev ClientState
st')
      }
    Recognition Macro
_ -> Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareCommand Focus
focus String
cmd ClientState
st

-- | Look up a command by name and return a @ContextFreeCommand@.
prepareCommand :: Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareCommand :: Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareCommand Focus
focus String
cmd ClientState
st =
  case Text -> Recognizer Command -> Recognition Command
forall a. Text -> Recognizer a -> Recognition a
recognize (Text -> Text
Text.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
cmd) Recognizer Command
commands of
    Exact Command{cmdImplementation :: ()
cmdImplementation=CommandImpl a
impl, cmdArgumentSpec :: ()
cmdArgumentSpec=Args ArgsContext a
argSpec} ->
      let
        cfCmd :: (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd ClientState -> a -> IO CommandResult
exec Bool -> ClientState -> String -> IO CommandResult
tab = ContextFreeCommand -> Either a ContextFreeCommand
forall a b. b -> Either a b
Right (ContextFreeCommand -> Either a ContextFreeCommand)
-> ContextFreeCommand -> Either a ContextFreeCommand
forall a b. (a -> b) -> a -> b
$ ContextFreeCommand
          { cfCmdCtx :: ArgsContext
cfCmdCtx=ArgsContext {argsContextSt :: ClientState
argsContextSt=ClientState
st, argsContextFocus :: Focus
argsContextFocus=Focus
focus}
          , cfCmdArgs :: Args ArgsContext a
cfCmdArgs=Args ArgsContext a
argSpec
          , cfCmdExec :: ClientState -> a -> IO CommandResult
cfCmdExec=ClientState -> a -> IO CommandResult
exec
          , cfCmdTab :: Bool -> ClientState -> String -> IO CommandResult
cfCmdTab=Bool -> ClientState -> String -> IO CommandResult
tab
          }
      in case CommandImpl a
impl of
        ClientCommand ClientState -> a -> IO CommandResult
exec Bool -> ClientState -> String -> IO CommandResult
tab ->
          (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd ClientState -> a -> IO CommandResult
exec Bool -> ClientState -> String -> IO CommandResult
tab

        WindowCommand WindowCommand a
exec Bool -> WindowCommand String
tab ->
          (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd (WindowCommand a
exec Focus
focus) (Bool -> WindowCommand String
`tab` Focus
focus)

        NetworkCommand NetworkCommand a
exec Bool -> NetworkCommand String
tab
          | Just Text
network <- Focus -> Maybe Text
focusNetwork Focus
focus
          , Just NetworkState
cs      <- Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
              (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd (NetworkCommand a
exec NetworkState
cs) (Bool -> NetworkCommand String
`tab` NetworkState
cs)
          | Bool
otherwise -> Text -> Either Text ContextFreeCommand
forall a b. a -> Either a b
Left Text
"command requires focused network"

        MaybeChatCommand MaybeChatCommand a
exec Bool -> MaybeChatCommand String
tab
          | Just NetworkState
cs <- Maybe NetworkState
maybeNetwork ->
              (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd (MaybeChatCommand a
exec Maybe Identifier
maybeChat NetworkState
cs) (\Bool
x -> Bool -> MaybeChatCommand String
tab Bool
x Maybe Identifier
maybeChat NetworkState
cs)
          | Bool
otherwise -> Text -> Either Text ContextFreeCommand
forall a b. a -> Either a b
Left Text
"command requires focused network"
          where
            maybeChat :: Maybe Identifier
maybeChat
              | ChannelFocus Text
_ Identifier
channel <- Focus
focus = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
channel
              | Bool
otherwise = Maybe Identifier
forall a. Maybe a
Nothing
            maybeNetwork :: Maybe NetworkState
maybeNetwork = do
              Text
network <- Focus -> Maybe Text
focusNetwork Focus
focus
              Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st

        ChannelCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
          | ChannelFocus Text
network Identifier
channelId <- Focus
focus
          , Just NetworkState
cs <- Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st
          , NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
channelId ->
              (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
          | Bool
otherwise -> Text -> Either Text ContextFreeCommand
forall a b. a -> Either a b
Left Text
"command requires focused channel"

        ChatCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
          | ChannelFocus Text
network Identifier
channelId <- Focus
focus
          , Just NetworkState
cs <- Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
              (ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either Text ContextFreeCommand
forall {a}.
(ClientState -> a -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> Either a ContextFreeCommand
cfCmd (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
          | Bool
otherwise -> Text -> Either Text ContextFreeCommand
forall a b. a -> Either a b
Left Text
"command requires focused chat window"

    Recognition Command
_ -> Text -> Either Text ContextFreeCommand
forall a b. a -> Either a b
Left Text
"unknown command"

-- | Parse and execute the given command. When the first argument is Nothing
-- the command is executed, otherwise the first argument is the cursor
-- position for tab-completion
executeCommand ::
  Maybe Bool       {- ^ tab-completion direction -} ->
  Maybe Focus      {- ^ focus override           -} ->
  String           {- ^ command                  -} ->
  ClientState      {- ^ client state             -} ->
  IO CommandResult {- ^ command result           -}

executeCommand :: Maybe Bool
-> Maybe Focus -> String -> ClientState -> IO CommandResult
executeCommand (Just Bool
isReversed) Maybe Focus
_ String
_ ClientState
st
  | Just ClientState
st' <- Bool -> ClientState -> Maybe ClientState
commandNameCompletion Bool
isReversed ClientState
st = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'

executeCommand Maybe Bool
tabComplete Maybe Focus
focusOverride String
str ClientState
st =
  let (String
cmd, String
args) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
str
      focus :: Focus
focus       = Focus -> Maybe Focus -> Focus
forall a. a -> Maybe a -> a
fromMaybe (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) Maybe Focus
focusOverride
  in case Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareCommand Focus
focus String
cmd ClientState
st of
    Right ContextFreeCommand
cfCmd -> ContextFreeCommand -> Maybe Bool -> String -> IO CommandResult
executeContextFreeCommand ContextFreeCommand
cfCmd Maybe Bool
tabComplete String
args
    Left Text
errmsg -> case Maybe Bool
tabComplete of
      Just Bool
isReversed -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st
      Maybe Bool
Nothing         -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
errmsg ClientState
st

-- | Expands each alias to have its own copy of the command callbacks
expandAliases :: [Command] -> [(Text,Command)]
expandAliases :: [Command] -> [(Text, Command)]
expandAliases [Command]
xs =
  [ (Text
name, Command
cmd) | Command
cmd <- [Command]
xs, Text
name <- NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Command -> NonEmpty Text
cmdNames Command
cmd) ]


-- | Map of built-in client commands to their implementations, tab completion
-- logic, and argument structures.
commands :: Recognizer Command
commands :: Recognizer Command
commands = [(Text, Command)] -> Recognizer Command
forall a. [(Text, a)] -> Recognizer a
fromCommands ([Command] -> [(Text, Command)]
expandAliases ((CommandSection -> [Command]) -> [CommandSection] -> [Command]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandSection -> [Command]
cmdSectionCmds [CommandSection]
commandsList))


-- | Raw list of commands in the order used for @/help@
commandsList :: [CommandSection]
commandsList :: [CommandSection]
commandsList =

  ------------------------------------------------------------------------
  [ Text -> [Command] -> CommandSection
CommandSection Text
"Client commands"
  ------------------------------------------------------------------------

  [ NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exit")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(clientDocs `cmdDoc` "exit")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl ()
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdExit Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , NonEmpty Text
-> Args ArgsContext (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reload")
      (Args ArgsContext String -> Args ArgsContext (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ArgsContext String
forall r. String -> Args r String
simpleToken String
"[filename]"))
      $(clientDocs `cmdDoc` "reload")
    (CommandImpl (Maybe String) -> Command)
-> CommandImpl (Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (Maybe String)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl (Maybe String)
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdReload Bool -> ClientState -> String -> IO CommandResult
tabReload

  , NonEmpty Text
-> Args ArgsContext (ClientState -> IO CommandResult)
-> Text
-> CommandImpl (ClientState -> IO CommandResult)
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"in")
      (String
-> (ArgsContext
    -> String
    -> Maybe (Args ArgsContext (ClientState -> IO CommandResult)))
-> Args ArgsContext (ClientState -> IO CommandResult)
forall r a. String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
"focus command" ArgsContext
-> String
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
inArgs)
      $(clientDocs `cmdDoc` "in")
    (CommandImpl (ClientState -> IO CommandResult) -> Command)
-> CommandImpl (ClientState -> IO CommandResult) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (ClientState -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl (ClientState -> IO CommandResult)
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (ClientState -> IO CommandResult)
cmdIn Bool -> ClientState -> String -> IO CommandResult
tabIn

  , NonEmpty Text
-> Args ArgsContext (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"extension")
      ((String -> String -> (String, String))
-> Args ArgsContext String
-> Args ArgsContext String
-> Args ArgsContext (String, String)
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Args ArgsContext String
forall r. String -> Args r String
simpleToken String
"extension") (String -> Args ArgsContext String
forall r. String -> Args r String
remainingArg String
"arguments"))
      $(clientDocs `cmdDoc` "extension")
    (CommandImpl (String, String) -> Command)
-> CommandImpl (String, String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (String, String)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl (String, String)
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (String, String)
cmdExtension Bool -> ClientState -> String -> IO CommandResult
simpleClientTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"palette")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(clientDocs `cmdDoc` "palette")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl ()
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdPalette Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"digraphs")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(clientDocs `cmdDoc` "digraphs")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl ()
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdDigraphs Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"keymap")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(clientDocs `cmdDoc` "keymap")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl ()
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdKeyMap Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"rtsstats")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(clientDocs `cmdDoc` "rtsstats")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl ()
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdRtsStats Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , NonEmpty Text
-> Args ArgsContext String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exec")
      (String -> Args ArgsContext String
forall r. String -> Args r String
remainingArg String
"arguments")
      $(clientDocs `cmdDoc` "exec")
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ (ClientState -> String -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl String
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientState -> String -> IO CommandResult
cmdExec Bool -> ClientState -> String -> IO CommandResult
simpleClientTab

  , NonEmpty Text
-> Args ArgsContext (Maybe Int)
-> Text
-> CommandImpl (Maybe Int)
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"url")
      Args ArgsContext (Maybe Int)
forall r. Args r (Maybe Int)
optionalNumberArg
      $(clientDocs `cmdDoc` "url")
    (CommandImpl (Maybe Int) -> Command)
-> CommandImpl (Maybe Int) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (Maybe Int)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl (Maybe Int)
forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe Int)
cmdUrl Bool -> ClientState -> String -> IO CommandResult
noClientTab

  , Command
newCertificateCommand

  , NonEmpty Text
-> Args ArgsContext (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"help")
      (Args ArgsContext String -> Args ArgsContext (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ArgsContext String
forall r. String -> Args r String
simpleToken String
"[topic]"))
      $(clientDocs `cmdDoc` "help")
    (CommandImpl (Maybe String) -> Command)
-> CommandImpl (Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ WindowCommand (Maybe String)
-> (Bool -> WindowCommand String) -> CommandImpl (Maybe String)
forall a.
WindowCommand a -> (Bool -> WindowCommand String) -> CommandImpl a
WindowCommand ([CommandSection]
-> Recognizer Command -> WindowCommand (Maybe String)
cmdHelp [CommandSection]
commandsList Recognizer Command
commands) Bool -> WindowCommand String
tabHelp

  ------------------------------------------------------------------------
  ],

  CommandSection
togglesCommands, CommandSection
connectionCommands, CommandSection
windowCommands, CommandSection
chatCommands,
  CommandSection
queryCommands, CommandSection
channelCommands, CommandSection
zncCommands, CommandSection
operatorCommands
  ]

-- | Implementation of @/exit@ command.
cmdExit :: ClientCommand ()
cmdExit :: ClientCommand ()
cmdExit ClientState
st ()
_ = CommandResult -> IO CommandResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st)

-- | Implementation of @/palette@ command. Set subfocus to Palette.
cmdPalette :: ClientCommand ()
cmdPalette :: ClientCommand ()
cmdPalette ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusPalette ClientState
st)

-- | Implementation of @/digraphs@ command. Set subfocus to Digraphs.
cmdDigraphs :: ClientCommand ()
cmdDigraphs :: ClientCommand ()
cmdDigraphs ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusDigraphs ClientState
st)

-- | Implementation of @/keymap@ command. Set subfocus to Keymap.
cmdKeyMap :: ClientCommand ()
cmdKeyMap :: ClientCommand ()
cmdKeyMap ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusKeyMap ClientState
st)

-- | Implementation of @/rtsstats@ command. Set subfocus to RtsStats.
-- Update cached rts stats in client state.
cmdRtsStats :: ClientCommand ()
cmdRtsStats :: ClientCommand ()
cmdRtsStats ClientState
st ()
_ =
  do Maybe Stats
mb <- IO (Maybe Stats)
getStats
     case Maybe Stats
mb of
       Maybe Stats
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"RTS statistics not available. (Use +RTS -T)" ClientState
st
       Just{}  -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState (Maybe Stats) (Maybe Stats)
-> Maybe Stats -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Stats) (Maybe Stats)
Lens' ClientState (Maybe Stats)
clientRtsStats Maybe Stats
mb
                                 (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusRtsStats ClientState
st

tabHelp :: Bool -> WindowCommand String
tabHelp :: Bool -> WindowCommand String
tabHelp Bool
isReversed Focus
_ ClientState
st String
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [Text]
cached [Text]
commandNames Bool
isReversed ClientState
st
  where
    cached :: [Text]
cached = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ HelpQuery -> Maybe Text
helpQueryToText (HelpQuery -> Maybe Text) -> HelpQuery -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Getting HelpQuery ClientState HelpQuery -> ClientState -> HelpQuery
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HelpState -> Const HelpQuery HelpState)
-> ClientState -> Const HelpQuery ClientState
Lens' ClientState HelpState
clientHelp ((HelpState -> Const HelpQuery HelpState)
 -> ClientState -> Const HelpQuery ClientState)
-> ((HelpQuery -> Const HelpQuery HelpQuery)
    -> HelpState -> Const HelpQuery HelpState)
-> Getting HelpQuery ClientState HelpQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HelpQuery -> Const HelpQuery HelpQuery)
-> HelpState -> Const HelpQuery HelpState
Lens' HelpState HelpQuery
hsQuery) ClientState
st
    commandNames :: [Text]
commandNames = (Text, Command) -> Text
forall a b. (a, b) -> a
fst ((Text, Command) -> Text) -> [(Text, Command)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command] -> [(Text, Command)]
expandAliases ((CommandSection -> [Command]) -> [CommandSection] -> [Command]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandSection -> [Command]
cmdSectionCmds [CommandSection]
commandsList)

-- | Implementation of @/reload@
--
-- Attempt to reload the configuration file
cmdReload :: ClientCommand (Maybe String)
cmdReload :: ClientCommand (Maybe String)
cmdReload ClientState
st Maybe String
mbPath =
  do let path :: Maybe String
path = Maybe String
mbPath Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
forall a. a -> Maybe a
Just (Getting String ClientState String -> ClientState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String ClientState String
Lens' ClientState String
clientConfigPath ClientState
st)
     Either ConfigurationFailure (String, Configuration)
res <- Maybe String
-> IO (Either ConfigurationFailure (String, Configuration))
loadConfiguration Maybe String
path
     case Either ConfigurationFailure (String, Configuration)
res of
       Left ConfigurationFailure
e -> Text -> ClientState -> IO CommandResult
commandFailureMsg (ConfigurationFailure -> Text
describeProblem ConfigurationFailure
e) ClientState
st
       Right (String
path',Configuration
cfg) ->
         do ClientState
st1 <- ClientState -> IO ClientState
clientStartExtensions
                 (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState Configuration Configuration
-> Configuration -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Configuration Configuration
Lens' ClientState Configuration
clientConfig Configuration
cfg
                 (ClientState -> ClientState) -> ClientState -> ClientState
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState String String
-> String -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState String String
Lens' ClientState String
clientConfigPath String
path' ClientState
st
            ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st1

  where
    describeProblem :: ConfigurationFailure -> Text
describeProblem ConfigurationFailure
err =
      String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
      case ConfigurationFailure
err of
       ConfigurationReadFailed    String
e -> String
"Failed to open configuration: "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
       ConfigurationParseFailed String
_ String
e -> String
"Failed to parse configuration: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
       ConfigurationMalformed   String
_ String
e -> String
"Configuration malformed: "       String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e

-- | Support file name tab completion when providing an alternative
-- configuration file.
--
-- /NOT IMPLEMENTED/
tabReload :: Bool {- ^ reversed -} -> ClientCommand String
tabReload :: Bool -> ClientState -> String -> IO CommandResult
tabReload Bool
_ ClientState
st String
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st

commandNameCompletion :: Bool -> ClientState -> Maybe ClientState
commandNameCompletion :: Bool -> ClientState -> Maybe ClientState
commandNameCompletion Bool
isReversed ClientState
st =
  do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
cursorPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n)
     (EditBox -> Maybe EditBox) -> ClientState -> Maybe ClientState
Lens' ClientState EditBox
clientTextBox ((Char -> Bool)
-> WordCompletionMode
-> Bool
-> [CaseText]
-> [CaseText]
-> EditBox
-> Maybe EditBox
forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
wordComplete (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) WordCompletionMode
plainWordCompleteMode Bool
isReversed [] [CaseText]
possibilities) ClientState
st
  where
    n :: Int
n = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
white Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
leadingPart
    (Int
cursorPos, String
line) = ClientState -> (Int, String)
clientLine ClientState
st
    (String
white, String
leadingPart) = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) (String -> String) -> (String, String) -> (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
line

    possibilities :: [CaseText]
possibilities = Text -> CaseText
caseText (Text -> CaseText) -> (Text -> Text) -> Text -> CaseText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
Text.cons Char
'/' (Text -> CaseText) -> [Text] -> [CaseText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
commandNames
    commandNames :: [Text]
commandNames = Recognizer Command -> [Text]
forall a. Recognizer a -> [Text]
keys Recognizer Command
commands
                [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Recognizer Macro -> [Text]
forall a. Recognizer a -> [Text]
keys (Getting (Recognizer Macro) ClientState (Recognizer Macro)
-> ClientState -> Recognizer Macro
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const (Recognizer Macro) Configuration)
-> ClientState -> Const (Recognizer Macro) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognizer Macro) Configuration)
 -> ClientState -> Const (Recognizer Macro) ClientState)
-> ((Recognizer Macro
     -> Const (Recognizer Macro) (Recognizer Macro))
    -> Configuration -> Const (Recognizer Macro) Configuration)
-> Getting (Recognizer Macro) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro -> Const (Recognizer Macro) (Recognizer Macro))
-> Configuration -> Const (Recognizer Macro) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) ClientState
st)

cmdExtension :: ClientCommand (String, String)
cmdExtension :: ClientCommand (String, String)
cmdExtension ClientState
st (String
name,String
command) =
  do Maybe ClientState
res <- Text -> Text -> ClientState -> IO (Maybe ClientState)
clientCommandExtension (String -> Text
Text.pack String
name) (String -> Text
Text.pack String
command) ClientState
st
     case Maybe ClientState
res of
       Maybe ClientState
Nothing  -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown extension" ClientState
st
       Just ClientState
st' -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'

-- | Implementation of @/exec@ command.
cmdExec :: ClientCommand String
cmdExec :: ClientState -> String -> IO CommandResult
cmdExec ClientState
st String
rest =
  do ZonedTime
now <- IO ZonedTime
getZonedTime
     case String -> Either [String] ExecCmd
parseExecCmd String
rest of
       Left [String]
es -> ZonedTime -> [String] -> IO CommandResult
forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
       Right ExecCmd
ec ->
         case ZonedTime
-> ExecCmd -> Either [String] ([Text] -> IO CommandResult)
forall {a}.
IsString a =>
ZonedTime -> ExecCmd -> Either [a] ([Text] -> IO CommandResult)
buildTransmitter ZonedTime
now ExecCmd
ec of
           Left [String]
es -> ZonedTime -> [String] -> IO CommandResult
forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
           Right [Text] -> IO CommandResult
tx ->
             do Either [String] [String]
res <- ExecCmd -> IO (Either [String] [String])
runExecCmd ExecCmd
ec
                case Either [String] [String]
res of
                  Left [String]
es -> ZonedTime -> [String] -> IO CommandResult
forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
                  Right [String]
msgs -> [Text] -> IO CommandResult
tx ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
msgs)

  where
    buildTransmitter :: ZonedTime -> ExecCmd -> Either [a] ([Text] -> IO CommandResult)
buildTransmitter ZonedTime
now ExecCmd
ec =
      case (String -> Text
Text.pack (String -> Text) -> Target String -> Target Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Target String) ExecCmd (Target String)
-> ExecCmd -> Target String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Target String) ExecCmd (Target String)
Lens' ExecCmd (Target String)
execOutputNetwork ExecCmd
ec,
            String -> Text
Text.pack (String -> Text) -> Target String -> Target Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Target String) ExecCmd (Target String)
-> ExecCmd -> Target String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Target String) ExecCmd (Target String)
Lens' ExecCmd (Target String)
execOutputChannel ExecCmd
ec) of

        (Target Text
Unspecified, Target Text
Unspecified) -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (ZonedTime -> [Text] -> IO CommandResult
forall {m :: * -> *} {t :: * -> *}.
(Monad m, Foldable t) =>
ZonedTime -> t Text -> m CommandResult
sendToClient ZonedTime
now)

        (Specified Text
network, Specified Text
channel) ->
          case Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
            Maybe NetworkState
Nothing -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"Unknown network"]
            Just NetworkState
cs -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel)

        (Target Text
_ , Specified Text
channel) ->
          case Maybe NetworkState
currentNetworkState of
            Maybe NetworkState
Nothing -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"No current network"]
            Just NetworkState
cs -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel)

        (Specified Text
network, Target Text
_) ->
          case Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
            Maybe NetworkState
Nothing -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"Unknown network"]
            Just NetworkState
cs -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (ZonedTime -> NetworkState -> [Text] -> IO CommandResult
forall {t :: * -> *}.
Foldable t =>
ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs)

        (Target Text
_, Target Text
Current) ->
          case Maybe NetworkState
currentNetworkState of
            Maybe NetworkState
Nothing -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"No current network"]
            Just NetworkState
cs ->
              case Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st of
                ChannelFocus Text
_ Identifier
channel -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs (Identifier -> Text
idText Identifier
channel))
                Focus
_                      -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"No current channel"]

        (Target Text
Current, Target Text
_) ->
          case Maybe NetworkState
currentNetworkState of
            Maybe NetworkState
Nothing -> [a] -> Either [a] ([Text] -> IO CommandResult)
forall a b. a -> Either a b
Left [a
"No current network"]
            Just NetworkState
cs -> ([Text] -> IO CommandResult)
-> Either [a] ([Text] -> IO CommandResult)
forall a b. b -> Either a b
Right (ZonedTime -> NetworkState -> [Text] -> IO CommandResult
forall {t :: * -> *}.
Foldable t =>
ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs)

    sendToClient :: ZonedTime -> t Text -> m CommandResult
sendToClient ZonedTime
now t Text
msgs = ClientState -> m CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> m CommandResult) -> ClientState -> m CommandResult
forall a b. (a -> b) -> a -> b
$! (ClientState -> Text -> ClientState)
-> ClientState -> t Text -> ClientState
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ZonedTime -> ClientState -> Text -> ClientState
recordSuccess ZonedTime
now) ClientState
st t Text
msgs

    sendToNetwork :: ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs t Text
msgs =
      ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> IO CommandResult)
-> IO ClientState -> IO CommandResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      (ClientState -> Text -> IO ClientState)
-> ClientState -> t Text -> IO ClientState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ClientState
st1 Text
msg ->
           case Text -> Maybe RawIrcMsg
parseRawIrcMsg Text
msg of
             Maybe RawIrcMsg
Nothing ->
               ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"" (Text
"Bad raw message: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg) ClientState
st1
             Just RawIrcMsg
raw ->
               do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
raw
                  ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st1) ClientState
st t Text
msgs

    sendToChannel :: NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel [Text]
msgs =
      ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> IO CommandResult)
-> IO ClientState -> IO CommandResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      (ClientState -> Text -> IO ClientState)
-> ClientState -> [Text] -> IO ClientState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ClientState
st1 Text
msg ->
        do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Text -> RawIrcMsg
ircPrivmsg Text
channel Text
msg)
           (Source -> Identifier -> IrcMsg)
-> [Text] -> NetworkState -> ClientState -> IO ClientState
chatCommand'
              (\Source
src Identifier
tgt -> Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
tgt Text
msg)
              [Text
channel]
              NetworkState
cs ClientState
st1) ClientState
st ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
msgs)

    currentNetworkState :: Maybe NetworkState
currentNetworkState =
      do Text
network <- LensLike' (Const (Maybe Text)) ClientState Focus
-> (Focus -> Maybe Text) -> ClientState -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const (Maybe Text)) ClientState Focus
Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
         Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st

    failure :: ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es =
      ClientState -> m CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure (ClientState -> m CommandResult) -> ClientState -> m CommandResult
forall a b. (a -> b) -> a -> b
$! (ClientState -> Text -> ClientState)
-> ClientState -> [Text] -> ClientState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> ClientState -> ClientState)
-> ClientState -> Text -> ClientState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"")) ClientState
st ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
es)


cmdUrl :: ClientCommand (Maybe Int)
cmdUrl :: ClientCommand (Maybe Int)
cmdUrl ClientState
st Maybe Int
arg =
  case Getting (Maybe UrlOpener) ClientState (Maybe UrlOpener)
-> ClientState -> Maybe UrlOpener
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Configuration -> Const (Maybe UrlOpener) Configuration)
-> ClientState -> Const (Maybe UrlOpener) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Maybe UrlOpener) Configuration)
 -> ClientState -> Const (Maybe UrlOpener) ClientState)
-> ((Maybe UrlOpener -> Const (Maybe UrlOpener) (Maybe UrlOpener))
    -> Configuration -> Const (Maybe UrlOpener) Configuration)
-> Getting (Maybe UrlOpener) ClientState (Maybe UrlOpener)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe UrlOpener -> Const (Maybe UrlOpener) (Maybe UrlOpener))
-> Configuration -> Const (Maybe UrlOpener) Configuration
Lens' Configuration (Maybe UrlOpener)
configUrlOpener) ClientState
st of
    Maybe UrlOpener
Nothing     -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"url-opener not configured" ClientState
st
    Just UrlOpener
opener -> UrlOpener -> Int -> IO CommandResult
doUrlOpen UrlOpener
opener (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) Maybe Int
arg)
  where
    doUrlOpen :: UrlOpener -> Index [Text] -> IO CommandResult
doUrlOpen UrlOpener
opener Index [Text]
n =
      case Getting (First Text) [Text] Text -> [Text] -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index [Text] -> Traversal' [Text] (IxValue [Text])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [Text]
n) (((Text, [Identifier]) -> Text) -> [(Text, [Identifier])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Identifier]) -> Text
forall a b. (a, b) -> a
fst (ClientState -> [(Text, [Identifier])]
urlList ClientState
st)) of
        Just Text
url -> UrlOpener -> String -> ClientState -> IO CommandResult
openUrl UrlOpener
opener (Text -> String
Text.unpack Text
url) ClientState
st
        Maybe Text
Nothing  -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad url number" ClientState
st

openUrl :: UrlOpener -> String -> ClientState -> IO CommandResult
openUrl :: UrlOpener -> String -> ClientState -> IO CommandResult
openUrl (UrlOpener String
opener [UrlArgument]
args) String
url ClientState
st =
  do let argStr :: UrlArgument -> String
argStr (UrlArgLiteral String
str) = String
str
         argStr UrlArgument
UrlArgUrl           = String
url
     Either IOError ()
res <- IO () -> IO (Either IOError ())
forall e a. Exception e => IO a -> IO (Either e a)
try (ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (String -> [String] -> ProcessConfig () () ()
proc String
opener ((UrlArgument -> String) -> [UrlArgument] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UrlArgument -> String
argStr [UrlArgument]
args)))
     case Either IOError ()
res of
       Left IOError
e  -> Text -> ClientState -> IO CommandResult
commandFailureMsg (String -> Text
Text.pack (IOError -> String
forall e. Exception e => e -> String
displayException (IOError
e :: IOError))) ClientState
st
       Right{} -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

inArgs :: ArgsContext -> String -> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
inArgs :: ArgsContext
-> String
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
inArgs ArgsContext{argsContextFocus :: ArgsContext -> Focus
argsContextFocus=Focus
focus} String
focusOverride =
  (Focus -> Args ArgsContext (ClientState -> IO CommandResult))
-> Maybe Focus
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Focus
f -> (ArgsContext -> ArgsContext)
-> Args ArgsContext (ClientState -> IO CommandResult)
-> Args ArgsContext (ClientState -> IO CommandResult)
forall r s a. (r -> s) -> Args s a -> Args r a
mapArgEnv (Focus -> ArgsContext -> ArgsContext
changeArgsFocus Focus
f) (Args ArgsContext (ClientState -> IO CommandResult)
 -> Args ArgsContext (ClientState -> IO CommandResult))
-> Args ArgsContext (ClientState -> IO CommandResult)
-> Args ArgsContext (ClientState -> IO CommandResult)
forall a b. (a -> b) -> a -> b
$ String
-> (ArgsContext
    -> String
    -> Maybe (Args ArgsContext (ClientState -> IO CommandResult)))
-> Args ArgsContext (ClientState -> IO CommandResult)
forall r a. String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
"command" ArgsContext
-> String
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
inArgsCmd) Maybe Focus
parsedFocus
  where
    parsedFocus :: Maybe Focus
parsedFocus = Maybe Text -> String -> Maybe Focus
parseFocus (Focus -> Maybe Text
focusNetwork Focus
focus) String
focusOverride
    changeArgsFocus :: Focus -> ArgsContext -> ArgsContext
changeArgsFocus Focus
focus' ArgsContext
argsContext = ArgsContext
argsContext {argsContextFocus=focus'}
    rightToMaybe :: Either a a -> Maybe a
rightToMaybe (Right a
v) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
    rightToMaybe Either a a
_ = Maybe a
forall a. Maybe a
Nothing
    inArgsCmd :: ArgsContext -> String -> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
    inArgsCmd :: ArgsContext
-> String
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
inArgsCmd ArgsContext{argsContextFocus :: ArgsContext -> Focus
argsContextFocus=Focus
focus', argsContextSt :: ArgsContext -> ClientState
argsContextSt=ClientState
st'} String
cmdName =
      ContextFreeCommand
-> Args ArgsContext (ClientState -> IO CommandResult)
cfCmdAsArgs (ContextFreeCommand
 -> Args ArgsContext (ClientState -> IO CommandResult))
-> Maybe ContextFreeCommand
-> Maybe (Args ArgsContext (ClientState -> IO CommandResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Text ContextFreeCommand -> Maybe ContextFreeCommand
forall {a} {a}. Either a a -> Maybe a
rightToMaybe (Either Text ContextFreeCommand -> Maybe ContextFreeCommand)
-> Either Text ContextFreeCommand -> Maybe ContextFreeCommand
forall a b. (a -> b) -> a -> b
$ Focus -> String -> ClientState -> Either Text ContextFreeCommand
prepareMacro Focus
focus' String
cmdName ClientState
st')

-- | Implementation of @/in@.
cmdIn :: ClientCommand (ClientState -> IO CommandResult)
cmdIn :: ClientCommand (ClientState -> IO CommandResult)
cmdIn ClientState
st ClientState -> IO CommandResult
fn = ClientState -> IO CommandResult
fn ClientState
st -- All the magic is in the Args parser.

tabIn :: Bool -> ClientCommand String
tabIn :: Bool -> ClientState -> String -> IO CommandResult
tabIn Bool
isReversed ClientState
st String
_ = -- TOOD: Command completion. This right here is just tabChannel.
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] (ClientState -> [Text]
focusNames ClientState
st) Bool
isReversed ClientState
st