{-# 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)
import Client.Commands.Docs (clientDocs, cmdDoc)
import Client.Commands.Exec
import Client.Commands.Interpolation (resolveMacroExpansions, Macro(Macro), MacroSpec(MacroSpec))
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.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.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.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)
import Client.Commands.ZNC (zncCommands)

-- | 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' = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Text)
clientErrorMsg forall a. Maybe a
Nothing ClientState
st in
  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
str of
    []          -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
    Char
'/':String
command -> Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand forall a. Maybe a
Nothing String
command ClientState
st'
    String
_           -> String -> ClientState -> IO CommandResult
executeChat 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 Text
discoTime String
command ClientState
st = do
  let key :: Text
key = (Char -> Bool) -> Text -> Text
Text.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') (String -> Text
Text.pack String
command)
      rest :: String
rest = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') String
command)

  case forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Recognizer Macro)
configMacros) (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 forall {t :: * -> *}.
Traversable t =>
Args ClientState [String]
-> t [ExpansionChunk] -> String -> Maybe (t Text)
doExpansion forall r. Args r [String]
spec [[ExpansionChunk]]
cmdExs String
rest 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
    Recognition Macro
_ -> Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand forall a. Maybe a
Nothing String
command ClientState
st
  where
    doExpansion :: Args ClientState [String]
-> t [ExpansionChunk] -> String -> Maybe (t Text)
doExpansion Args ClientState [String]
spec t [ExpansionChunk]
cmdExs String
rest =
      do [String]
args <- forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState [String]
spec String
rest
         forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
args)) t [ExpansionChunk]
cmdExs

    resolveMacro :: [Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro [Text]
args = forall (f :: * -> *).
Alternative f =>
(Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions (Maybe Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Text
discoTime ClientState
st) (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 = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a. Num a => Integer -> a
fromInteger Integer
i)) [a]
args



    process :: [Text] -> ClientState -> IO CommandResult
process [] ClientState
st0 = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st0
    process (Text
c:[Text]
cs) ClientState
st0 =
      do CommandResult
res <- Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand forall a. Maybe a
Nothing (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    -> forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st1)

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


-- | 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 forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' ' forall a. Eq a => a -> a -> Bool
==) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ ClientState -> (Int, String)
clientLine ClientState
st of
    Char
'/':String
command -> Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand (forall a. a -> Maybe a
Just Bool
isReversed) String
command ClientState
st
    String
_           -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st


-- | 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 -} ->
  String           {- ^ command                  -} ->
  ClientState      {- ^ client state             -} ->
  IO CommandResult {- ^ command result           -}

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

executeCommand Maybe Bool
tabCompleteReversed String
str ClientState
st =
  let (String
cmd, String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
' ') String
str
      cmdTxt :: Text
cmdTxt      = Text -> Text
Text.toLower (String -> Text
Text.pack String
cmd)

      finish :: Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState t
spec ClientState -> t -> IO CommandResult
exec Bool -> ClientState -> String -> IO CommandResult
tab =
        case Maybe Bool
tabCompleteReversed of
          Just Bool
isReversed -> Bool -> ClientState -> String -> IO CommandResult
tab Bool
isReversed ClientState
st String
rest
          Maybe Bool
Nothing ->
            case forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState t
spec String
rest of
              Maybe t
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad command arguments" ClientState
st
              Just t
arg -> ClientState -> t -> IO CommandResult
exec ClientState
st t
arg
  in
  case forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdTxt Recognizer Command
commands of

    Exact Command{cmdImplementation :: ()
cmdImplementation=CommandImpl a
impl, cmdArgumentSpec :: ()
cmdArgumentSpec=Args ClientState a
argSpec} ->
      case CommandImpl a
impl of
        ClientCommand ClientCommand a
exec Bool -> ClientState -> String -> IO CommandResult
tab ->
          forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec ClientCommand a
exec Bool -> ClientState -> String -> IO CommandResult
tab

        NetworkCommand NetworkCommand a
exec Bool -> NetworkCommand String
tab
          | Just Text
network <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
          , Just NetworkState
cs      <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
              forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (NetworkCommand a
exec NetworkState
cs) (\Bool
x -> Bool -> NetworkCommand String
tab Bool
x NetworkState
cs)
          | Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused network" ClientState
st

        ChannelCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
          | ChannelFocus Text
network Identifier
channelId <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
          , Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st
          , NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
channelId ->
              forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
          | Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused channel" ClientState
st

        ChatCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
          | ChannelFocus Text
network Identifier
channelId <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
          , Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
              forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
          | Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused chat window" ClientState
st

    Recognition Command
_ -> case Maybe Bool
tabCompleteReversed of
           Just Bool
isReversed -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st
           Maybe Bool
