{-# Language BangPatterns, BlockArguments, OverloadedStrings, TemplateHaskell #-}
{-|
Module      : Client.Commands.Chat
Description : Common user IRC commands
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.Chat (chatCommands, chatCommand', executeChat, cmdCtcp) where

import Client.Commands.Arguments.Spec
import Client.Commands.TabCompletion
import Client.Commands.Types
import Client.Commands.Window (parseFocus)
import Client.Message
import Client.State
import Client.State.Channel (chanJoined)
import Client.State.Extensions (clientChatExtension)
import Client.State.Focus (focusNetwork, Focus(ChannelFocus), Subfocus(FocusInfo, FocusUsers))
import Client.State.Network
import Control.Applicative (liftA2, liftA3)
import Control.Lens (filteredBy, has, ix, view, preview, views)
import Control.Monad (when, unless)
import Data.ByteString qualified as B
import Data.Char (toUpper)
import Data.Foldable (foldl', traverse_)
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Time (getZonedTime)
import Irc.Commands
import Irc.Identifier (Identifier, idText, mkId)
import Irc.Message (IrcMsg(Privmsg, Notice, Ctcp), Source(Source))
import Irc.RawIrcMsg (RawIrcMsg, parseRawIrcMsg)
import Client.Commands.Docs (chatDocs, cmdDoc)

chatCommands :: CommandSection
chatCommands :: CommandSection
chatCommands = Text -> [Command] -> CommandSection
CommandSection Text
"IRC commands"
  ------------------------------------------------------------------------

  [ NonEmpty Text
-> Args ArgsContext ([Char], Maybe [Char])
-> Text
-> CommandImpl ([Char], Maybe [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text
"join" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"j"])
      (([Char] -> Maybe [Char] -> ([Char], Maybe [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) (Maybe [Char])
-> Args ArgsContext ([Char], Maybe [Char])
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"channels") (Ap (Arg ArgsContext) [Char] -> Ap (Arg ArgsContext) (Maybe [Char])
forall r a. Args r a -> Args r (Maybe a)
optionalArg ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"[keys]")))
      $(chatDocs `cmdDoc` "join")
    (CommandImpl ([Char], Maybe [Char]) -> Command)
-> CommandImpl ([Char], Maybe [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ([Char], Maybe [Char])
-> (Bool -> NetworkCommand [Char])
-> CommandImpl ([Char], Maybe [Char])
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand ([Char], Maybe [Char])
cmdJoin Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"part")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"reason")
      $(chatDocs `cmdDoc` "part")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand [Char]
-> (Bool -> ChannelCommand [Char]) -> CommandImpl [Char]
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand [Char]
cmdPart Bool -> ChannelCommand [Char]
simpleChannelTab

  , NonEmpty Text
-> Args ArgsContext ([Char], [Char])
-> Text
-> CommandImpl ([Char], [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"msg")
      (([Char] -> [Char] -> ([Char], [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Args ArgsContext ([Char], [Char])
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message"))
      $(chatDocs `cmdDoc` "msg")
    (CommandImpl ([Char], [Char]) -> Command)
-> CommandImpl ([Char], [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ([Char], [Char])
-> (Bool -> NetworkCommand [Char]) -> CommandImpl ([Char], [Char])
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand ([Char], [Char])
cmdMsg Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"me")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message")
      $(chatDocs `cmdDoc` "me")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand [Char]
-> (Bool -> ChannelCommand [Char]) -> CommandImpl [Char]
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChatCommand ChannelCommand [Char]
cmdMe Bool -> ChannelCommand [Char]
simpleChannelTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"say")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message")
      $(chatDocs `cmdDoc` "say")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand [Char]
-> (Bool -> ChannelCommand [Char]) -> CommandImpl [Char]
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChatCommand ChannelCommand [Char]
cmdSay Bool -> ChannelCommand [Char]
simpleChannelTab

  , NonEmpty Text
-> Args ArgsContext ([Char], [Char])
-> Text
-> CommandImpl ([Char], [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text
"query" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"q"])
      (([Char] -> [Char] -> ([Char], [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Args ArgsContext ([Char], [Char])
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message"))
      $(chatDocs `cmdDoc` "query")
    (CommandImpl ([Char], [Char]) -> Command)
-> CommandImpl ([Char], [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ([Char], [Char])
-> (Bool -> ClientCommand [Char]) -> CommandImpl ([Char], [Char])
forall a.
ClientCommand a -> (Bool -> ClientCommand [Char]) -> CommandImpl a
ClientCommand ClientCommand ([Char], [Char])
cmdQuery Bool -> ClientCommand [Char]
simpleClientTab

  , NonEmpty Text
-> Args ArgsContext ([Char], [Char])
-> Text
-> CommandImpl ([Char], [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"notice")
      (([Char] -> [Char] -> ([Char], [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Args ArgsContext ([Char], [Char])
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message"))
      $(chatDocs `cmdDoc` "notice")
    (CommandImpl ([Char], [Char]) -> Command)
-> CommandImpl ([Char], [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ([Char], [Char])
-> (Bool -> NetworkCommand [Char]) -> CommandImpl ([Char], [Char])
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand ([Char], [Char])
cmdNotice Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"wallops")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message to +w users")
      $(chatDocs `cmdDoc` "wallops")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [Char]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [Char]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdWallops Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"operwall")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message to +z opers")
      $(chatDocs `cmdDoc` "operwall")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [Char]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [Char]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdOperwall Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Args ArgsContext ([Char], [Char], [Char])
-> Text
-> CommandImpl ([Char], [Char], [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"ctcp")
      (([Char] -> [Char] -> [Char] -> ([Char], [Char], [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Args ArgsContext ([Char], [Char], [Char])
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"command") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"arguments"))
      $(chatDocs `cmdDoc` "ctcp")
    (CommandImpl ([Char], [Char], [Char]) -> Command)
-> CommandImpl ([Char], [Char], [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ([Char], [Char], [Char])
-> (Bool -> NetworkCommand [Char])
-> CommandImpl ([Char], [Char], [Char])
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand ([Char], [Char], [Char])
cmdCtcp Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"nick")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"nick")
      $(chatDocs `cmdDoc` "nick")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [Char]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [Char]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdNick Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"away")
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message")
      $(chatDocs `cmdDoc` "away")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [Char]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [Char]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdAway Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"names")
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(chatDocs `cmdDoc` "names")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand ()
-> (Bool -> ChannelCommand [Char]) -> CommandImpl ()
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand ()
cmdChanNames Bool -> ChannelCommand [Char]
noChannelTab

  , NonEmpty Text
-> Args ArgsContext () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text
"channelinfo" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"cinfo"])
      (() -> Args ArgsContext ()
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(chatDocs `cmdDoc` "channelinfo")
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand ()
-> (Bool -> ChannelCommand [Char]) -> CommandImpl ()
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand [Char]) -> CommandImpl a
ChannelCommand ChannelCommand ()
cmdChannelInfo Bool -> ChannelCommand [Char]
noChannelTab

  , NonEmpty Text
-> Args ArgsContext ([Char], [Char])
-> Text
-> CommandImpl ([Char], [Char])
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"knock")
      (([Char] -> [Char] -> ([Char], [Char]))
-> Ap (Arg ArgsContext) [Char]
-> Ap (Arg ArgsContext) [Char]
-> Args ArgsContext ([Char], [Char])
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"channel") ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"message"))
      $(chatDocs `cmdDoc` "knock")
    (CommandImpl ([Char], [Char]) -> Command)
-> CommandImpl ([Char], [Char]) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ([Char], [Char])
-> (Bool -> NetworkCommand [Char]) -> CommandImpl ([Char], [Char])
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand ([Char], [Char])
cmdKnock Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ArgsContext) [Char]
-> Text
-> CommandImpl [Char]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text
"quote" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"/"])
      ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
remainingArg [Char]
"raw IRC command")
      $(chatDocs `cmdDoc` "quote")
    (CommandImpl [Char] -> Command) -> CommandImpl [Char] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [Char]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [Char]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdQuote Bool -> NetworkCommand [Char]
simpleNetworkTab

  , NonEmpty Text
-> Args ArgsContext [[Char]]
-> Text
-> CommandImpl [[Char]]
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"monitor")
      ([Char]
-> (ArgsContext -> [Char] -> Maybe (Args ArgsContext [[Char]]))
-> Args ArgsContext [[Char]]
forall r a. [Char] -> (r -> [Char] -> Maybe (Args r a)) -> Args r a
extensionArg [Char]
"[+-CLS]" ArgsContext -> [Char] -> Maybe (Args ArgsContext [[Char]])
monitorArgs)
      $(chatDocs `cmdDoc` "monitor")
    (CommandImpl [[Char]] -> Command)
-> CommandImpl [[Char]] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [[Char]]
-> (Bool -> NetworkCommand [Char]) -> CommandImpl [[Char]]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [[Char]]
cmdMonitor Bool -> NetworkCommand [Char]
simpleNetworkTab

  ]

monitorArgs :: ArgsContext -> String -> Maybe (Args ArgsContext [String])
monitorArgs :: ArgsContext -> [Char] -> Maybe (Args ArgsContext [[Char]])
monitorArgs ArgsContext
_ [Char]
str =
  case Char -> Char
toUpper (Char -> Char) -> [Char] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
str of
    [Char]
"+" -> Args ArgsContext [[Char]] -> Maybe (Args ArgsContext [[Char]])
forall a. a -> Maybe a
Just (Char -> Ap (Arg ArgsContext) [Char] -> Args ArgsContext [[Char]]
forall {f :: * -> *} {a}. Functor f => a -> f [a] -> f [[a]]
wrap Char
'+' ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target[,target2]*"))
    [Char]
"-" -> Args ArgsContext [[Char]] -> Maybe (Args ArgsContext [[Char]])
forall a. a -> Maybe a
Just (Char -> Ap (Arg ArgsContext) [Char] -> Args ArgsContext [[Char]]
forall {f :: * -> *} {a}. Functor f => a -> f [a] -> f [[a]]
wrap Char
'-' ([Char] -> Ap (Arg ArgsContext) [Char]
forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target[,target2]*"))
    [Char]
"C" -> Args ArgsContext [[Char]] -> Maybe (Args ArgsContext [[Char]])
forall a. a -> Maybe a
Just ([[Char]] -> Args ArgsContext [[Char]]
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"C"])
    [Char]
"L" -> Args ArgsContext [[Char]] -> Maybe (Args ArgsContext [[Char]])
forall a. a -> Maybe a
Just ([[Char]] -> Args ArgsContext [[Char]]
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"L"])
    [Char]
"S" -> Args ArgsContext [[Char]] -> Maybe (Args ArgsContext [[Char]])
forall a. a -> Maybe a
Just ([[Char]] -> Args ArgsContext [[Char]]
forall a. a -> Ap (Arg ArgsContext) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"S"])
    [Char]
_   -> Maybe (Args ArgsContext [[Char]])
forall a. Maybe a
Nothing
  where
    wrap :: a -> f [a] -> f [[a]]
wrap a
c = ([a] -> [[a]]) -> f [a] -> f [[a]]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[a]
s -> [[a
c], [a]
s])

cmdMonitor :: NetworkCommand [String]
cmdMonitor :: NetworkCommand [[Char]]
cmdMonitor NetworkState
cs ClientState
st [[Char]]
args =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircMonitor (([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
Text.pack [[Char]]
args))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdChanNames :: ChannelCommand ()
cmdChanNames :: ChannelCommand ()
cmdChanNames Identifier
chan NetworkState
cs ClientState
st ()
_ = do
    -- TODO: Uncomment when RPL_NAMREPLY actually creates a ChannelState.
    -- let connecting = has (csPingStatus . _PingConnecting) cs
    --     isJoined   = has (csChannels . ix chan . filteredBy chanJoined) cs
    -- unless (connecting || isJoined)
    --   (sendMsg cs (ircNames chan))
    ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
subfocus ClientState
st)
  where subfocus :: Subfocus
subfocus = Text -> Identifier -> Subfocus
FocusUsers (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
chan

cmdChannelInfo :: ChannelCommand ()
cmdChannelInfo :: ChannelCommand ()
cmdChannelInfo Identifier
chan NetworkState
cs ClientState
st ()
_ = do
    let connecting :: Bool
connecting = Getting Any NetworkState (Int, Maybe UTCTime, ConnectRestriction)
-> NetworkState -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((PingStatus -> Const Any PingStatus)
-> NetworkState -> Const Any NetworkState
Lens' NetworkState PingStatus
csPingStatus ((PingStatus -> Const Any PingStatus)
 -> NetworkState -> Const Any NetworkState)
-> (((Int, Maybe UTCTime, ConnectRestriction)
     -> Const Any (Int, Maybe UTCTime, ConnectRestriction))
    -> PingStatus -> Const Any PingStatus)
-> Getting
     Any NetworkState (Int, Maybe UTCTime, ConnectRestriction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe UTCTime, ConnectRestriction)
 -> Const Any (Int, Maybe UTCTime, ConnectRestriction))
-> PingStatus -> Const Any PingStatus
Prism' PingStatus (Int, Maybe UTCTime, ConnectRestriction)
_PingConnecting) NetworkState
cs
        isJoined :: Bool
isJoined   = Getting Any NetworkState ChannelState -> NetworkState -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> NetworkState -> Const Any NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const Any (HashMap Identifier ChannelState))
 -> NetworkState -> Const Any NetworkState)
-> ((ChannelState -> Const Any ChannelState)
    -> HashMap Identifier ChannelState
    -> Const Any (HashMap Identifier ChannelState))
-> Getting Any NetworkState ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
chan ((ChannelState -> Const Any ChannelState)
 -> HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> ((ChannelState -> Const Any ChannelState)
    -> ChannelState -> Const Any ChannelState)
-> (ChannelState -> Const Any ChannelState)
-> HashMap Identifier ChannelState
-> Const Any (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) ChannelState Bool
-> (ChannelState -> Const Any ChannelState)
-> ChannelState
-> Const Any ChannelState
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Applicative f) =>
Getting (First i) a i -> p a (f a) -> a -> f a
filteredBy Getting (First Bool) ChannelState Bool
Lens' ChannelState Bool
chanJoined) NetworkState
cs
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
connecting Bool -> Bool -> Bool
|| Bool
isJoined)
      (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
chan []) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> Text -> RawIrcMsg
ircTopic Identifier
chan Text
""))
    ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
subfocus ClientState
st)
  where subfocus :: Subfocus
subfocus = Text -> Identifier -> Subfocus
FocusInfo (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
chan

cmdKnock :: NetworkCommand (String, String)
cmdKnock :: NetworkCommand ([Char], [Char])
cmdKnock NetworkState
cs ClientState
st ([Char]
chan,[Char]
message) =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Text -> RawIrcMsg
ircKnock ([Char] -> Text
Text.pack [Char]
chan) ([Char] -> Text
Text.pack [Char]
message))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdJoin :: NetworkCommand (String, Maybe String)
cmdJoin :: NetworkCommand ([Char], Maybe [Char])
cmdJoin NetworkState
cs ClientState
st ([Char]
channelsStr, Maybe [Char]
mbKeys) =
 do let network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
    let channelId :: Identifier
channelId = Text -> Identifier
mkId ([Char] -> Text
Text.pack ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
',' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Char]
channelsStr))
    let channels :: [Text]
