{-# Language BangPatterns, OverloadedStrings #-}
{-|
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.Extensions (clientChatExtension)
import           Client.State.Focus
import           Client.State.Network
import           Control.Applicative
import           Control.Lens
import           Control.Monad (when)
import           Data.Char (toUpper)
import           Data.Foldable
import           Data.List.NonEmpty (NonEmpty((:|)))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time
import           Irc.Commands
import           Irc.Identifier
import           Irc.Message
import           Irc.RawIrcMsg

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

  [ NonEmpty Text
-> Args ClientState (String, Maybe String)
-> Text
-> CommandImpl (String, Maybe String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text
"join" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"j"])
      ((String -> Maybe String -> (String, Maybe String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) (Maybe String)
-> Args ClientState (String, Maybe String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"channels") (Ap (Arg ClientState) String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"[keys]")))
      Text
"\^BParameters:\^B\n\
      \\n\
      \    channels: Comma-separated list of channels\n\
      \    keys:     Comma-separated list of keys\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Join the given channels. When keys are provided, they should\n\
      \    occur in the same order as the channels.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /join #friends\n\
      \    /join #secret thekey\n\
      \    /join #secret1,#secret2 key1,key2\n\
      \\n\
      \\^BSee also:\^B channel, clear, part\n"
    (CommandImpl (String, Maybe String) -> Command)
-> CommandImpl (String, Maybe String) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (String, Maybe String)
-> (Bool -> NetworkCommand String)
-> CommandImpl (String, Maybe String)
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (String, Maybe String)
cmdJoin Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"part")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"reason")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    reason: Optional message sent to channel as part reason\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Part from the current channel.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /part\n\
      \    /part It's not me, it's you\n\
      \\n\
      \\^BSee also:\^B clear, join, quit\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand String
-> (Bool -> ChannelCommand String) -> CommandImpl String
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand String) -> CommandImpl a
ChannelCommand ChannelCommand String
cmdPart Bool -> ChannelCommand String
simpleChannelTab

  , NonEmpty Text
-> Args ClientState (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"msg")
      ((String -> String -> (String, String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Args ClientState (String, String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"target") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message"))
      Text
"\^BParameters:\^B\n\
      \\n\
      \    target:  Comma-separated list of nicknames and channels\n\
      \    message: Formatted message body\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Send a chat message to a user or a channel. On servers\n\
      \    with STATUSMSG support, the channel name can be prefixed\n\
      \    with a sigil to restrict the recipients to those with the\n\
      \    given mode.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /msg buddy I'm sending you a message.\n\
      \    /msg #friends This message is for the whole channel.\n\
      \    /msg him,her I'm chatting with two people.\n\
      \    /msg @#users This message is only for ops!\n\
      \\n\
      \\^BSee also:\^B notice, me, say\n"
    (CommandImpl (String, String) -> Command)
-> CommandImpl (String, String) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (String, String)
-> (Bool -> NetworkCommand String) -> CommandImpl (String, String)
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (String, String)
cmdMsg Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"me")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    message: Body of action message\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Sends an action message to the currently focused channel.\n\
      \    Most clients will render these messages prefixed with\n\
      \    only your nickname as though describing an action.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /me shrugs\n\
      \\n\
      \\^BSee also:\^B notice, msg, say\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand String
-> (Bool -> ChannelCommand String) -> CommandImpl String
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand String) -> CommandImpl a
ChatCommand ChannelCommand String
cmdMe Bool -> ChannelCommand String
simpleChannelTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"say")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    message: Body of message\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Send a message to the current chat window.  This can be useful\n\
      \    for sending a chat message with a leading '/' to the current\n\
      \    chat window.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /say /help is the right place to start!\n\
      \\n\
      \\^BSee also:\^B notice, me, msg\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand String
-> (Bool -> ChannelCommand String) -> CommandImpl String
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand String) -> CommandImpl a
ChatCommand ChannelCommand String
cmdSay Bool -> ChannelCommand String
simpleChannelTab

  , NonEmpty Text
