{-# LANGUAGE BangPatterns, OverloadedStrings, 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.Spec
import           Client.Commands.Arguments.Parser
import           Client.Commands.Exec
import           Client.Commands.Interpolation
import           Client.Commands.Recognizer
import           Client.Commands.WordCompletion
import           Client.Configuration
import           Client.State
import           Client.State.Extensions
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window
import           Control.Applicative
import           Control.Exception (displayException, try)
import           Control.Lens
import           Control.Monad
import           Data.Foldable
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time (getZonedTime)
import           Irc.Commands
import           Irc.Identifier
import           Irc.RawIrcMsg
import           Irc.Message
import           RtsStats (getStats)
import           System.Process

import           Client.Commands.Channel (channelCommands)
import           Client.Commands.Certificate (newCertificateCommand)
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.Toggles (togglesCommands)
import           Client.Commands.Window (windowCommands)
import           Client.Commands.ZNC (zncCommands)
import           Client.Commands.TabCompletion
import           Client.Commands.Types

-- | 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
_           -> 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 (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 Args ClientState [String]
-> [[ExpansionChunk]] -> String -> Maybe [Text]
forall (t :: * -> *).
Traversable t =>
Args ClientState [String]
-> t [ExpansionChunk] -> String -> Maybe (t Text)
doExpansion Args ClientState [String]
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 Maybe Bool
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 <- ClientState
-> Args ClientState [String] -> String -> Maybe [String]
forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState [String]
spec String
rest
         ([ExpansionChunk] -> Maybe Text)
-> t [ExpansionChunk] -> Maybe (t Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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)) t [ExpansionChunk]
cmdExs

    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 Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Text
discoTime ClientState
st) ([Text] -> Integer -> Maybe Text
forall a. [a] -> Integer -> Maybe a
expandInt [Text]
args)

    expandInt :: [a] -> Integer -> Maybe a
    expandInt :: [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 -> Int
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 -> String -> ClientState -> IO CommandResult
executeCommand Maybe Bool
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    -> CommandResult -> IO CommandResult
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" -> 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
    Text
"channel" -> Getting (First Text) ClientState Identifier
-> (Identifier -> Text) -> ClientState -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
Getting (First r) s a -> (a -> r) -> m (Maybe r)
previews ((Focus -> Const (First Text) Focus)
-> ClientState -> Const (First Text) ClientState
Lens' ClientState Focus
clientFocus ((Focus -> Const (First Text) Focus)
 -> ClientState -> Const (First Text) ClientState)
-> ((Identifier -> Const (First Text) Identifier)
    -> Focus -> Const (First Text) Focus)
-> Getting (First Text) ClientState Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
-> (Identifier -> Const (First Text) Identifier)
-> Focus
-> Const (First Text) Focus
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
_2) Identifier -> Text
idText ClientState
st
    Text
"nick"    -> do Text
net <- 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
                    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 (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


-- | 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 -> String -> ClientState -> IO CommandResult
executeCommand (Bool -> Maybe Bool
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 = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'

executeCommand Maybe Bool
tabCompleteReversed String
str ClientState
st =
  let (String
cmd, String
rest) = (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
      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 ClientState -> Args ClientState t -> String -> Maybe t
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 Text -> Recognizer Command -> Recognition Command
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 ->
          Args ClientState a
-> ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
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 <- 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
          , 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 ->
              Args ClientState a
-> ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
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 <- 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
          , 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 ->
              Args ClientState a
-> ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
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 <- 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
          , 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 ->
              Args ClientState a
-> ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
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 <- NonEmpty Text -> [Text]
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 ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exit")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"Exit the client immediately.\n"
    (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 ClientState (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reload")
      (Args ClientState String -> Args ClientState (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"[filename]"))
      Text
"Reload the client configuration file.\n\
      \\n\
      \If \^Bfilename\^B is provided it will be used to reload.\n\
      \Otherwise the previously loaded configuration file will be reloaded.\n"
    (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 ClientState (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"extension")
      ((String -> String -> (String, String))
-> Args ClientState String
-> Args ClientState String
-> Args ClientState (String, String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"extension") (String -> Args ClientState String
forall r. String -> Args r String
remainingArg String
"arguments"))
      Text
"Calls the process_command callback of the given extension.\n\
      \\n\
      \\^Bextension\^B should be the name of the loaded extension.\n"
    (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 ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"palette")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"Show the current palette settings and a color chart to help pick new colors.\n"
    (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 ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"digraphs")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"\^BDescription:\^B\n\
      \\n\
      \    Show the table of digraphs. A digraph is a pair of characters\n\
      \    can be used together to represent an uncommon character. Type\n\
      \    the two-character digraph corresponding to the desired output\n\
      \    character and then press M-k (default binding).\n\
      \\n\
      \    Note that the digraphs list is searchable with /grep.\n\
      \\n\
      \\^BSee also:\^B grep\n"
    (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 ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"keymap")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"Show the key binding map.\n\
      \\n\
      \Key bindings can be changed in configuration file. See `glirc --config-format`.\n"
    (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 ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"rtsstats")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"Show the GHC RTS statistics.\n"
    (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 ClientState String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exec")
      (String -> Args ClientState String
forall r. String -> Args r String
remainingArg String
"arguments")
      Text
"Execute a command synchnonously sending the to a configuration destination.\n\
      \\n\
      \\^Barguments\^B: [-n[network]] [-c[channel]] [-i input] command [arguments...]\n\
      \\n\
      \When \^Binput\^B is specified it is sent to the stdin.\n\
      \\n\
      \When neither \^Bnetwork\^B nor \^Bchannel\^B are specified output goes to client window (*).\n\
      \When \^Bnetwork\^B is specified output is sent as raw IRC traffic to the network.\n\
      \When \^Bchannel\^B is specified output is sent as chat to the given channel on the current network.\n\
      \When \^Bnetwork\^B and \^Bchannel\^B are specified output is sent as chat to the given channel on the given network.\n\
      \\n\
      \\^Barguments\^B is divided on spaces into words before being processed\
      \ by getopt. Use Haskell string literal syntax to create arguments with\
      \ escaped characters and spaces inside.\n\
      \\n"
    (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 ClientState (Maybe Int)
-> Text
-> CommandImpl (Maybe Int)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"url")
      Args ClientState (Maybe Int)
forall r. Args r (Maybe Int)
optionalNumberArg
      Text
"Open a URL seen in chat.\n\
      \\n\
      \The URL is opened using the executable configured under \^Burl-opener\^B.\n\
      \\n\
      \When this command is active in the textbox, chat messages are filtered to\
      \ only show ones with URLs.\n\
      \\n\
      \When \^Bnumber\^B is omitted it defaults to \^B1\^B. The number selects the\
      \ URL to open counting back from the most recent.\n"
    (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 ClientState (Maybe String)
-> Text
-> CommandImpl (Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"help")
      (Args ClientState String -> Args ClientState (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"[command]"))
      Text
"Show command documentation.\n\
      \\n\
      \When \^Bcommand\^B is omitted a list of all commands is displayed.\n\
      \When \^Bcommand\^B is specified detailed help for that command is shown.\n"
    (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)
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 ()
_ = CommandResult -> IO CommandResult
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

-- | Implementation of @/help@ command. Set subfocus to Help.
cmdHelp :: ClientCommand (Maybe String)
cmdHelp :: ClientCommand (Maybe String)
cmdHelp ClientState
st Maybe String
mb = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
focus ClientState
st)
  where
    focus :: Subfocus
focus = Maybe Text -> Subfocus
FocusHelp ((String -> Text) -> Maybe String -> Maybe Text
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
_ =
  WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
commandNames Bool
isReversed ClientState
st
  where
    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 (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 (t :: * -> *) a. Foldable t => t a -> Int
length String
white Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> 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 (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 (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 (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 (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
    focus :: Focus
focus = 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

    urls :: [Text]
urls = Getting (Endo [Text]) ClientState Text -> ClientState -> [Text]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ( (Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> ClientState -> Const (Endo [Text]) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
 -> ClientState -> Const (Endo [Text]) ClientState)
-> ((Text -> Const (Endo [Text]) Text)
    -> Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> Getting (Endo [Text]) ClientState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus ((Window -> Const (Endo [Text]) Window)
 -> Map Focus Window -> Const (Endo [Text]) (Map Focus Window))
-> ((Text -> Const (Endo [Text]) Text)
    -> Window -> Const (Endo [Text]) Window)
-> (Text -> Const (Endo [Text]) Text)
-> Map Focus Window
-> Const (Endo [Text]) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLines -> Const (Endo [Text]) WindowLines)
-> Window -> Const (Endo [Text]) Window
Lens' Window WindowLines
winMessages ((WindowLines -> Const (Endo [Text]) WindowLines)
 -> Window -> Const (Endo [Text]) Window)
-> ((Text -> Const (Endo [Text]) Text)
    -> WindowLines -> Const (Endo [Text]) WindowLines)
-> (Text -> Const (Endo [Text]) Text)
-> Window
-> Const (Endo [Text]) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Const (Endo [Text]) WindowLine)
-> WindowLines -> Const (Endo [Text]) WindowLines
forall s t a b. Each s t a b => Traversal s t a b
each ((WindowLine -> Const (Endo [Text]) WindowLine)
 -> WindowLines -> Const (Endo [Text]) WindowLines)
-> ((Text -> Const (Endo [Text]) Text)
    -> WindowLine -> Const (Endo [Text]) WindowLine)
-> (Text -> Const (Endo [Text]) Text)
-> WindowLines
-> Const (Endo [Text]) WindowLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> WindowLine -> Const (Endo [Text]) WindowLine
Getter WindowLine Text
wlText
                    ((Text -> Const (Endo [Text]) Text)
 -> WindowLine -> Const (Endo [Text]) WindowLine)
-> ((Text -> Const (Endo [Text]) Text)
    -> Text -> Const (Endo [Text]) Text)
-> (Text -> Const (Endo [Text]) Text)
-> WindowLine
-> Const (Endo [Text]) WindowLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> Fold Text Text
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding Text -> [Text]
urlMatches) ClientState
st

    doUrlOpen :: UrlOpener -> Int -> IO CommandResult
doUrlOpen UrlOpener
opener Int
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 Int
Index [Text]
n) [Text]
urls 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 (String -> [String] -> IO ()
callProcess 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