channels = (Char -> Bool) -> Text -> [Text]
Text.split (Char
',' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Char] -> Text
Text.pack [Char]
channelsStr)
    let keys :: [Text]
keys = [Text] -> ([Char] -> [Text]) -> Maybe [Char] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Char -> Bool) -> Text -> [Text]
Text.split (Char
',' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack) Maybe [Char]
mbKeys
    (RawIrcMsg -> IO ()) -> [RawIrcMsg] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) ([Text] -> [Text] -> [RawIrcMsg]
chunkJoins [Text]
channels [Text]
keys)
    ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Focus -> ClientState -> ClientState
changeFocus (Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
channelId) ClientState
st)

chunkJoins :: [Text] -> [Text] -> [RawIrcMsg]
chunkJoins :: [Text] -> [Text] -> [RawIrcMsg]
chunkJoins [Text]
cs0 [Text]
ks0 =
  case ([Text]
cs0, [Text]
ks0) of
    (Text
c:[Text]
cs, Text
k:[Text]
ks) -> Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go (Text -> Int
cost Text
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
cost Text
k) [Text
c] [Text
k] [Text]
cs [Text]
ks
    (Text
c:[Text]
cs, []) -> Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go (Text -> Int
cost Text
c) [Text
c] [] [Text]
cs []
    ([Text], [Text])
