{-# LANGUAGE OverloadedStrings #-}
module Network.IRC.Bot.Part.Channels where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)
import Control.Monad.Trans (MonadIO(liftIO))
import Data.Monoid ((<>))
import Data.Set (Set, insert, toList)
import Data.ByteString (ByteString)
import Network.IRC (Message(..), joinChan)
import Network.IRC.Bot.BotMonad (BotMonad(..))
import Network.IRC.Bot.Log (LogLevel(..))

initChannelsPart :: (BotMonad m) => Set ByteString -> IO (TVar (Set ByteString), m ())
initChannelsPart :: Set ByteString -> IO (TVar (Set ByteString), m ())
initChannelsPart Set ByteString
chans =
    do TVar (Set ByteString)
channels <- STM (TVar (Set ByteString)) -> IO (TVar (Set ByteString))
forall a. STM a -> IO a
atomically (STM (TVar (Set ByteString)) -> IO (TVar (Set ByteString)))
-> STM (TVar (Set ByteString)) -> IO (TVar (Set ByteString))
forall a b. (a -> b) -> a -> b
$ Set ByteString -> STM (TVar (Set ByteString))
forall a. a -> STM (TVar a)
newTVar Set ByteString
chans
       (TVar (Set ByteString), m ()) -> IO (TVar (Set ByteString), m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TVar (Set ByteString)
channels, TVar (Set ByteString) -> m ()
forall (m :: * -> *). BotMonad m => TVar (Set ByteString) -> m ()
channelsPart TVar (Set ByteString)
channels)

channelsPart :: (BotMonad m) => TVar (Set ByteString) -> m ()
channelsPart :: TVar (Set ByteString) -> m ()
channelsPart TVar (Set ByteString)
channels =
    do Message
msg <- m Message
forall (m :: * -> *). BotMonad m => m Message
askMessage
       let cmd :: ByteString
cmd = Message -> ByteString
msg_command Message
msg
       case ByteString
cmd of
         ByteString
"005" -> do Set ByteString
chans <- IO (Set ByteString) -> m (Set ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set ByteString) -> m (Set ByteString))
-> IO (Set ByteString) -> m (Set ByteString)
forall a b. (a -> b) -> a -> b
$ STM (Set ByteString) -> IO (Set ByteString)
forall a. STM a -> IO a
atomically (STM (Set ByteString) -> IO (Set ByteString))
-> STM (Set ByteString) -> IO (Set ByteString)
forall a b. (a -> b) -> a -> b
$ TVar (Set ByteString) -> STM (Set ByteString)
forall a. TVar a -> STM a
readTVar TVar (Set ByteString)
channels
                     (ByteString -> m ()) -> [ByteString] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> m ()
forall (m :: * -> *). BotMonad m => ByteString -> m ()
doJoin (Set ByteString -> [ByteString]
forall a. Set a -> [a]
toList Set ByteString
chans)
         ByteString
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      doJoin :: (BotMonad m) => ByteString -> m ()
      doJoin :: ByteString -> m ()
doJoin ByteString
chan =
          do Message -> m ()
forall (m :: * -> *). BotMonad m => Message -> m ()
sendMessage (ByteString -> Message
joinChan ByteString
chan)
             LogLevel -> ByteString -> m ()
forall (m :: * -> *). BotMonad m => LogLevel -> ByteString -> m ()
logM LogLevel
Normal (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString
"Joining room " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
chan

joinChannel :: (BotMonad m) => ByteString -> TVar (Set ByteString) -> m ()
joinChannel :: ByteString -> TVar (Set ByteString) -> m ()
joinChannel ByteString
chan TVar (Set ByteString)
channels =
    do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
           do Set ByteString
cs <- TVar (Set ByteString) -> STM (Set ByteString)
forall a. TVar a -> STM a
readTVar TVar (Set ByteString)
channels
              TVar (Set ByteString) -> Set ByteString -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Set ByteString)
channels (ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => a -> Set a -> Set a
insert ByteString
chan Set ByteString
cs)
       Message -> m ()
forall (m :: * -> *). BotMonad m => Message -> m ()
sendMessage (ByteString -> Message
joinChan ByteString
chan)