-> Args ClientState (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text
"query" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text
"q"])
      ((String -> String -> (String, String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Args ClientState (String, String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"target") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message"))
      Text
"\^BParameters:\^B\n\
      \\n\
      \    target: Focus name\n\
      \    message: Optional message\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    This command switches the client focus to the given\n\
      \    target and optionally sends a message to that target.\n\
      \\n\
      \    Channel: \^_#channel\^_\n\
      \    Channel: \^_network\^_:\^_#channel\^_\n\
      \    User:    \^_nick\^_\n\
      \    User:    \^_network\^_:\^_nick\^_\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /q fn:#haskell\n\
      \    /q #haskell\n\
      \    /q lambdabot @messages\n\
      \    /q irc_friend How are you?\n\
      \\n\
      \\^BSee also:\^B msg channel focus\n"
    (CommandImpl (String, String) -> Command)
-> CommandImpl (String, String) -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand (String, String)
-> (Bool -> ClientCommand String) -> CommandImpl (String, String)
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand (String, String)
cmdQuery Bool -> ClientCommand String
simpleClientTab

  , NonEmpty Text
-> Args ClientState (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"notice")
      ((String -> String -> (String, String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Args ClientState (String, String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"target") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message"))
      Text
"\^BParameters:\^B\n\
      \\n\
      \    target:  Comma-separated list of nicknames and channels\n\
      \    message: Formatted message body\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Send a chat notice to a user or a channel. On servers\n\
      \    with STATUSMSG support, the channel name can be prefixed\n\
      \    with a sigil to restrict the recipients to those with the\n\
      \    given mode. Notice messages were originally intended to be\n\
      \    used by bots. Different clients will render these in different\n\
      \    ways.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /notice buddy I'm sending you a message.\n\
      \    /notice #friends This message is for the whole channel.\n\
      \    /notice him,her I'm chatting with two people.\n\
      \    /notice @#users This message is only for ops!\n\
      \\n\
      \\^BSee also:\^B me, msg, say\n"
    (CommandImpl (String, String) -> Command)
-> CommandImpl (String, String) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (String, String)
-> (Bool -> NetworkCommand String) -> CommandImpl (String, String)
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (String, String)
cmdNotice Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"wallops")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message to +w users")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    message: Formatted message body\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Send a network-wide WALLOPS message. These message go out\n\
      \    to users who have the 'w' usermode set.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /wallops Hi everyone, thanks for using this network!\n\
      \\n\
      \\^BSee also:\^B me, msg, say\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdWallops Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"operwall")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message to +z opers")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    message: Formatted message body\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Send a network-wide WALLOPS message to opers. These message go\n\
      \    out to opers who have the 'z' usermode set.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /operwall What's this even for?\n\
      \\n\
      \\^BSee also:\^B me, msg, say\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdOperwall Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Args ClientState (String, String, String)
-> Text
-> CommandImpl (String, String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"ctcp")
      ((String -> String -> String -> (String, String, String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Args ClientState (String, String, String)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"target") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"command") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"arguments"))
      Text
"\^BParameters:\^B\n\
      \\n\
      \    target:    Comma-separated list of nicknames and channels\n\
      \    command:   CTCP command name\n\
      \    arguments: CTCP command arguments\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Client-to-client protocol (CTCP) commands can be used\n\
      \    to query information from another user's client application\n\
      \    directly. Common CTCP commands include: ACTION, PING, VERSION,\n\
      \    USERINFO, CLIENTINFO, and TIME. glirc does not automatically\n\
      \    respond to CTCP commands.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /ctcp myfriend VERSION\n\
      \    /ctcp myfriend CLIENTINFO\n"
    (CommandImpl (String, String, String) -> Command)
-> CommandImpl (String, String, String) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (String, String, String)
-> (Bool -> NetworkCommand String)
-> CommandImpl (String, String, String)
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (String, String, String)
cmdCtcp Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"nick")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"nick")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    nick: New nickname\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Change your nickname on the currently focused server.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /nick guest123\n\
      \    /nick better_nick\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdNick Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"away")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message")
      Text