_ -> []
  where
    limit :: Int
limit = Int
500 -- "JOIN__:\r\n"
    cost :: Text -> Int
cost Text
x = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length (Text -> ByteString
Text.encodeUtf8 Text
x)

    finishChannels :: [Text] -> Text
finishChannels = Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
    finishKeys :: [Text] -> Maybe Text
finishKeys [] = Maybe Text
forall a. Maybe a
Nothing
    finishKeys [Text]
ks = Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text
finishChannels [Text]
ks)

    go :: Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go Int
n [Text]
acc1 [Text]
acc2 (Text
c:[Text]
cs) []
      | Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit = Text -> Maybe Text -> RawIrcMsg
ircJoin ([Text] -> Text
finishChannels [Text]
acc1) ([Text] -> Maybe Text
finishKeys [Text]
acc2) RawIrcMsg -> [RawIrcMsg] -> [RawIrcMsg]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go Int
x [Text
c] [] [Text]
cs []
      | Bool
otherwise = Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc1) [Text]
acc2 [Text]
cs []
      where
        x :: Int
x = Text -> Int
cost Text
c

    go Int
n [Text]
acc1 [Text]
acc2 (Text
c:[Text]
cs) (Text
k:[Text]
ks)
      | Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit = Text -> Maybe Text -> RawIrcMsg
