module Network.IRC.Client.Types
( module Network.IRC.Client.Types
, Event(..)
, Source(..)
, Message(..)
) where
import Control.Applicative ((<$>))
import Control.Concurrent.STM (TVar, atomically, readTVar, newTVar, writeTVar)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Reader (ReaderT, ask)
import Data.ByteString (ByteString)
import Data.Conduit (Consumer, Producer)
import Data.Conduit.TMChan (TBMChan)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime)
import Network.IRC.Conduit (Event(..), Message(..), Source(..), IrcEvent, IrcMessage)
type UnicodeEvent = Event Text
type UnicodeSource = Source Text
type UnicodeMessage = Message Text
type IRC a = StatefulIRC () a
type StatefulIRC s a = ReaderT (IRCState s) IO a
data IRCState s = IRCState { _connectionConfig :: ConnectionConfig s
, _userState :: TVar s
, _instanceConfig :: TVar (InstanceConfig s)
, _connState :: TVar ConnectionState
}
data ConnectionState = Connected | Disconnecting | Disconnected
deriving (Bounded, Enum, Eq, Ord, Read, Show)
newIRCState :: MonadIO m => ConnectionConfig s -> InstanceConfig s -> s -> m (IRCState s)
newIRCState cconf iconf ustate = do
ustvar <- liftIO . atomically . newTVar $ ustate
ictvar <- liftIO . atomically . newTVar $ iconf
cstvar <- liftIO . atomically . newTVar $ Disconnected
return IRCState
{ _connectionConfig = cconf
, _userState = ustvar
, _instanceConfig = ictvar
, _connState = cstvar
}
ircState :: StatefulIRC s (IRCState s)
ircState = ask
getConnectionConfig :: IRCState s -> ConnectionConfig s
getConnectionConfig = _connectionConfig
getInstanceConfig :: IRCState s -> TVar (InstanceConfig s)
getInstanceConfig = _instanceConfig
getUserState :: IRCState s -> TVar s
getUserState = _userState
getConnState :: MonadIO m => IRCState s -> m ConnectionState
getConnState = liftIO . atomically . readTVar . _connState
getInstanceConfig' :: MonadIO m => IRCState s -> m (InstanceConfig s)
getInstanceConfig' = liftIO . atomically . readTVar . _instanceConfig
connectionConfig :: StatefulIRC s (ConnectionConfig s)
connectionConfig = _connectionConfig <$> ask
instanceConfigTVar :: StatefulIRC s (TVar (InstanceConfig s))
instanceConfigTVar = _instanceConfig <$> ask
instanceConfig :: StatefulIRC s (InstanceConfig s)
instanceConfig = instanceConfigTVar >>= liftIO . atomically . readTVar
putInstanceConfig :: InstanceConfig s -> StatefulIRC s ()
putInstanceConfig iconf = instanceConfigTVar >>= liftIO . atomically . flip writeTVar iconf
stateTVar :: StatefulIRC s (TVar s)
stateTVar = _userState <$> ask
state :: StatefulIRC s s
state = stateTVar >>= liftIO . atomically . readTVar
putState :: s -> StatefulIRC s ()
putState s = stateTVar >>= liftIO . atomically . flip writeTVar s
data Origin = FromServer | FromClient
deriving (Eq, Read, Show)
data ConnectionConfig s = ConnectionConfig
{ _func :: IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()
, _sendqueue :: TBMChan IrcMessage
, _server :: ByteString
, _port :: Int
, _flood :: NominalDiffTime
, _onconnect :: StatefulIRC s ()
, _ondisconnect :: StatefulIRC s ()
, _logfunc :: Origin -> ByteString -> IO ()
}
data InstanceConfig s = InstanceConfig
{ _nick :: Text
, _username :: Text
, _realname :: Text
, _password :: Maybe Text
, _channels :: [Text]
, _ctcpVer :: Text
, _eventHandlers :: [EventHandler s]
, _ignore :: [(Text, Maybe Text)]
}
data EventType
= EEverything
| ENothing
| EPrivmsg | ENotice | ECTCP | ENick | EJoin | EPart | EQuit | EMode | ETopic | EInvite | EKick | EPing | ENumeric
deriving (Eq, Show)
data EventHandler s = EventHandler
{ _description :: Text
, _matchType :: EventType
, _eventFunc :: UnicodeEvent -> StatefulIRC s ()
}
eventType :: Event a -> EventType
eventType e = case _message e of
(Privmsg _ Right{}) -> EPrivmsg
(Privmsg _ Left{}) -> ECTCP
(Notice _ Right{}) -> ENotice
(Notice _ Left{}) -> ECTCP
Nick{} -> ENick
Join{} -> EJoin
Part{} -> EPart
Quit{} -> EQuit
Mode{} -> EMode
Topic{} -> ETopic
Invite{} -> EInvite
Kick{} -> EKick
Ping{} -> EPing
Numeric{} -> ENumeric
_ -> EEverything