{-# LANGUAGE BangPatterns, OverloadedStrings, TemplateHaskell, ExistentialQuantification #-}
module Client.Commands
( CommandResult(..)
, execute
, executeUserCommand
, commandExpansion
, tabCompletion
, CommandSection(..)
, Command(..)
, CommandImpl(..)
, commands
, commandsList
) where
import Client.Commands.Arguments.Parser (parse)
import Client.Commands.Arguments.Spec (optionalArg, optionalNumberArg, remainingArg, simpleToken)
import Client.Commands.Docs (clientDocs, cmdDoc)
import Client.Commands.Exec
import Client.Commands.Interpolation (resolveMacroExpansions, Macro(Macro), MacroSpec(MacroSpec))
import Client.Commands.Recognizer (fromCommands, keys, recognize, Recognition(Exact), Recognizer)
import Client.Commands.WordCompletion (caseText, plainWordCompleteMode, wordComplete)
import Client.Configuration
import Client.State
import Client.State.Extensions (clientCommandExtension, clientStartExtensions)
import Client.State.Focus
import Client.State.Network (csNick, isChannelIdentifier, sendMsg)
import Client.State.Url
import Control.Applicative (liftA2, (<|>))
import Control.Exception (displayException, try)
import Control.Lens
import Control.Monad (guard, foldM)
import Data.Foldable (foldl', toList)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time (getZonedTime)
import Irc.Commands (ircPrivmsg)
import Irc.Identifier (idText)
import Irc.Message (IrcMsg(Privmsg))
import Irc.RawIrcMsg (parseRawIrcMsg)
import RtsStats (getStats)
import System.Process.Typed (proc, runProcess_)
import Client.Commands.Certificate (newCertificateCommand)
import Client.Commands.Channel (channelCommands)
import Client.Commands.Chat (chatCommands, chatCommand', executeChat)
import Client.Commands.Connection (connectionCommands)
import Client.Commands.Operator (operatorCommands)
import Client.Commands.Queries (queryCommands)
import Client.Commands.TabCompletion
import Client.Commands.Toggles (togglesCommands)
import Client.Commands.Types
import Client.Commands.Window (windowCommands)
import Client.Commands.ZNC (zncCommands)
execute ::
String ->
ClientState ->
IO CommandResult
execute :: String -> ClientState -> IO CommandResult
execute String
str ClientState
st =
let st' :: ClientState
st' = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Text)
clientErrorMsg forall a. Maybe a
Nothing ClientState
st in
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
str of
[] -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
Char
'/':String
command -> Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand forall a. Maybe a
Nothing String
command ClientState
st'
String
_ -> String -> ClientState -> IO CommandResult
executeChat String
str ClientState
st'
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 (forall a. Eq a => a -> a -> Bool
/=Char
' ') (String -> Text
Text.pack String
command)
rest :: String
rest = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
' ') (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') String
command)
case forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Recognizer Macro)
configMacros) (forall a. Text -> Recognizer a -> Recognition a
recognize Text
key) ClientState
st of
Exact (Macro Text
_ (MacroSpec forall r. Args r [String]
spec) [[ExpansionChunk]]
cmdExs) ->
case forall {t :: * -> *}.
Traversable t =>
Args ClientState [String]
-> t [ExpansionChunk] -> String -> Maybe (t Text)
doExpansion forall r. Args r [String]
spec [[ExpansionChunk]]
cmdExs String
rest of
Maybe [Text]
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"macro expansions failed" ClientState
st
Just [Text]
cmds -> [Text] -> ClientState -> IO CommandResult
process [Text]
cmds ClientState
st
Recognition Macro
_ -> Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand forall a. Maybe a
Nothing String
command ClientState
st
where
doExpansion :: Args ClientState [String]
-> t [ExpansionChunk] -> String -> Maybe (t Text)
doExpansion Args ClientState [String]
spec t [ExpansionChunk]
cmdExs String
rest =
do [String]
args <- forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState [String]
spec String
rest
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
args)) t [ExpansionChunk]
cmdExs
resolveMacro :: [Text] -> [ExpansionChunk] -> Maybe Text
resolveMacro [Text]
args = forall (f :: * -> *).
Alternative f =>
(Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions (Maybe Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Text
discoTime ClientState
st) (forall a. [a] -> Integer -> Maybe a
expandInt [Text]
args)
expandInt :: [a] -> Integer -> Maybe a
expandInt :: forall a. [a] -> Integer -> Maybe a
expandInt [a]
args Integer
i = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a. Num a => Integer -> a
fromInteger Integer
i)) [a]
args
process :: [Text] -> ClientState -> IO CommandResult
process [] ClientState
st0 = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st0
process (Text
c:[Text]
cs) ClientState
st0 =
do CommandResult
res <- Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand forall a. Maybe a
Nothing (Text -> String
Text.unpack Text
c) ClientState
st0
case CommandResult
res of
CommandSuccess ClientState
st1 -> [Text] -> ClientState -> IO CommandResult
process [Text]
cs ClientState
st1
CommandFailure ClientState
st1 -> [Text] -> ClientState -> IO CommandResult
process [Text]
cs ClientState
st1
CommandQuit ClientState
st1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st1)
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" -> forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
Text
"channel" -> forall s (m :: * -> *) r a.
MonadReader s m =>
Getting (First r) s a -> (a -> r) -> m (Maybe r)
previews (Lens' ClientState Focus
clientFocus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Focus (Text, Identifier)
_ChannelFocus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) Identifier -> Text
idText ClientState
st
Text
"nick" -> do Text
net <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st
forall (m :: * -> *) a. Monad m => a -> m a
return (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' NetworkState Identifier
csNick Identifier -> Text
idText NetworkState
cs)
Text
"disconnect" -> Maybe Text
discoTime
Text
_ -> forall a. Maybe a
Nothing
tabCompletion ::
Bool ->
ClientState ->
IO CommandResult
tabCompletion :: Bool -> ClientState -> IO CommandResult
tabCompletion Bool
isReversed ClientState
st =
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' ' forall a. Eq a => a -> a -> Bool
==) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ ClientState -> (Int, String)
clientLine ClientState
st of
Char
'/':String
command -> Maybe Bool -> String -> ClientState -> IO CommandResult
executeCommand (forall a. a -> Maybe a
Just Bool
isReversed) String
command ClientState
st
String
_ -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st
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 = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
executeCommand Maybe Bool
tabCompleteReversed String
str ClientState
st =
let (String
cmd, String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
' ') String
str
cmdTxt :: Text
cmdTxt = Text -> Text
Text.toLower (String -> Text
Text.pack String
cmd)
finish :: Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState t
spec ClientState -> t -> IO CommandResult
exec Bool -> ClientState -> String -> IO CommandResult
tab =
case Maybe Bool
tabCompleteReversed of
Just Bool
isReversed -> Bool -> ClientState -> String -> IO CommandResult
tab Bool
isReversed ClientState
st String
rest
Maybe Bool
Nothing ->
case forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState t
spec String
rest of
Maybe t
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad command arguments" ClientState
st
Just t
arg -> ClientState -> t -> IO CommandResult
exec ClientState
st t
arg
in
case forall a. Text -> Recognizer a -> Recognition a
recognize Text
cmdTxt Recognizer Command
commands of
Exact Command{cmdImplementation :: ()
cmdImplementation=CommandImpl a
impl, cmdArgumentSpec :: ()
cmdArgumentSpec=Args ClientState a
argSpec} ->
case CommandImpl a
impl of
ClientCommand ClientCommand a
exec Bool -> ClientState -> String -> IO CommandResult
tab ->
forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec ClientCommand a
exec Bool -> ClientState -> String -> IO CommandResult
tab
NetworkCommand NetworkCommand a
exec Bool -> NetworkCommand String
tab
| Just Text
network <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
, Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (NetworkCommand a
exec NetworkState
cs) (\Bool
x -> Bool -> NetworkCommand String
tab Bool
x NetworkState
cs)
| Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused network" ClientState
st
ChannelCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
| ChannelFocus Text
network Identifier
channelId <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
, Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st
, NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
channelId ->
forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
| Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused channel" ClientState
st
ChatCommand ChannelCommand a
exec Bool -> ChannelCommand String
tab
| ChannelFocus Text
network Identifier
channelId <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
, Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
forall {t}.
Args ClientState t
-> (ClientState -> t -> IO CommandResult)
-> (Bool -> ClientState -> String -> IO CommandResult)
-> IO CommandResult
finish Args ClientState a
argSpec (ChannelCommand a
exec Identifier
channelId NetworkState
cs) (\Bool
x -> Bool -> ChannelCommand String
tab Bool
x Identifier
channelId NetworkState
cs)
| Bool
otherwise -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused chat window" ClientState
st
Recognition Command
_ -> case Maybe Bool
tabCompleteReversed of
Just Bool
isReversed -> Bool -> ClientState -> IO CommandResult
nickTabCompletion Bool
isReversed ClientState
st
Maybe Bool
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown command" ClientState
st
expandAliases :: [Command] -> [(Text,Command)]
expandAliases :: [Command] -> [(Text, Command)]
expandAliases [Command]
xs =
[ (Text
name, Command
cmd) | Command
cmd <- [Command]
xs, Text
name <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Command -> NonEmpty Text
cmdNames Command
cmd) ]
commands :: Recognizer Command
commands :: Recognizer Command
commands = forall a. [(Text, a)] -> Recognizer a
fromCommands ([Command] -> [(Text, Command)]
expandAliases (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandSection -> [Command]
cmdSectionCmds [CommandSection]
commandsList))
commandsList :: [CommandSection]
commandsList :: [CommandSection]
commandsList =
[ Text -> [Command] -> CommandSection
CommandSection Text
"Client commands"
[ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exit")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(clientDocs `cmdDoc` "exit")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdExit Bool -> ClientState -> String -> IO CommandResult
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reload")
(forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[filename]"))
$(clientDocs `cmdDoc` "reload")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdReload Bool -> ClientState -> String -> IO CommandResult
tabReload
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"extension")
(forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. String -> Args r String
simpleToken String
"extension") (forall r. String -> Args r String
remainingArg String
"arguments"))
$(clientDocs `cmdDoc` "extension")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (String, String)
cmdExtension Bool -> ClientState -> String -> IO CommandResult
simpleClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"palette")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(clientDocs `cmdDoc` "palette")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdPalette Bool -> ClientState -> String -> IO CommandResult
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"digraphs")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(clientDocs `cmdDoc` "digraphs")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdDigraphs Bool -> ClientState -> String -> IO CommandResult
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"keymap")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(clientDocs `cmdDoc` "keymap")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdKeyMap Bool -> ClientState -> String -> IO CommandResult
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"rtsstats")
(forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$(clientDocs `cmdDoc` "rtsstats")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand ()
cmdRtsStats Bool -> ClientState -> String -> IO CommandResult
noClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"exec")
(forall r. String -> Args r String
remainingArg String
"arguments")
$(clientDocs `cmdDoc` "exec")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientState -> String -> IO CommandResult
cmdExec Bool -> ClientState -> String -> IO CommandResult
simpleClientTab
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"url")
forall r. Args r (Maybe Int)
optionalNumberArg
$(clientDocs `cmdDoc` "url")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe Int)
cmdUrl Bool -> ClientState -> String -> IO CommandResult
noClientTab
, Command
newCertificateCommand
, forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"help")
(forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[command]"))
$(clientDocs `cmdDoc` "help")
forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a
-> (Bool -> ClientState -> String -> IO CommandResult)
-> CommandImpl a
ClientCommand ClientCommand (Maybe String)
cmdHelp Bool -> ClientState -> String -> IO CommandResult
tabHelp
],
CommandSection
togglesCommands, CommandSection
connectionCommands, CommandSection
windowCommands, CommandSection
chatCommands,
CommandSection
queryCommands, CommandSection
channelCommands, CommandSection
zncCommands, CommandSection
operatorCommands
]
cmdExit :: ClientCommand ()
cmdExit :: ClientCommand ()
cmdExit ClientState
st ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> CommandResult
CommandQuit ClientState
st)
cmdPalette :: ClientCommand ()
cmdPalette :: ClientCommand ()
cmdPalette ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusPalette ClientState
st)
cmdDigraphs :: ClientCommand ()
cmdDigraphs :: ClientCommand ()
cmdDigraphs ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusDigraphs ClientState
st)
cmdKeyMap :: ClientCommand ()
cmdKeyMap :: ClientCommand ()
cmdKeyMap ClientState
st ()
_ = 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{} -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState (Maybe Stats)
clientRtsStats Maybe Stats
mb
forall a b. (a -> b) -> a -> b
$ Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusRtsStats ClientState
st
cmdHelp :: ClientCommand (Maybe String)
cmdHelp :: ClientCommand (Maybe String)
cmdHelp ClientState
st Maybe String
mb = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
focus ClientState
st)
where
focus :: Subfocus
focus = Maybe Text -> Subfocus
FocusHelp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack Maybe String
mb)
tabHelp :: Bool -> ClientCommand String
tabHelp :: Bool -> ClientState -> String -> IO CommandResult
tabHelp Bool
isReversed ClientState
st String
_ =
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
commandNames Bool
isReversed ClientState
st
where
commandNames :: [Text]
commandNames = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command] -> [(Text, Command)]
expandAliases (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CommandSection -> [Command]
cmdSectionCmds [CommandSection]
commandsList)
cmdReload :: ClientCommand (Maybe String)
cmdReload :: ClientCommand (Maybe String)
cmdReload ClientState
st Maybe String
mbPath =
do let path :: Maybe String
path = Maybe String
mbPath forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState String
clientConfigPath ClientState
st)
Either ConfigurationFailure (String, Configuration)
res <- Maybe String
-> IO (Either ConfigurationFailure (String, Configuration))
loadConfiguration Maybe String
path
case Either ConfigurationFailure (String, Configuration)
res of
Left ConfigurationFailure
e -> Text -> ClientState -> IO CommandResult
commandFailureMsg (ConfigurationFailure -> Text
describeProblem ConfigurationFailure
e) ClientState
st
Right (String
path',Configuration
cfg) ->
do ClientState
st1 <- ClientState -> IO ClientState
clientStartExtensions
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Configuration
clientConfig Configuration
cfg
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState String
clientConfigPath String
path' ClientState
st
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st1
where
describeProblem :: ConfigurationFailure -> Text
describeProblem ConfigurationFailure
err =
String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$
case ConfigurationFailure
err of
ConfigurationReadFailed String
e -> String
"Failed to open configuration: " forall a. [a] -> [a] -> [a]
++ String
e
ConfigurationParseFailed String
_ String
e -> String
"Failed to parse configuration: " forall a. [a] -> [a] -> [a]
++ String
e
ConfigurationMalformed String
_ String
e -> String
"Configuration malformed: " forall a. [a] -> [a] -> [a]
++ String
e
tabReload :: Bool -> ClientCommand String
tabReload :: Bool -> ClientState -> String -> IO CommandResult
tabReload Bool
_ ClientState
st String
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure ClientState
st
commandNameCompletion :: Bool -> ClientState -> Maybe ClientState
commandNameCompletion :: Bool -> ClientState -> Maybe ClientState
commandNameCompletion Bool
isReversed ClientState
st =
do forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
cursorPos forall a. Eq a => a -> a -> Bool
== Int
n)
Lens' ClientState EditBox
clientTextBox (forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
wordComplete (Char
' ' forall a. Eq a => a -> a -> Bool
/=) WordCompletionMode
plainWordCompleteMode Bool
isReversed [] [CaseText]
possibilities) ClientState
st
where
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
white forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
leadingPart
(Int
cursorPos, String
line) = ClientState -> (Int, String)
clientLine ClientState
st
(String
white, String
leadingPart) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
' ' forall a. Eq a => a -> a -> Bool
/=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
' 'forall a. Eq a => a -> a -> Bool
==) String
line
possibilities :: [CaseText]
possibilities = Text -> CaseText
caseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
Text.cons Char
'/' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
commandNames
commandNames :: [Text]
commandNames = forall a. Recognizer a -> [Text]
keys Recognizer Command
commands
forall a. [a] -> [a] -> [a]
++ forall a. Recognizer a -> [Text]
keys (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Recognizer Macro)
configMacros) ClientState
st)
cmdExtension :: ClientCommand (String, String)
cmdExtension :: ClientCommand (String, String)
cmdExtension ClientState
st (String
name,String
command) =
do Maybe ClientState
res <- Text -> Text -> ClientState -> IO (Maybe ClientState)
clientCommandExtension (String -> Text
Text.pack String
name) (String -> Text
Text.pack String
command) ClientState
st
case Maybe ClientState
res of
Maybe ClientState
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unknown extension" ClientState
st
Just ClientState
st' -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
cmdExec :: ClientCommand String
cmdExec :: ClientState -> String -> IO CommandResult
cmdExec ClientState
st String
rest =
do ZonedTime
now <- IO ZonedTime
getZonedTime
case String -> Either [String] ExecCmd
parseExecCmd String
rest of
Left [String]
es -> forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
Right ExecCmd
ec ->
case forall {a}.
IsString a =>
ZonedTime -> ExecCmd -> Either [a] ([Text] -> IO CommandResult)
buildTransmitter ZonedTime
now ExecCmd
ec of
Left [String]
es -> forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
Right [Text] -> IO CommandResult
tx ->
do Either [String] [String]
res <- ExecCmd -> IO (Either [String] [String])
runExecCmd ExecCmd
ec
case Either [String] [String]
res of
Left [String]
es -> forall {m :: * -> *}.
Monad m =>
ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es
Right [String]
msgs -> [Text] -> IO CommandResult
tx (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
msgs)
where
buildTransmitter :: ZonedTime -> ExecCmd -> Either [a] ([Text] -> IO CommandResult)
buildTransmitter ZonedTime
now ExecCmd
ec =
case (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd (Target String)
execOutputNetwork ExecCmd
ec,
String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd (Target String)
execOutputChannel ExecCmd
ec) of
(Target Text
Unspecified, Target Text
Unspecified) -> forall a b. b -> Either a b
Right (forall {m :: * -> *} {t :: * -> *}.
(Monad m, Foldable t) =>
ZonedTime -> t Text -> m CommandResult
sendToClient ZonedTime
now)
(Specified Text
network, Specified Text
channel) ->
case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"Unknown network"]
Just NetworkState
cs -> forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel)
(Target Text
_ , Specified Text
channel) ->
case Maybe NetworkState
currentNetworkState of
Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"No current network"]
Just NetworkState
cs -> forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel)
(Specified Text
network, Target Text
_) ->
case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st of
Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"Unknown network"]
Just NetworkState
cs -> forall a b. b -> Either a b
Right (forall {t :: * -> *}.
Foldable t =>
ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs)
(Target Text
_, Target Text
Current) ->
case Maybe NetworkState
currentNetworkState of
Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"No current network"]
Just NetworkState
cs ->
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
ChannelFocus Text
_ Identifier
channel -> forall a b. b -> Either a b
Right (NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs (Identifier -> Text
idText Identifier
channel))
Focus
_ -> forall a b. a -> Either a b
Left [a
"No current channel"]
(Target Text
Current, Target Text
_) ->
case Maybe NetworkState
currentNetworkState of
Maybe NetworkState
Nothing -> forall a b. a -> Either a b
Left [a
"No current network"]
Just NetworkState
cs -> forall a b. b -> Either a b
Right (forall {t :: * -> *}.
Foldable t =>
ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs)
sendToClient :: ZonedTime -> t Text -> m CommandResult
sendToClient ZonedTime
now t Text
msgs = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ZonedTime -> ClientState -> Text -> ClientState
recordSuccess ZonedTime
now) ClientState
st t Text
msgs
sendToNetwork :: ZonedTime -> NetworkState -> t Text -> IO CommandResult
sendToNetwork ZonedTime
now NetworkState
cs t Text
msgs =
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ClientState
st1 Text
msg ->
case Text -> Maybe RawIrcMsg
parseRawIrcMsg Text
msg of
Maybe RawIrcMsg
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"" (Text
"Bad raw message: " forall a. Semigroup a => a -> a -> a
<> Text
msg) ClientState
st1
Just RawIrcMsg
raw ->
do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
raw
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st1) ClientState
st t Text
msgs
sendToChannel :: NetworkState -> Text -> [Text] -> IO CommandResult
sendToChannel NetworkState
cs Text
channel [Text]
msgs =
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ClientState
st1 Text
msg ->
do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Text -> RawIrcMsg
ircPrivmsg Text
channel Text
msg)
(Source -> Identifier -> IrcMsg)
-> [Text] -> NetworkState -> ClientState -> IO ClientState
chatCommand'
(\Source
src Identifier
tgt -> Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
tgt Text
msg)
[Text
channel]
NetworkState
cs ClientState
st1) ClientState
st (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
msgs)
currentNetworkState :: Maybe NetworkState
currentNetworkState =
do Text
network <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st
failure :: ZonedTime -> [String] -> m CommandResult
failure ZonedTime
now [String]
es =
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now Text
"")) ClientState
st (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
es)
cmdUrl :: ClientCommand (Maybe Int)
cmdUrl :: ClientCommand (Maybe Int)
cmdUrl ClientState
st Maybe Int
arg =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (Maybe UrlOpener)
configUrlOpener) ClientState
st of
Maybe UrlOpener
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"url-opener not configured" ClientState
st
Just UrlOpener
opener -> UrlOpener -> Int -> IO CommandResult
doUrlOpen UrlOpener
opener (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
subtract Int
1) Maybe Int
arg)
where
doUrlOpen :: UrlOpener -> Index [Text] -> IO CommandResult
doUrlOpen UrlOpener
opener Index [Text]
n =
case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index [Text]
n) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (ClientState -> [UrlPair]
urlList ClientState
st)) of
Just Text
url -> UrlOpener -> String -> ClientState -> IO CommandResult
openUrl UrlOpener
opener (Text -> String
Text.unpack Text
url) ClientState
st
Maybe Text
Nothing -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"bad url number" ClientState
st
openUrl :: UrlOpener -> String -> ClientState -> IO CommandResult
openUrl :: UrlOpener -> String -> ClientState -> IO CommandResult
openUrl (UrlOpener String
opener [UrlArgument]
args) String
url ClientState
st =
do let argStr :: UrlArgument -> String
argStr (UrlArgLiteral String
str) = String
str
argStr UrlArgument
UrlArgUrl = String
url
Either IOError ()
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (String -> [String] -> ProcessConfig () () ()
proc String
opener (forall a b. (a -> b) -> [a] -> [b]
map UrlArgument -> String
argStr [UrlArgument]
args)))
case Either IOError ()
res of
Left IOError
e -> Text -> ClientState -> IO CommandResult
commandFailureMsg (String -> Text
Text.pack (forall e. Exception e => e -> String
displayException (IOError
e :: IOError))) ClientState
st
Right{} -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st