Nothing         -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown command" 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 <- 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 = forall a. [(Text, a)] -> Recognizer a
fromCommands ([Command] -> [(Text, Command)]
expandAliases (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"
  ------------------------------------------------------------------------

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

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

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

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

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

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

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

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

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

  , Command
newCertificateCommand

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"help")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[command]"))
      $(clientDocs `cmdDoc` "help")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdHelp Bool -> ClientState -> String -> IO CommandResult
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 ()
_ = 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 ()
_ = 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 ()
_ = 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 ()
_ = 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{}  -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Stats)
clientRtsStats Maybe Stats
mb
                                 forall a b. (a -> b) -> a -> b
$ Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusRtsStats ClientState
st

-- | Implementation of @/help@ command. Set subfocus to Help.
cmdHelp :: ClientCommand (Maybe String)
cmdHelp :: ClientCommand (Maybe String)
cmdHelp ClientState
st Maybe String
mb = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
focus ClientState
st)
  where
    focus :: Subfocus
focus = Maybe Text -> Subfocus
FocusHelp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack Maybe String
mb)

tabHelp :: Bool -> ClientCommand String
tabHelp :: Bool -> ClientState -> String -> IO CommandResult
tabHelp Bool
isReversed ClientState
st String
_ =
  forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
commandNames Bool
isReversed ClientState
st
  where
    commandNames :: [Text]
commandNames = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command] -> [(Text, Command)]
expandAliases (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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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
                 forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Configuration
clientConfig Configuration
cfg
                 forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState String
clientConfigPath String
path' ClientState
st
            forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st1

  where
    describeProblem :: ConfigurationFailure -> Text
describeProblem ConfigurationFailure
err =
      String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$
      case ConfigurationFailure
err of
       ConfigurationReadFailed    String
e -> String
"Failed to open configuration: "  forall a. [a] -> [a] -> [a]
++ String
e
       ConfigurationParseFailed String
_ String
e -> String
"Failed to parse configuration: " forall a. [a] -> [a] -> [a]
++ String
e
       ConfigurationMalformed   String
_ String
e -> String
"Configuration malformed: "       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
_ = 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 forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
cursorPos forall a. Eq a => a -> a -> Bool
== Int
n)
     Lens' ClientState EditBox
clientTextBox (forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
wordComplete (Char
' ' forall a. Eq a => a -> a -> Bool
/=) WordCompletionMode
plainWordCompleteMode Bool
isReversed [] [CaseText]
possibilities) ClientState
st
  where
    n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
white forall a. Num a => a -> a -> a
+ 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) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
' ' forall a. Eq a => a -> a -> Bool
/=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
line

    possibilities :: [CaseText]
possibilities = Text -> CaseText
caseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
Text.cons Char
'/' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
commandNames
    commandNames :: [Text]
commandNames = forall a. Recognizer a -> [Text]
keys Recognizer Command
commands
                forall a. [a] -> [a] -> [a]
++ forall a. Recognizer a -> [Text]
keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' -> 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 -> forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
       Right ExecCmd
ec ->
         case forall {a}.
IsString a =>
ZonedTime -> ExecCmd -> Either [a] ([Text] -> IO CommandResult)
buildTransmitter ZonedTime
now ExecCmd
ec of
           Left [String]
es -> 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 -> forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
                  Right [String]
msgs -> [Text] -> IO CommandResult
tx (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd (Target String)
execOutputNetwork ExecCmd
ec,
            String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd (Target String)
execOutputChannel ExecCmd
ec) of

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

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

        (Specified Text
network, Target Text
_) ->
          case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
            Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"Unknown network"]
            Just NetworkState
cs -> forall a b. b -> Either a b
Right (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 -> forall a b. a -> Either a b
Left [a
"No current network"]
            Just NetworkState
cs ->
              case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
                ChannelFocus Text
_ Identifier
channel -> forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs (Identifier -> Text
idText Identifier
channel))
                Focus
_                      -> 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 -> forall a b. a -> Either a b
Left [a
"No current network"]
            Just NetworkState
cs -> forall a b. b -> Either a b
Right (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 = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall a b. (a -> b) -> 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 =
      forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      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 ->
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"" (Text
"Bad raw message: " forall a. Semigroup a => a -> a -> a
<> Text
msg) ClientState
st1
             Just RawIrcMsg
raw ->
               do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
raw
                  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 =
      forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      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 (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
msgs)

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

    failure :: ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es =
      forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"")) ClientState
st (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 forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (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 forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [Text]
n) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (ClientState -> [UrlPair]
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 <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (String -> [String] -> ProcessConfig () () ()
proc String
opener (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 (forall e. Exception e => e -> String
displayException (IOError
e :: IOError))) ClientState
st
       Right{} -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st