"\^BParameters:\^B\n\
      \\n\
      \    message: Optional away message\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Change your nickname on the currently focused server.\n\
      \    Omit the message parameter to clear your away status.\n\
      \    The away message is only used by the server to update\n\
      \    status in /whois and to provide automated responses.\n\
      \    It is not used by this client directly.\n\
      \\n\
      \\^BExamples:\^B\n\
      \\n\
      \    /away\n\
      \    /away Out getting some sun\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdAway Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"names")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"\^BDescription:\^B\n\
      \\n\
      \    Show the user list for the current channel.\n\
      \    Detailed view (default key F2) shows full hostmask.\n\
      \    Hostmasks can be populated with /who #channel.\n\
      \    Press ESC to exit the userlist.\n\
      \\n\
      \\^BSee also:\^B channelinfo, masks\n"
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand ()
-> (Bool -> ChannelCommand String) -> CommandImpl ()
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand String) -> CommandImpl a
ChannelCommand ChannelCommand ()
cmdChanNames Bool -> ChannelCommand String
noChannelTab

  , NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"channelinfo")
      (() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Text
"\^BDescription:\^B\n\
      \\n\
      \    Show information about the current channel.\n\
      \    Press ESC to exit the channel info window.\n\
      \\n\
      \    Information includes topic, creation time, URL, and modes.\n\
      \\n\
      \\^BSee also:\^B masks, mode, topic, users\n"
    (CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ChannelCommand ()
-> (Bool -> ChannelCommand String) -> CommandImpl ()
forall a.
ChannelCommand a
-> (Bool -> ChannelCommand String) -> CommandImpl a
ChannelCommand ChannelCommand ()
cmdChannelInfo Bool -> ChannelCommand String
noChannelTab

  , NonEmpty Text
-> Args ClientState (String, String)
-> Text
-> CommandImpl (String, String)
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"knock")
      ((String -> String -> (String, String))
-> Ap (Arg ClientState) String
-> Ap (Arg ClientState) String
-> Args ClientState (String, String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
simpleToken String
"channel") (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"message"))
      Text
"Request entry to an invite-only channel.\n"
    (CommandImpl (String, String) -> Command)
-> CommandImpl (String, String) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (String, String)
-> (Bool -> NetworkCommand String) -> CommandImpl (String, String)
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (String, String)
cmdKnock Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Ap (Arg ClientState) String
-> Text
-> CommandImpl String
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"quote")
      (String -> Ap (Arg ClientState) String
forall r. String -> Args r String
remainingArg String
"raw IRC command")
      Text
"Send a raw IRC command.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdQuote Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Args ClientState [String]
-> Text
-> CommandImpl [String]
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"monitor")
      (String
-> (ClientState -> String -> Maybe (Args ClientState [String]))
-> Args ClientState [String]
forall r a. String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
"[+-CLS]" ClientState -> String -> Maybe (Args ClientState [String])
monitorArgs)
      Text
"\^BSubcommands:\^B\n\
      \\n\
      \    /monitor + target[,target2]* - Add nicknames to monitor list\n\
      \    /monitor - target[,target2]* - Remove nicknames to monitor list\n\
      \    /monitor C                   - Clear monitor list\n\
      \    /monitor L                   - Show monitor list\n\
      \    /monitor S                   - Show status of nicknames on monitor list\n\
      \\n\
      \\^BDescription:\^B\n\
      \\n\
      \    Monitor is a protocol for getting server-side notifications\n\
      \    when users become online/offline.\n"
    (CommandImpl [String] -> Command)
-> CommandImpl [String] -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand [String]
-> (Bool -> NetworkCommand String) -> CommandImpl [String]
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand [String]
cmdMonitor Bool -> NetworkCommand String
simpleNetworkTab

    ]

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

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

