2014-05-07 14:35:25 +05:30
|
|
|
{-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-}
|
2014-05-10 20:01:25 +05:30
|
|
|
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-05-04 02:57:43 +05:30
|
|
|
module Network.IRC.Types where
|
|
|
|
|
2014-05-10 20:01:25 +05:30
|
|
|
import BasicPrelude hiding (show)
|
2014-05-04 02:57:43 +05:30
|
|
|
import Control.Monad.Reader
|
2014-05-06 02:50:40 +05:30
|
|
|
import Control.Monad.State
|
2014-05-04 16:50:19 +05:30
|
|
|
import Data.Configurator.Types
|
2014-05-10 20:01:25 +05:30
|
|
|
import Prelude (Show(..))
|
2014-05-04 02:57:43 +05:30
|
|
|
import System.IO
|
|
|
|
import System.Time
|
|
|
|
|
2014-05-04 07:43:37 +05:30
|
|
|
type Channel = Text
|
|
|
|
type Nick = Text
|
|
|
|
type HandlerName = Text
|
2014-05-06 02:50:40 +05:30
|
|
|
|
|
|
|
newtype Handler = Handler {
|
|
|
|
runHandler :: forall m . (MonadIO m) => BotConfig -> Message -> m (Maybe Command)
|
|
|
|
}
|
2014-05-04 02:57:43 +05:30
|
|
|
|
2014-05-04 07:43:37 +05:30
|
|
|
data User = Self | User { userNick :: Nick, userServer :: Text }
|
2014-05-04 02:57:43 +05:30
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
data Message =
|
2014-05-04 08:44:54 +05:30
|
|
|
ChannelMsg { time :: ClockTime, user :: User, msg :: Text }
|
|
|
|
| PrivMsg { time :: ClockTime, user :: User, msg :: Text }
|
|
|
|
| Ping { time :: ClockTime, msg :: Text }
|
|
|
|
| JoinMsg { time :: ClockTime, user :: User }
|
|
|
|
| ModeMsg { time :: ClockTime, user :: User, target :: Text , mode :: Text, modeArgs :: [Text] }
|
|
|
|
| NickMsg { time :: ClockTime, user :: User, nick :: Text }
|
|
|
|
| QuitMsg { time :: ClockTime, user :: User, msg :: Text }
|
|
|
|
| PartMsg { time :: ClockTime, user :: User, msg :: Text }
|
2014-05-06 03:08:09 +05:30
|
|
|
| KickMsg { time :: ClockTime, user :: User, kicked :: Text , msg :: Text }
|
2014-05-04 08:44:54 +05:30
|
|
|
| OtherMsg { time :: ClockTime, source :: Text, command :: Text , target :: Text, msg :: Text }
|
2014-05-04 02:57:43 +05:30
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
data Command =
|
2014-05-04 08:44:54 +05:30
|
|
|
Pong { rmsg :: Text }
|
|
|
|
| ChannelMsgReply { rmsg :: Text }
|
2014-05-04 07:43:37 +05:30
|
|
|
| PrivMsgReply { ruser :: User, rmsg :: Text }
|
2014-05-04 02:57:43 +05:30
|
|
|
| NickCmd
|
|
|
|
| UserCmd
|
|
|
|
| JoinCmd
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
2014-05-04 08:44:54 +05:30
|
|
|
data BotConfig = BotConfig { server :: String
|
|
|
|
, port :: Int
|
|
|
|
, channel :: Text
|
|
|
|
, botNick :: Text
|
2014-05-04 07:03:23 +05:30
|
|
|
, botTimeout :: Int
|
2014-05-04 16:50:19 +05:30
|
|
|
, handlers :: [HandlerName]
|
|
|
|
, config :: Config }
|
|
|
|
|
|
|
|
instance Show BotConfig where
|
|
|
|
show BotConfig { .. } = "server = " ++ show server ++ "\n" ++
|
|
|
|
"port = " ++ show port ++ "\n" ++
|
|
|
|
"channel = " ++ show channel ++ "\n" ++
|
|
|
|
"nick = " ++ show botNick ++ "\n" ++
|
|
|
|
"timeout = " ++ show botTimeout ++ "\n" ++
|
|
|
|
"handlers = " ++ show handlers ++ "\n"
|
|
|
|
|
|
|
|
data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show)
|
2014-05-04 02:57:43 +05:30
|
|
|
|
2014-05-06 02:50:40 +05:30
|
|
|
data BotStatus = Connected | Disconnected | Joined | Kicked | Errored
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
|
|
|
|
deriving (Functor, Monad, MonadIO, MonadReader Bot, MonadState BotStatus)
|
|
|
|
|
|
|
|
runIRC :: Bot -> BotStatus -> IRC a -> IO BotStatus
|
2014-05-07 14:35:25 +05:30
|
|
|
runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC
|