-- |
-- Module      : Network.IRC.Client.Utils
-- Copyright   : (c) 2016 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : experimental
-- Portability : portable
--
-- Commonly-used utility functions for IRC clients.
module Network.IRC.Client.Utils
  ( -- * Nicks
    setNick

    -- * Channels
  , leaveChannel
  , delChan

    -- * Events
  , addHandler
  , reply
  , replyTo

    -- * CTCPs
  , ctcp
  , ctcpReply

    -- * Connection state
  , isConnected
  , isDisconnecting
  , isDisconnected
  , snapConnState

    -- * Concurrency
  , fork

    -- * Lenses
  , snapshot
  , snapshotModify
  , get
  , set
  , modify
  ) where

import           Control.Concurrent          (ThreadId, forkFinally, myThreadId)
import           Control.Concurrent.STM      (STM, TVar, atomically, modifyTVar)
import           Control.Monad.IO.Class      (liftIO)
import qualified Data.Set                    as S
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import           Network.IRC.Conduit         (Event(..), Message(..),
                                              Source(..))
import           Network.IRC.CTCP            (toCTCP)

import           Network.IRC.Client.Internal
import           Network.IRC.Client.Lens

-------------------------------------------------------------------------------
-- Nicks

-- | Update the nick in the instance configuration and also send an
-- update message to the server. This doesn't attempt to resolve nick
-- collisions, that's up to the event handlers.
setNick :: Text -> IRC s ()
setNick :: forall s. Text -> IRC s ()
setNick Text
new = do
  TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
    forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (forall s a. Lens' s a -> a -> s -> s
set forall s. Lens' (InstanceConfig s) Text
nick Text
new)
  forall s. Message Text -> IRC s ()
send forall a b. (a -> b) -> a -> b
$ forall a. NickName a -> Message (NickName a)
Nick Text
new


-------------------------------------------------------------------------------
-- Channels

-- | Update the channel list in the instance configuration and also
-- part the channel.
leaveChannel :: Text -> Maybe Text -> IRC s ()
leaveChannel :: forall s. Text -> Maybe Text -> IRC s ()
leaveChannel Text
chan Maybe Text
reason = do
  TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall s. TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
chan
  forall s. Message Text -> IRC s ()
send forall a b. (a -> b) -> a -> b
$ forall a. NickName a -> Reason (NickName a) -> Message (NickName a)
Part Text
chan Maybe Text
reason

-- | Remove a channel from the list without sending a part command (be
-- careful not to let the channel list get out of sync with the
-- real-world state if you use it for anything!)
delChan :: TVar (InstanceConfig s) -> Text -> STM ()
delChan :: forall s. TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
chan =
  forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [Text]
channels (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Text
chan)))


-------------------------------------------------------------------------------
-- Events

-- | Add an event handler
addHandler :: EventHandler s -> IRC s ()
addHandler :: forall s. EventHandler s -> IRC s ()
addHandler EventHandler s
handler = do
  TVar (InstanceConfig s)
tvarI <- forall a s. Getting a s a -> s -> a
get forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s (IRCState s)
getIRCState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
    forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [EventHandler s]
handlers (EventHandler s
handlerforall a. a -> [a] -> [a]
:))

-- | Send a message to the source of an event.
reply :: Event Text -> Text -> IRC s ()
reply :: forall s. Event Text -> Text -> IRC s ()
reply = forall s. Source Text -> Text -> IRC s ()
replyTo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Event a -> Source a
_source

-- | Send a message to the source of an event.
replyTo :: Source Text -> Text -> IRC s ()
replyTo :: forall s. Source Text -> Text -> IRC s ()
replyTo (Channel Text
c Text
_) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. Message Text -> IRC s ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
replyTo (User Text
n)      = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s. Message Text -> IRC s ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
replyTo Source Text
_ = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-------------------------------------------------------------------------------
-- CTCPs

-- | Construct a @PRIVMSG@ containing a CTCP
ctcp :: Text -> Text -> [Text] -> Message Text
ctcp :: Text -> Text -> [Text] -> Message Text
ctcp Text
t Text
command [Text]
args = forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> CTCPByteString
toCTCP Text
command [Text]
args

-- | Construct a @NOTICE@ containing a CTCP
ctcpReply :: Text -> Text -> [Text] -> Message Text
ctcpReply :: Text -> Text -> [Text] -> Message Text
ctcpReply Text
t Text
command [Text]
args = forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Notice Text
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> CTCPByteString
toCTCP Text
command [Text]
args


-------------------------------------------------------------------------------
-- Connection state

-- | Check if the client is connected.
isConnected :: IRC s Bool
isConnected :: forall s. IRC s Bool
isConnected = (forall a. Eq a => a -> a -> Bool
==ConnectionState
Connected) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s ConnectionState
snapConnState

-- | Check if the client is in the process of disconnecting.
isDisconnecting :: IRC s Bool
isDisconnecting :: forall s. IRC s Bool
isDisconnecting = (forall a. Eq a => a -> a -> Bool
==ConnectionState
Disconnecting) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s ConnectionState
snapConnState

-- | Check if the client is disconnected
isDisconnected :: IRC s Bool
isDisconnected :: forall s. IRC s Bool
isDisconnected = (forall a. Eq a => a -> a -> Bool
==ConnectionState
Disconnected) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IRC s ConnectionState
snapConnState

-- | Snapshot the connection state.
snapConnState :: IRC s ConnectionState
snapConnState :: forall s. IRC s ConnectionState
snapConnState = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. IRCState s -> STM ConnectionState
getConnectionState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. IRC s (IRCState s)
getIRCState


-------------------------------------------------------------------------------
-- Concurrency

-- | Fork a thread which will be thrown a 'Disconnect' exception when
-- the client disconnects.
fork :: IRC s () -> IRC s ThreadId
fork :: forall s. IRC s () -> IRC s ThreadId
fork IRC s ()
ma = do
  IRCState s
s <- forall s. IRC s (IRCState s)
getIRCState
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    ThreadId
tid <- forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (forall (m :: * -> *) s a. MonadIO m => IRC s a -> IRCState s -> m a
runIRCAction IRC s ()
ma IRCState s
s) forall a b. (a -> b) -> a -> b
$ \Either SomeException ()
_ -> do
      ThreadId
tid <- IO ThreadId
myThreadId
      forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s. IRCState s -> TVar (Set ThreadId)
_runningThreads IRCState s
s) (forall a. Ord a => a -> Set a -> Set a
S.delete ThreadId
tid)
    forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s. IRCState s -> TVar (Set ThreadId)
_runningThreads IRCState s
s) (forall a. Ord a => a -> Set a -> Set a
S.insert ThreadId
tid)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ThreadId
tid