ircJoin ([Text] -> Text
finishChannels [Text]
acc1) ([Text] -> Maybe Text
finishKeys [Text]
acc2) RawIrcMsg -> [RawIrcMsg] -> [RawIrcMsg]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go Int
x [Text
c] [Text
k] [Text]
cs [Text]
ks
      | Bool
otherwise = Int -> [Text] -> [Text] -> [Text] -> [Text] -> [RawIrcMsg]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc1) (Text
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc2) [Text]
cs [Text]
ks
      where
        x :: Int
x = Text -> Int
cost Text
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
cost Text
k

    go Int
_ [Text]
acc1 [Text]
acc2 [] [Text]
_ = [Text -> Maybe Text -> RawIrcMsg
ircJoin ([Text] -> Text
finishChannels [Text]
acc1) ([Text] -> Maybe Text
finishKeys [Text]
acc2)]

-- | @/query@ command. Takes a channel or nickname and switches
-- focus to that target on the current network.
cmdQuery :: ClientCommand (String, String)
cmdQuery :: ClientCommand ([Char], [Char])
cmdQuery ClientState
st ([Char]
target, [Char]
msg) =
  case Maybe Text -> [Char] -> Maybe Focus
parseFocus (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) [Char]
target of
    Just (ChannelFocus Text
net Identifier
tgt)

      | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
