module Network.IRC.Client.Utils
(
setNick
, leaveChannel
, delChan
, addHandler
, reply
, replyTo
, ctcp
, ctcpReply
, isConnected
, isDisconnecting
, isDisconnected
, snapConnState
, fork
, 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
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
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
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)))
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]
:))
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
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 ()
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
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
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
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
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
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
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