{-# LANGUAGE BangPatterns, OverloadedStrings, ExistentialQuantification #-}
module Client.Commands
( CommandResult(..)
, execute
, executeUserCommand
, commandExpansion
, tabCompletion
, 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
execute ::
String ->
ClientState ->
IO CommandResult
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'
executeUserCommand ::
Maybe Text ->
String ->
ClientState ->
IO CommandResult
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)
commandExpansion ::
Maybe Text ->
ClientState ->
Text ->
Maybe Text
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
tabCompletion ::
Bool ->
ClientState ->
IO CommandResult
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
executeCommand ::
Maybe Bool ->
String ->
ClientState ->
IO CommandResult
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
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) ]
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))
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
]
cmdExit :: ClientCommand ()
cmdExit :: ClientCommand ()
cmdExit ClientState
st ()
_ = CommandResult -> IO CommandResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st)
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)
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)
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)
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
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)
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
tabReload :: Bool -> 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'
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