msg -> ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess 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
net) ClientState
st ->
           do let tgtTxt :: Text
tgtTxt = Identifier -> Text
idText Identifier
tgt
                  msgTxt :: Text
msgTxt = [Char] -> Text
Text.pack [Char]
msg
              RawIrcMsg
-> (Source -> Identifier -> IrcMsg)
-> Text
-> NetworkState
-> ClientState
-> IO CommandResult
chatCommand
                (Text -> Text -> RawIrcMsg
ircPrivmsg Text
tgtTxt Text
msgTxt)
                (\Source
src Identifier
tgt1 -> Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
tgt1 Text
msgTxt)
                Text
tgtTxt NetworkState
cs ClientState
st'
      where
       firstTgt :: Identifier
firstTgt = Text -> Identifier
mkId ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char
','Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Identifier -> Text
idText Identifier
tgt))
       st' :: ClientState
st' = Focus -> ClientState -> ClientState
changeFocus (Text -> Identifier -> Focus
ChannelFocus Text
net Identifier
firstTgt) ClientState
st

    Maybe Focus
_ -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"Bad target" ClientState
st

-- | Implementation of @/ctcp@
cmdCtcp :: NetworkCommand (String, String, String)
cmdCtcp :: NetworkCommand ([Char], [Char], [Char])
cmdCtcp NetworkState
cs ClientState
st ([Char]
target, [Char]
cmd, [Char]
args) =
 do let cmdTxt :: Text
