{-# Language OverloadedStrings, TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-|
Module      : Client.Commands.Queries
Description : Query command implementations
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.Queries (queryCommands) where

import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, extensionArg, Args)
import Client.Commands.Docs (queriesDocs, cmdDoc)
import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab)
import Client.Commands.Types (commandSuccess, commandSuccessUpdateCS, Command(Command), CommandImpl(NetworkCommand), CommandSection(CommandSection), NetworkCommand)
import Client.State (changeSubfocus, ClientState)
import Client.State.Focus (Subfocus(FocusChanList, FocusWho))
import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply)
import Client.WhoReply (newWhoReply)
import Control.Applicative (liftA2)
import Control.Lens (has, set, view)
import Control.Monad (unless)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Text qualified as Text
import Irc.Commands

queryCommands :: CommandSection
queryCommands :: CommandSection
queryCommands = Text -> [Command] -> CommandSection
CommandSection Text
"Queries"

  [ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"who")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (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
"[channel|nick|mask]") (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[options]"))))
      $(queriesDocs `cmdDoc` "who")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe (String, Maybe String))
cmdWho Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"whois")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "whois")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdWhois Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"whowas")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "whowas")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdWhowas Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"ison")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "ison")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdIson   Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"userhost")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "userhost")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdUserhost Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"time")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "time")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdTime Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"stats")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "stats")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdStats Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"lusers")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "lusers")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdLusers Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"users")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "users")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdUsers Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"motd")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "motd")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdMotd Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"admin")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "admin")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdAdmin Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"rules")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "rules")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdRules Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"info")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(queriesDocs `cmdDoc` "info")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand ()
cmdInfo Bool -> NetworkCommand String
noNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"list")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r a. String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
"[clientarg]" ClientState -> String -> Maybe (Args ClientState ListArgs)
listArgs))
      $(queriesDocs `cmdDoc` "list")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe ListArgs)
cmdList Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"links")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(queriesDocs `cmdDoc` "links")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdLinks Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"version")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[servername]"))
      $(queriesDocs `cmdDoc` "version")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe String)
cmdVersion Bool -> NetworkCommand String
simpleNetworkTab

  ]

cmdInfo :: NetworkCommand ()
cmdInfo :: NetworkCommand ()
cmdInfo NetworkState
cs ClientState
st ()
_ =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
ircInfo
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdVersion :: NetworkCommand (Maybe String)
cmdVersion :: NetworkCommand (Maybe String)
cmdVersion NetworkState
cs ClientState
st Maybe String
mbservername =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ Text -> RawIrcMsg
ircVersion forall a b. (a -> b) -> a -> b
$ case Maybe String
mbservername of
                                Just String
s  -> String -> Text
Text.pack String
s
                                Maybe String
Nothing -> Text
""
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdList :: NetworkCommand (Maybe ListArgs)
cmdList :: NetworkCommand (Maybe ListArgs)
cmdList NetworkState
cs ClientState
st Maybe ListArgs
rest =
    do
      let lsa :: ListArgs
lsa = forall a. a -> Maybe a -> a
fromMaybe ListArgs
lsaDefault Maybe ListArgs
rest
      let connecting :: Bool
connecting = forall s a. Getting Any s a -> s -> Bool
has (Lens' NetworkState PingStatus
csPingStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting) NetworkState
cs
      let elist :: Maybe Text
elist = forall a. a -> Maybe a
Just (String -> Text
Text.pack (forall a. a -> Maybe a -> a
fromMaybe String
"" (ListArgs -> Maybe String
_lsaElist ListArgs
lsa)))
      let cached :: Bool
cached = Maybe Text
elist forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' NetworkState ChannelList
csChannelList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelList (Maybe Text)
clsElist) NetworkState
cs
      let sendM :: IO ()
sendM = NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircList (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe a -> [a]
maybeToList (ListArgs -> Maybe String
_lsaElist ListArgs
lsa)))
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
connecting Bool -> Bool -> Bool
|| (Bool
cached Bool -> Bool -> Bool
&& Bool -> Bool
not (ListArgs -> Bool
_lsaRefresh ListArgs
lsa))) IO ()
sendM
      let cs' :: NetworkState
cs' = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' NetworkState ChannelList
csChannelList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelList (Maybe Text)
clsElist) Maybe Text
elist NetworkState
cs 
      let subfocus :: Subfocus
subfocus = Maybe Int -> Maybe Int -> Subfocus
FocusChanList (ListArgs -> Maybe Int
_lsaMin ListArgs
lsa) (ListArgs -> Maybe Int
_lsaMax ListArgs
lsa)
      NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
subfocus ClientState
st)

listArgs :: ClientState -> String -> Maybe (Args ClientState ListArgs)
listArgs :: ClientState -> String -> Maybe (Args ClientState ListArgs)
listArgs ClientState
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {f :: * -> *}.
Functor f =>
f (Maybe String) -> ListArgs -> f ListArgs
withElist (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[serverarg]"))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ListArgs
lsaParse
    where withElist :: f (Maybe String) -> ListArgs -> f ListArgs
withElist f (Maybe String)
arg ListArgs
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe String
s -> ListArgs
a { _lsaElist :: Maybe String
_lsaElist = Maybe String
s }) f (Maybe String)
arg

data ListArgs = ListArgs
  { ListArgs -> Maybe String
_lsaElist   :: Maybe String
  , ListArgs -> Bool
_lsaRefresh :: Bool
  , ListArgs -> Maybe Int
_lsaMin     :: Maybe Int
  , ListArgs -> Maybe Int
_lsaMax     :: Maybe Int
  }

