{-# Language BangPatterns, 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.Extensions (clientChatExtension)
import Client.State.Focus (focusNetwork, Focus(ChannelFocus), Subfocus(FocusInfo, FocusUsers))
import Client.State.Network (csNetwork, csUserInfo, sendMsg, NetworkState)
import Control.Applicative (liftA2, liftA3)
import Control.Lens (view, preview, views)
import Control.Monad (when)
import Data.Char (toUpper)
import Data.Foldable (foldl')
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Text (Text)
import Data.Text 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"
  ------------------------------------------------------------------------

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"quote")
      (forall r. [Char] -> Args r [Char]
remainingArg [Char]
"raw IRC command")
      $(chatDocs `cmdDoc` "quote")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand [Char]) -> CommandImpl a
NetworkCommand NetworkCommand [Char]
cmdQuote Bool -> NetworkCommand [Char]
simpleNetworkTab

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

  ]

monitorArgs :: ClientState -> String -> Maybe (Args ClientState [String])
monitorArgs :: ClientState -> [Char] -> Maybe (Args ClientState [[Char]])
monitorArgs ClientState
_ [Char]
str =
  case Char -> Char
toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
str of
    [Char]
"+" -> forall a. a -> Maybe a
Just (forall {f :: * -> *} {a}. Functor f => a -> f [a] -> f [[a]]
wrap Char
'+' (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target[,target2]*"))
    [Char]
"-" -> forall a. a -> Maybe a
Just (forall {f :: * -> *} {a}. Functor f => a -> f [a] -> f [[a]]
wrap Char
'-' (forall r. [Char] -> Args r [Char]
simpleToken [Char]
"target[,target2]*"))
    [Char]
"C" -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"C"])
    [Char]
"L" -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"L"])
    [Char]
"S" -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]
"S"])
    [Char]
_   -> forall a. Maybe a
Nothing
  where
    wrap :: a -> f [a] -> f [[a]]
wrap a
c = 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
Text.pack [[Char]]
args))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdChanNames :: ChannelCommand ()
cmdChanNames :: ChannelCommand ()
cmdChanNames Identifier
_ NetworkState
_ ClientState
st ()
_ = 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 ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusInfo ClientState
st)

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))
     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]
channels, Maybe [Char]
mbKeys) =
  do let network :: Text
network = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs
     let channelId :: Identifier
channelId = Text -> Identifier
mkId ([Char] -> Text
Text.pack (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
',') [Char]
channels))
     NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> Maybe Text -> RawIrcMsg
ircJoin ([Char] -> Text
Text.pack [Char]
channels) ([Char] -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
mbKeys))
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
        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 ([Char], [Char])
cmdQuery ClientState
st ([Char]
target, [Char]
msg) =
  case Maybe Text -> [Char] -> Maybe Focus
parseFocus (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st) [Char]
target of
    Just (ChannelFocus Text
net Identifier
tgt)

      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
msg -> forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'

      | Just NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
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
','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" forall a. Semigroup a => a -> a -> a
<> Text
cmdTxt forall a. Semigroup a => a -> a -> a
<>
              (if Text -> Bool
Text.null Text
argTxt then Text
"" else Text
" " forall a. Semigroup a => a -> a -> a
<> Text
argTxt) 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
  | 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)
         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
  | 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)
         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)
  | 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)
  | 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
  | 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
      forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
  where
    tgtTxts :: [Text]
tgtTxts = (Char -> Bool) -> Text -> [Text]
Text.split (Char
','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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
targetTxts
         !myNick :: Source
myNick = UserInfo -> Text -> Source
Source (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
""
         network :: Text
network = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 ]

     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> 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 (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' '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
         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))
     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))
     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))
     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
_ NetworkState
_ ClientState
st [Char]
rest = [Char] -> ClientState -> IO CommandResult
executeChat [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 " forall a. [a] -> [a] -> [a]
++ [Char]
rest forall a. [a] -> [a] -> [a]
++ [Char]
"\^A")
         !myNick :: Source
myNick = UserInfo -> Text -> Source
Source (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
""
         network :: Text
network = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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)
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
       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 :: [Char] -> ClientState -> IO CommandResult
executeChat [Char]
msg ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st of
    ChannelFocus Text
network Identifier
channel
      | Just !NetworkState
cs <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) ClientState
st ->
          do ZonedTime
now <- IO ZonedTime
getZonedTime
             let msgTxt :: Text
msgTxt = [Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (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

             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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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) }
             forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess 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