cmdTxt = Text -> Text
Text.toUpper ([Char] -> Text
Text.pack [Char]
cmd)
        argTxt :: Text
argTxt = [Char] -> Text
Text.pack [Char]
args
        tgtTxt :: Text
tgtTxt = [Char] -> Text
Text.pack [Char]
target

    let msg :: Text
msg = Text
"\^A" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmdTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              (if Text -> Bool
Text.null Text
argTxt then Text
"" else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argTxt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Text
"\^A"
    RawIrcMsg
-> (Source -> Identifier -> IrcMsg)
-> Text
-> NetworkState
-> ClientState
-> IO CommandResult
chatCommand
      (Text -> Text -> RawIrcMsg
ircPrivmsg Text
tgtTxt Text
msg)
      (\Source
src Identifier
tgt -> Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp Source
src Identifier
tgt Text
cmdTxt Text
argTxt)
      Text
tgtTxt NetworkState
cs ClientState
st

-- | Implementation of @/wallops@
cmdWallops :: NetworkCommand String
cmdWallops :: NetworkCommand [Char]
cmdWallops NetworkState
cs ClientState
st [Char]
rest
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
      do let restTxt :: Text
restTxt = [Char] -> Text
Text.pack [Char]
rest
         NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircWallops Text
restTxt)
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

-- | Implementation of @/operwall@
cmdOperwall :: NetworkCommand String
cmdOperwall :: NetworkCommand [Char]
cmdOperwall NetworkState
cs ClientState
st [Char]
rest
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
      do let restTxt :: Text
restTxt = [Char] -> Text
Text.pack [Char]
rest
         NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircOperwall Text
restTxt)
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

-- | Implementation of @/notice@
cmdNotice :: NetworkCommand (String, String)
cmdNotice :: NetworkCommand ([Char], [Char])
cmdNotice NetworkState
cs ClientState
st ([Char]
target, [Char]
rest)
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
     do let restTxt :: Text
restTxt = [Char] -> Text
Text.pack [Char]
rest
            tgtTxt :: Text
tgtTxt = [Char] -> Text
Text.pack [Char]
target
        RawIrcMsg
-> (Source -> Identifier -> IrcMsg)
-> Text
-> NetworkState
-> ClientState
-> IO CommandResult
chatCommand
          (Text -> Text -> RawIrcMsg
ircNotice Text
tgtTxt Text
restTxt)
          (\Source
src Identifier
tgt -> Source -> Identifier -> Text -> IrcMsg
Notice Source
src Identifier
tgt Text
restTxt)
          Text
tgtTxt NetworkState
cs ClientState
st

-- | Implementation of @/msg@
cmdMsg :: NetworkCommand (String, String)
cmdMsg :: NetworkCommand ([Char], [Char])
cmdMsg NetworkState
cs ClientState
st ([Char]
target, [Char]
rest)
  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
     do let restTxt :: Text
restTxt = [Char] -> Text
Text.pack [Char]
rest
            tgtTxt :: Text
tgtTxt = [Char] -> Text
Text.pack [Char]
target
        RawIrcMsg
-> (Source -> Identifier -> IrcMsg)
-> Text
-> NetworkState
-> ClientState
-> IO CommandResult
chatCommand
          (Text -> Text -> RawIrcMsg
ircPrivmsg Text
tgtTxt Text
restTxt)
          (\Source
src Identifier
tgt -> Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
tgt Text
restTxt)
          Text
tgtTxt NetworkState
cs ClientState
st