cmdChanNames :: ChannelCommand ()
cmdChanNames :: ChannelCommand ()
cmdChanNames Identifier
_ NetworkState
_ ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusUsers ClientState
st)

cmdChannelInfo :: ChannelCommand ()
cmdChannelInfo :: ChannelCommand ()
cmdChannelInfo Identifier
_ NetworkState
_ ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusInfo ClientState
st)

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

cmdJoin :: NetworkCommand (String, Maybe String)
cmdJoin :: NetworkCommand (String, Maybe String)
cmdJoin NetworkState
cs ClientState
st (String
channels, Maybe String
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 (String -> Text
Text.pack ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') String
channels))
     NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Maybe Text -> RawIrcMsg
ircJoin (String -> Text
Text.pack String
channels) (String -> Text
Text.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mbKeys))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
        (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Focus -> ClientState -> ClientState
changeFocus (Text -> Identifier -> Focus
ChannelFocus Text
network Identifier
channelId) ClientState
st

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

      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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 = String -> Text
Text.pack String
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 (String, String, String)
cmdCtcp NetworkState
cs ClientState
st (String
target, String
cmd, String
args) =
 do let cmdTxt :: Text
cmdTxt = Text -> Text
Text.toUpper (String -> Text
Text.pack String
cmd)
        argTxt :: Text
argTxt = String -> Text
Text.pack String
args
        tgtTxt :: Text
tgtTxt = String -> Text
Text.pack String
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 String
cmdWallops NetworkState
cs ClientState
st String
rest
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
      do let restTxt :: Text
restTxt = String -> Text
Text.pack String
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 String
cmdOperwall NetworkState
cs ClientState
st String
rest
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
      do let restTxt :: Text
restTxt = String -> Text
Text.pack String
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 (String, String)
cmdNotice NetworkState
cs ClientState
st (String
target, String
rest)
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
     do let restTxt :: Text
restTxt = String -> Text
Text.pack String
rest
            tgtTxt :: Text
tgtTxt = String -> Text
Text.pack String
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 (String, String)
cmdMsg NetworkState
cs ClientState
st (String
target, String
rest)
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"empty message" ClientState
st
  | Bool
otherwise =
     do let restTxt :: Text
restTxt = String -> Text
Text.pack String
rest
            tgtTxt :: Text
tgtTxt = String -> Text
Text.pack String
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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
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 (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 (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 String
cmdQuote NetworkState
cs ClientState
st String
rest =
  case Text -> Maybe RawIrcMsg
parseRawIrcMsg (String -> Text
Text.pack ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
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 String
cmdAway NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircAway (String -> Text
Text.pack String
rest))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

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

cmdPart :: ChannelCommand String
cmdPart :: ChannelCommand String
cmdPart Identifier
channelId NetworkState
cs ClientState
st String
rest =
  do let msg :: String
msg = String
rest
     NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> Text -> RawIrcMsg
ircPart Identifier
channelId (String -> Text
Text.pack String
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 String
cmdSay Identifier
_ NetworkState
_ ClientState
st String
rest = String -> ClientState -> IO CommandResult
executeChat String
rest ClientState
st

-- | Implementation of @/me@
cmdMe :: ChannelCommand String
cmdMe :: ChannelCommand String
cmdMe Identifier
channelId NetworkState
cs ClientState
st String
rest =
  do ZonedTime
now <- IO ZonedTime
getZonedTime
     let actionTxt :: Text
actionTxt = String -> Text
Text.pack (String
"\^AACTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\^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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
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" (String -> Text
Text.pack String
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 ::
  String           {- ^ chat message   -} ->
  ClientState      {- ^ client state   -} ->
  IO CommandResult {- ^ command result -}
executeChat :: String -> ClientState -> IO CommandResult
executeChat String
msg ClientState
st =
  case Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st of
    ChannelFocus Text
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 = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') String
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 :: Text -> MessageBody -> ZonedTime -> ClientMessage
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