lsaDefault :: ListArgs
lsaDefault :: ListArgs
lsaDefault = ListArgs
  { _lsaElist :: Maybe String
_lsaElist = forall a. Maybe a
Nothing
  , _lsaRefresh :: Bool
_lsaRefresh = Bool
False
  , _lsaMin :: Maybe Int
_lsaMin = forall a. Maybe a
Nothing
  , _lsaMax :: Maybe Int
_lsaMax = forall a. Maybe a
Nothing
  }

lsaParse :: String -> Maybe ListArgs
lsaParse :: String -> Maybe ListArgs
lsaParse = ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsaDefault
  where
    lsaParse' :: ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsa String
str = case String
str of
      Char
'~':String
rest -> ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsa{ _lsaRefresh :: Bool
_lsaRefresh = Bool
True } String
rest
      Char
',':String
rest -> ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsa String
rest
      Char
'>':(forall a. Read a => ReadS a
reads -> [(Int
min', String
rest)]) | Int
min' forall a. Ord a => a -> a -> Bool
>= Int
0 ->
        ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsa{ _lsaMin :: Maybe Int
_lsaMin = forall a. a -> Maybe a
Just Int
min'} String
rest
      Char
'<':(forall a. Read a => ReadS a
reads -> [(Int
max', String
rest)]) | Int
max' forall a. Ord a => a -> a -> Bool
>= Int
0 ->
        ListArgs -> String -> Maybe ListArgs
lsaParse' ListArgs
lsa{ _lsaMax :: Maybe Int
_lsaMax = forall a. a -> Maybe a
Just Int
max'} String
rest
      String
"" -> forall a. a -> Maybe a
Just ListArgs
lsa
      String
_ -> forall a. Maybe a
Nothing

cmdLusers :: NetworkCommand (Maybe String)
cmdLusers :: NetworkCommand (Maybe String)
cmdLusers NetworkState
cs ClientState
st Maybe String
arg =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ [Text] -> RawIrcMsg
ircLusers forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$
       case Maybe String
arg of
         Maybe String
Nothing -> []
         Just String
x -> [String
"*", String
x] -- mask field is legacy
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdUsers :: NetworkCommand (Maybe String)
cmdUsers :: NetworkCommand (Maybe String)
cmdUsers NetworkState
cs ClientState
st Maybe String
arg =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ Text -> RawIrcMsg
ircUsers forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
Text.pack Maybe String
arg
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdMotd :: NetworkCommand (Maybe String)
cmdMotd :: NetworkCommand (Maybe String)
cmdMotd NetworkState
cs ClientState
st Maybe String
mbservername =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ Text -> RawIrcMsg
ircMotd forall a b. (a -> b) -> a -> b
$ case Maybe String
mbservername of
                              Just String
s  -> String -> Text
Text.pack String
s
                              Maybe String
Nothing -> Text
""
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdAdmin :: NetworkCommand (Maybe String)
cmdAdmin :: NetworkCommand (Maybe String)
cmdAdmin NetworkState
cs ClientState
st Maybe String
mbservername =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ Text -> RawIrcMsg
ircAdmin forall a b. (a -> b) -> a -> b
$ case Maybe String
mbservername of
                              Just String
s  -> String -> Text
Text.pack String
s
                              Maybe String
Nothing -> Text
""
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdRules :: NetworkCommand (Maybe String)
cmdRules :: NetworkCommand (Maybe String)
cmdRules NetworkState
cs ClientState
st Maybe String
mbservername =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs forall a b. (a -> b) -> a -> b
$ Text -> RawIrcMsg
ircRules forall a b. (a -> b) -> a -> b
$
       case Maybe String
mbservername of
         Just String
s  -> String -> Text
Text.pack String
s
         Maybe String
Nothing -> Text
""
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdStats :: NetworkCommand String
cmdStats :: NetworkCommand String
cmdStats NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircStats (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdLinks :: NetworkCommand String
cmdLinks :: NetworkCommand String
cmdLinks NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircLinks (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdTime :: NetworkCommand (Maybe String)
cmdTime :: NetworkCommand (Maybe String)
cmdTime NetworkState
cs ClientState
st Maybe String
arg =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircTime (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
Text.pack Maybe String
arg))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdWhois :: NetworkCommand String
cmdWhois :: NetworkCommand String
cmdWhois NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircWhois (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdWho :: NetworkCommand (Maybe (String, Maybe String))
cmdWho :: NetworkCommand (Maybe (String, Maybe String))
cmdWho NetworkState
_  ClientState
st Maybe (String, Maybe String)
Nothing = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusWho ClientState
st)
cmdWho NetworkState
cs ClientState
st (Just (String
query, Maybe String
arg)) =
  do
    let query' :: Text
query' = String -> Text
Text.pack String
query
    let arg' :: String
arg' = forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
arg
    let cs' :: NetworkState
cs' = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' NetworkState WhoReply
csWhoReply (Text -> String -> WhoReply
newWhoReply Text
query' String
arg') NetworkState
cs
    NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircWho (Text
query' forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
arg)))
    NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs' (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusWho ClientState
st)

cmdWhowas :: NetworkCommand String
cmdWhowas :: NetworkCommand String
cmdWhowas NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircWhowas (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdIson :: NetworkCommand String
cmdIson :: NetworkCommand String
cmdIson NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircIson (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdUserhost :: NetworkCommand String
cmdUserhost :: NetworkCommand String
cmdUserhost NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircUserhost (String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
words String
rest))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st