-- | Common logic for @/msg@ and @/notice@
chatCommand ::
  RawIrcMsg {- ^ irc command -} ->
  (Source -> Identifier -> IrcMsg) ->
  Text {- ^ targets -} ->
  NetworkState         ->
  ClientState          ->
  IO CommandResult
chatCommand :: RawIrcMsg
-> (Source -> Identifier -> IrcMsg)
-> Text
-> NetworkState
-> ClientState
-> IO CommandResult
chatCommand RawIrcMsg
ircMsg Source -> Identifier -> IrcMsg
mkmsg Text
tgtsTxt NetworkState
cs ClientState
st
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
Text.null [Text]
tgtTxts = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty target" ClientState
st
  | Bool
otherwise =
   do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
ircMsg
      ClientState
st' <- (Source -> Identifier -> IrcMsg)
-> [Text] -> NetworkState -> ClientState -> IO ClientState
chatCommand' Source -> Identifier -> IrcMsg
mkmsg [Text]
tgtTxts NetworkState
cs ClientState
st
      ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
  where
    tgtTxts :: [Text]
tgtTxts = (Char -> Bool) -> Text -> [Text]
Text.split (Char
','Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
tgtsTxt

-- | Common logic for @/msg@ and @/notice@ returning the client state
chatCommand' ::
  (Source -> Identifier -> IrcMsg) ->
  [Text] {- ^ targets  -} ->
  NetworkState         ->
  ClientState          ->
  IO ClientState
chatCommand' :: (Source -> Identifier -> IrcMsg)
-> [Text] -> NetworkState -> ClientState -> IO ClientState
chatCommand' Source -> Identifier -> IrcMsg
con [Text]
targetTxts NetworkState
cs ClientState
st =
  do ZonedTime
now <- IO ZonedTime
getZonedTime
     let targetIds :: [Identifier]
targetIds = Text -> Identifier
mkId (Text -> Identifier) -> [Text] -> [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
targetTxts
         !myNick :: Source
myNick = UserInfo -> Text -> Source
Source (Getting UserInfo NetworkState UserInfo -> NetworkState -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo NetworkState UserInfo
Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
""
         network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
         entries :: [(Identifier, ClientMessage)]
entries = [ (Identifier
targetId,
                          ClientMessage
                          { _msgTime :: ZonedTime
_msgTime = ZonedTime
now
                          , _msgNetwork :: Text
_msgNetwork = Text
network
                          , _msgBody :: MessageBody
_msgBody = IrcMsg -> MessageBody
IrcBody (Source -> Identifier -> IrcMsg
con Source
myNick Identifier
targetId)
                          })
                       | Identifier
targetId <- [Identifier]
targetIds ]

     ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! (ClientState -> (Identifier, ClientMessage) -> ClientState)
-> ClientState -> [(Identifier, ClientMessage)] -> ClientState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ClientState
acc (Identifier
targetId, ClientMessage
entry) ->
                        Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage Text
network Identifier
targetId ClientMessage
entry ClientState
acc)
                      ClientState
st
                      [(Identifier, ClientMessage)]
entries

-- | Implementation of @/quote@. Parses arguments as a raw IRC command and
-- sends to the current network.
cmdQuote :: NetworkCommand String
cmdQuote :: NetworkCommand [Char]
cmdQuote NetworkState
cs ClientState
st [Char]
rest =
  case Text -> Maybe RawIrcMsg
parseRawIrcMsg ([Char] -> Text
Text.pack ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) [Char]
rest)) of
    Maybe RawIrcMsg
Nothing  -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"failed to parse raw IRC command" ClientState
st
    Just RawIrcMsg
raw ->
      do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
raw
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdAway :: NetworkCommand String
cmdAway :: NetworkCommand [Char]
cmdAway NetworkState
cs ClientState
st [Char]
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircAway ([Char] -> Text
Text.pack [Char]
rest))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdNick :: NetworkCommand String
cmdNick :: NetworkCommand [Char]
cmdNick NetworkState
cs ClientState
st [Char]
nick =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircNick ([Char] -> Text
Text.pack [Char]
nick))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdPart :: ChannelCommand String
cmdPart :: ChannelCommand [Char]
cmdPart Identifier
channelId NetworkState
cs ClientState
st [Char]
rest =
  do let msg :: [Char]
