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.CTCP (toCTCP)
import Network.IRC.Conduit (Event(..), Message(..),
Source(..))
import Network.IRC.Client.Internal
import Network.IRC.Client.Lens
setNick :: Text -> IRC s ()
setNick :: Text -> IRC s ()
setNick Text
new = do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$
TVar (InstanceConfig s)
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (Lens' (InstanceConfig s) Text
-> Text -> InstanceConfig s -> InstanceConfig s
forall s a. Lens' s a -> a -> s -> s
set forall s. Lens' (InstanceConfig s) Text
Lens' (InstanceConfig s) Text
nick Text
new)
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ()) -> Message Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Message Text
forall a. NickName a -> Message (NickName a)
Nick Text
new
leaveChannel :: Text -> Maybe Text -> IRC s ()
leaveChannel :: Text -> Maybe Text -> IRC s ()
leaveChannel Text
chan Maybe Text
reason = do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$ TVar (InstanceConfig s) -> Text -> STM ()
forall s. TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
chan
Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ()) -> Message Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Message Text
forall a. NickName a -> Reason (NickName a) -> Message (NickName a)
Part Text
chan Maybe Text
reason
delChan :: TVar (InstanceConfig s) -> Text -> STM ()
delChan :: TVar (InstanceConfig s) -> Text -> STM ()
delChan TVar (InstanceConfig s)
tvarI Text
chan =
TVar (InstanceConfig s)
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (Lens' (InstanceConfig s) [Text]
-> ([Text] -> [Text]) -> InstanceConfig s -> InstanceConfig s
forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [Text]
Lens' (InstanceConfig s) [Text]
channels ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
chan)))
addHandler :: EventHandler s -> IRC s ()
addHandler :: EventHandler s -> IRC s ()
addHandler EventHandler s
handler = do
TVar (InstanceConfig s)
tvarI <- Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
-> IRCState s -> TVar (InstanceConfig s)
forall a s. Getting a s a -> s -> a
get Getting
(TVar (InstanceConfig s)) (IRCState s) (TVar (InstanceConfig s))
forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig (IRCState s -> TVar (InstanceConfig s))
-> IRC s (IRCState s) -> IRC s (TVar (InstanceConfig s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO () -> IRC s ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IRC s ()) -> (STM () -> IO ()) -> STM () -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IRC s ()) -> STM () -> IRC s ()
forall a b. (a -> b) -> a -> b
$
TVar (InstanceConfig s)
-> (InstanceConfig s -> InstanceConfig s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (InstanceConfig s)
tvarI (Lens' (InstanceConfig s) [EventHandler s]
-> ([EventHandler s] -> [EventHandler s])
-> InstanceConfig s
-> InstanceConfig s
forall s a. Lens' s a -> (a -> a) -> s -> s
modify forall s. Lens' (InstanceConfig s) [EventHandler s]
Lens' (InstanceConfig s) [EventHandler s]
handlers (EventHandler s
handlerEventHandler s -> [EventHandler s] -> [EventHandler s]
forall a. a -> [a] -> [a]
:))
reply :: Event Text -> Text -> IRC s ()
reply :: Event Text -> Text -> IRC s ()
reply = Source Text -> Text -> IRC s ()
forall s. Source Text -> Text -> IRC s ()
replyTo (Source Text -> Text -> IRC s ())
-> (Event Text -> Source Text) -> Event Text -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event Text -> Source Text
forall a. Event a -> Source a
_source
replyTo :: Source Text -> Text -> IRC s ()
replyTo :: Source Text -> Text -> IRC s ()
replyTo (Channel Text
c Text
_) = (Text -> IRC s ()) -> [Text] -> IRC s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ())
-> (Text -> Message Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CTCPByteString Text -> Message Text
forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
c (Either CTCPByteString Text -> Message Text)
-> (Text -> Either CTCPByteString Text) -> Text -> Message Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CTCPByteString Text
forall a b. b -> Either a b
Right) ([Text] -> IRC s ()) -> (Text -> [Text]) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
replyTo (User Text
n) = (Text -> IRC s ()) -> [Text] -> IRC s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Message Text -> IRC s ()
forall s. Message Text -> IRC s ()
send (Message Text -> IRC s ())
-> (Text -> Message Text) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CTCPByteString Text -> Message Text
forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
n (Either CTCPByteString Text -> Message Text)
-> (Text -> Either CTCPByteString Text) -> Text -> Message Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CTCPByteString Text
forall a b. b -> Either a b
Right) ([Text] -> IRC s ()) -> (Text -> [Text]) -> Text -> IRC s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
replyTo Source Text
_ = IRC s () -> Text -> IRC s ()
forall a b. a -> b -> a
const (IRC s () -> Text -> IRC s ()) -> IRC s () -> Text -> IRC s ()
forall a b. (a -> b) -> a -> b
$ () -> IRC s ()
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 = Text -> Either CTCPByteString Text -> Message Text
forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Privmsg Text
t (Either CTCPByteString Text -> Message Text)
-> (CTCPByteString -> Either CTCPByteString Text)
-> CTCPByteString
-> Message Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTCPByteString -> Either CTCPByteString Text
forall a b. a -> Either a b
Left (CTCPByteString -> Message Text) -> CTCPByteString -> Message Text
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 = Text -> Either CTCPByteString Text -> Message Text
forall a.
NickName a
-> Either CTCPByteString (NickName a) -> Message (NickName a)
Notice Text
t (Either CTCPByteString Text -> Message Text)
-> (CTCPByteString -> Either CTCPByteString Text)
-> CTCPByteString
-> Message Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTCPByteString -> Either CTCPByteString Text
forall a b. a -> Either a b
Left (CTCPByteString -> Message Text) -> CTCPByteString -> Message Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> CTCPByteString
toCTCP Text
command [Text]
args
isConnected :: IRC s Bool
isConnected :: IRC s Bool
isConnected = (ConnectionState -> ConnectionState -> Bool
forall a. Eq a => a -> a -> Bool
==ConnectionState
Connected) (ConnectionState -> Bool) -> IRC s ConnectionState -> IRC s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s ConnectionState
forall s. IRC s ConnectionState
snapConnState
isDisconnecting :: IRC s Bool
isDisconnecting :: IRC s Bool
isDisconnecting = (ConnectionState -> ConnectionState -> Bool
forall a. Eq a => a -> a -> Bool
==ConnectionState
Disconnecting) (ConnectionState -> Bool) -> IRC s ConnectionState -> IRC s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s ConnectionState
forall s. IRC s ConnectionState
snapConnState
isDisconnected :: IRC s Bool
isDisconnected :: IRC s Bool
isDisconnected = (ConnectionState -> ConnectionState -> Bool
forall a. Eq a => a -> a -> Bool
==ConnectionState
Disconnected) (ConnectionState -> Bool) -> IRC s ConnectionState -> IRC s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s ConnectionState
forall s. IRC s ConnectionState
snapConnState
snapConnState :: IRC s ConnectionState
snapConnState :: IRC s ConnectionState
snapConnState = IO ConnectionState -> IRC s ConnectionState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectionState -> IRC s ConnectionState)
-> (IRCState s -> IO ConnectionState)
-> IRCState s
-> IRC s ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM ConnectionState -> IO ConnectionState
forall a. STM a -> IO a
atomically (STM ConnectionState -> IO ConnectionState)
-> (IRCState s -> STM ConnectionState)
-> IRCState s
-> IO ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRCState s -> STM ConnectionState
forall s. IRCState s -> STM ConnectionState
getConnectionState (IRCState s -> IRC s ConnectionState)
-> IRC s (IRCState s) -> IRC s ConnectionState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
fork :: IRC s () -> IRC s ThreadId
fork :: IRC s () -> IRC s ThreadId
fork IRC s ()
ma = do
IRCState s
s <- IRC s (IRCState s)
forall s. IRC s (IRCState s)
getIRCState
IO ThreadId -> IRC s ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> IRC s ThreadId) -> IO ThreadId -> IRC s ThreadId
forall a b. (a -> b) -> a -> b
$ do
ThreadId
tid <- IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (IRC s () -> IRCState s -> IO ()
forall (m :: * -> *) s a. MonadIO m => IRC s a -> IRCState s -> m a
runIRCAction IRC s ()
ma IRCState s
s) ((Either SomeException () -> IO ()) -> IO ThreadId)
-> (Either SomeException () -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \Either SomeException ()
_ -> do
ThreadId
tid <- IO ThreadId
myThreadId
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Set ThreadId) -> (Set ThreadId -> Set ThreadId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (IRCState s -> TVar (Set ThreadId)
forall s. IRCState s -> TVar (Set ThreadId)
_runningThreads IRCState s
s) (ThreadId -> Set ThreadId -> Set ThreadId
forall a. Ord a => a -> Set a -> Set a
S.delete ThreadId
tid)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Set ThreadId) -> (Set ThreadId -> Set ThreadId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (IRCState s -> TVar (Set ThreadId)
forall s. IRCState s -> TVar (Set ThreadId)
_runningThreads IRCState s
s) (ThreadId -> Set ThreadId -> Set ThreadId
forall a. Ord a => a -> Set a -> Set a
S.insert ThreadId
tid)
ThreadId -> IO ThreadId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ThreadId
tid