msg = [Char]
rest
     NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> Text -> RawIrcMsg
ircPart Identifier
channelId ([Char] -> Text
Text.pack [Char]
msg))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

-- | This command is equivalent to chatting without a command. The primary use
-- at the moment is to be able to send a leading @/@ to chat easily.
cmdSay :: ChannelCommand String
cmdSay :: ChannelCommand [Char]
cmdSay Identifier
focus NetworkState
cs ClientState
st [Char]
rest = Focus -> [Char] -> ClientState -> IO CommandResult
executeChat (Text -> Identifier -> Focus
ChannelFocus (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) Identifier
focus) [Char]
rest ClientState
st

-- | Implementation of @/me@
cmdMe :: ChannelCommand String
cmdMe :: ChannelCommand [Char]
cmdMe Identifier
channelId NetworkState
cs ClientState
st [Char]
rest =
  do ZonedTime
now <- IO ZonedTime
getZonedTime
     let actionTxt :: Text
actionTxt = [Char] -> Text
Text.pack ([Char]
"\^AACTION " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\^A")
         !myNick :: Source
myNick = UserInfo -> Text -> Source
Source (Getting UserInfo NetworkState UserInfo -> NetworkState -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo NetworkState UserInfo
Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
""
         network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
         entry :: ClientMessage
entry = ClientMessage
                    { _msgTime :: ZonedTime
_msgTime = ZonedTime
now
                    , _msgNetwork :: Text
_msgNetwork = Text
network
                    , _msgBody :: MessageBody
_msgBody = IrcMsg -> MessageBody
IrcBody (Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp Source
myNick Identifier
channelId Text
"ACTION" ([Char] -> Text
Text.pack [Char]
rest))
                    }
     NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Text -> RawIrcMsg
ircPrivmsg (Identifier -> Text
idText Identifier
channelId) Text
actionTxt)
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
       (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$! Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage Text
network Identifier
channelId ClientMessage
entry ClientState
st

-- | Treat the current text input as a chat message and send it.
executeChat ::
  Focus                                   ->
  String           {- ^ chat message   -} ->
  ClientState      {- ^ client state   -} ->
  IO CommandResult {- ^ command result -}
executeChat :: Focus -> [Char] -> ClientState -> IO CommandResult
executeChat Focus
focus [Char]
msg ClientState
st =
  case Focus
focus of
    ChannelFocus Text
network Identifier
channel
      | 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 ->
          do ZonedTime
now <- IO ZonedTime
getZonedTime
             let msgTxt :: Text
msgTxt = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') [Char]
msg
                 tgtTxt :: Text
tgtTxt = Identifier -> Text
idText Identifier
channel

             (ClientState
st1,Bool
allow) <- Text -> Text -> Text -> ClientState -> IO (ClientState, Bool)
clientChatExtension Text
network Text
tgtTxt Text
msgTxt ClientState
st

             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
allow (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Text -> RawIrcMsg
ircPrivmsg Text
tgtTxt Text
msgTxt))

             let myNick :: Source
myNick = UserInfo -> Text -> Source
Source (Getting UserInfo NetworkState UserInfo -> NetworkState -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo NetworkState UserInfo
Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
""
                 entry :: ClientMessage
entry = ClientMessage
                   { _msgTime :: ZonedTime
_msgTime    = ZonedTime
now
                   , _msgNetwork :: Text
_msgNetwork = Text
network
                   , _msgBody :: MessageBody
_msgBody    = IrcMsg -> MessageBody
IrcBody (Source -> Identifier -> Text -> IrcMsg
Privmsg Source
myNick Identifier
channel Text
msgTxt) }
             ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$! Text -> Identifier -> ClientMessage -> ClientState -> ClientState
recordChannelMessage Text
network Identifier
channel ClientMessage
entry ClientState
st1

    Focus
_ -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"cannot send chat messages to this window" ClientState
st