Some restructuring and refactoring

master
Abhinav Sarkar 2014-06-08 07:12:33 +05:30
parent 5d49e4e201
commit e61cab74ed
11 changed files with 296 additions and 245 deletions

View File

@ -27,6 +27,7 @@ import System.Log.Logger.TH (deriveLoggers)
import Network.IRC.Internal.Types import Network.IRC.Internal.Types
import Network.IRC.Protocol import Network.IRC.Protocol
import Network.IRC.Types
import Network.IRC.Util import Network.IRC.Util
$(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO, HSL.ERROR]) $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO, HSL.ERROR])

View File

@ -31,6 +31,7 @@ import qualified Network.IRC.Handlers.Core as Core
import Network.IRC.Bot import Network.IRC.Bot
import Network.IRC.Internal.Types import Network.IRC.Internal.Types
import Network.IRC.Types
import Network.IRC.Util import Network.IRC.Util
$(deriveLoggers "HSL" [HSL.DEBUG, HSL.ERROR]) $(deriveLoggers "HSL" [HSL.DEBUG, HSL.ERROR])

View File

@ -53,4 +53,4 @@ help FullMessage { .. } = case fromMessage message of
let mHelp = find ((\c -> c == command || c == cons '!' command) . fst) let mHelp = find ((\c -> c == command || c == cons '!' command) . fst)
. concatMap mapToList . mapValues $ msgHandlerInfo . concatMap mapToList . mapValues $ msgHandlerInfo
return [toCommand . ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp] return [toCommand . ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp]
_ -> return [] _ -> return []

View File

@ -0,0 +1,67 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
module Network.IRC.Internal.Command.Types where
import ClassyPrelude
import Data.Typeable (cast)
import Network.IRC.Internal.Message.Types
-- | The typeclass for IRC commands sent from the bot to the server.
class (Typeable cmd, Show cmd, Eq cmd, Ord cmd) => CommandC cmd where
toCommand :: cmd -> Command
toCommand = Command
fromCommand :: Command -> Maybe cmd
fromCommand (Command cmd) = cast cmd
-- | A wrapper over all types of IRC commands.
data Command = forall m . CommandC m => Command m deriving (Typeable)
instance Show Command where
show (Command m) = show m
instance Eq Command where
Command m1 == Command m2 = case cast m1 of
Just m1' -> m1' == m2
_ -> False
-- | A /PING/ command. A 'PongMsg' is expected as a response to this.
data PingCmd = PingCmd !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PingCmd
-- | A /PONG/ command. Sent in response to a 'PingMsg'.
data PongCmd = PongCmd !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PongCmd
-- | A /PRIVMSG/ message sent to the channel.
data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC ChannelMsgReply
-- | A /PRIVMSG/ message sent to a user.
data PrivMsgReply = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PrivMsgReply
-- | A /NICK/ command sent to set the bot's nick.
data NickCmd = NickCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC NickCmd
-- | A /USER/ command sent to identify the bot.
data UserCmd = UserCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC UserCmd
-- | A /JOIN/ command sent to join the channel.
data JoinCmd = JoinCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC JoinCmd
-- | A /QUIT/ command sent to quit the server.
data QuitCmd = QuitCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC QuitCmd
-- | A /NAMES/ command sent to ask for the nicks of the users in the channel.
data NamesCmd = NamesCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC NamesCmd

View File

@ -0,0 +1,57 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
module Network.IRC.Internal.Event.Types where
import ClassyPrelude
import Data.Typeable (cast)
import Network.IRC.Internal.Message.Types
import Network.IRC.Internal.Command.Types
-- ** Events
-- | Events are used for communication between message handlers. To send events, write them to the
-- event channel provided to the 'MsgHandler' when it is created. To receive events, provide
-- an 'onEvent' function as a part of the message handler.
class (Typeable e, Show e, Eq e) => EventC e where
-- | Creates an event.
toEvent :: e -> IO Event
toEvent e = Event <$> pure e <*> getCurrentTime
-- | Extracts a received event.
fromEvent :: Event -> Maybe (e, UTCTime)
fromEvent (Event e time) = do
ev <- cast e
return (ev, time)
-- | A wrapper over all types of 'Event's to allow sending them over channel of same type.
data Event = forall e. (EventC e, Typeable e) => Event e UTCTime deriving (Typeable)
instance Show Event where
show (Event e time) = formatTime defaultTimeLocale "[%F %T] " time ++ show e
instance Eq Event where
Event e1 t1 == Event e2 t2 =
case cast e2 of
Just e2' -> e1 == e2' && t1 == t2
Nothing -> False
-- | Response to an event received by a message handler.
data EventResponse =
-- | No response
RespNothing
-- | Events as the response. They will be sent to all message handlers like usual events.
| RespEvent [Event]
-- | Messages as the response. They will be sent to all message handlers like usual messages.
| RespMessage [FullMessage]
-- | Commands as the response. They will be sent to the server like usual commands.
| RespCommand [Command]
deriving (Show, Eq)
-- | An event signifying the bot quitting the server.
data QuitEvent = QuitEvent deriving (Show, Eq, Ord, Typeable)
instance EventC QuitEvent

View File

@ -0,0 +1,123 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Internal.Message.Types where
import ClassyPrelude
import Data.Data (Data)
import Data.SafeCopy (base, deriveSafeCopy)
import Data.Typeable (cast)
-- ** IRC Message
-- | An IRC nick.
newtype Nick = Nick { nickToText :: Text }
deriving (Eq, Ord, Data, Typeable, Hashable)
instance Show Nick where
show = unpack . nickToText
$(deriveSafeCopy 0 'base ''Nick)
-- | An IRC user.
data User
-- | The user for the bot itself.
= Self
-- | An user other than the bot.
| User
{ userNick :: !Nick -- ^ The user's nick.
, userServer :: !Text -- ^ The user's server.
} deriving (Show, Eq, Ord)
-- | An IRC message sent from the server to the bot.
data FullMessage = FullMessage
{ msgTime :: !UTCTime -- ^ The time when the message was received.
, msgLine :: !Text -- ^ The raw message line.
, message :: Message -- ^ The details of the parsed message.
} deriving (Show, Eq)
-- | The typeclass for different types of IRC messages.
class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where
toMessage :: msg -> Message
toMessage = Message
fromMessage :: Message -> Maybe msg
fromMessage (Message msg) = cast msg
-- | A wrapper over all types of IRC messages.
data Message = forall m . MessageC m => Message m deriving (Typeable)
instance Show Message where
show (Message m) = show m
instance Eq Message where
Message m1 == Message m2 = case cast m1 of
Just m1' -> m1' == m2
_ -> False
-- | The internal (non-IRC) message received when the bot is idle.
data IdleMsg = IdleMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC IdleMsg
-- | The message received when the bot's current nick is already in use.
data NickInUseMsg = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC NickInUseMsg
-- | A /PING/ message. Must be replied with a 'PongCmd'.
data PingMsg = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingMsg
-- | A /PONG/ message. Received in response to a 'PingCmd'.
data PongMsg = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongMsg
-- | A /NAMES/ message which contains a list of nicks of all users in the channel.
data NamesMsg = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesMsg
-- | A /PRIVMSG/ message sent to the channel from a user.
data ChannelMsg = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsg
-- | A /PRIVMSG/ private message sent to the bot from a user.
data PrivMsg = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsg
-- | An /PRIVMSG/ action message sent to the channel from a user.
data ActionMsg = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ActionMsg
-- | A /JOIN/ message received when a user joins the channel.
data JoinMsg = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinMsg
-- | A /QUIT/ message received when a user quits the server.
data QuitMsg = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitMsg
-- | A /PART/ message received when a user leaves the channel.
data PartMsg = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PartMsg
-- | A /NICK/ message received when a user changes their nick.
data NickMsg = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
instance MessageC NickMsg
-- | A /KICK/ message received when a user kicks another user from the channel.
data KickMsg = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
deriving (Typeable, Show, Eq, Ord)
instance MessageC KickMsg
-- | A /MODE/ message received when a user's mode changes.
data ModeMsg = ModeMsg { modeUser :: !User, modeTarget :: !Text, mode :: !Text , modeArgs :: ![Text] }
deriving (Typeable, Show, Eq, Ord)
instance MessageC ModeMsg
-- | All other messages which are not parsed as any of the above types.
data OtherMsg = OtherMsg { msgSource :: !Text, msgCommand :: !Text, msgTarget :: !Text , msg :: !Text }
deriving (Typeable, Show, Eq, Ord)
instance MessageC OtherMsg

View File

@ -1,186 +1,24 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Internal.Types where module Network.IRC.Internal.Types where
import qualified Data.Configurator as CF
import ClassyPrelude import ClassyPrelude
import Control.Concurrent.Lifted (Chan) import Control.Concurrent.Lifted (Chan)
import Control.Monad.Base (MonadBase) import Control.Monad.Base (MonadBase)
import Control.Monad.Reader (ReaderT, MonadReader, runReaderT) import Control.Monad.Reader (ReaderT, MonadReader, runReaderT)
import Control.Monad.State (StateT, MonadState, execStateT) import Control.Monad.State (StateT, MonadState, execStateT)
import Data.Configurator.Types (Config) import Data.Configurator.Types (Config)
import Data.Data (Data)
import Data.SafeCopy (base, deriveSafeCopy)
import Data.Typeable (cast)
import Network.IRC.Internal.Command.Types
import Network.IRC.Internal.Event.Types
import Network.IRC.Internal.Message.Types
import Network.IRC.Util import Network.IRC.Util
-- * Types
-- ** IRC related
-- | An IRC nick.
newtype Nick = Nick { nickToText :: Text }
deriving (Eq, Ord, Data, Typeable, Hashable)
instance Show Nick where
show = unpack . nickToText
$(deriveSafeCopy 0 'base ''Nick)
-- | An IRC user.
data User
-- | The user for the bot itself.
= Self
-- | An user other than the bot.
| User
{ userNick :: !Nick -- ^ The user's nick.
, userServer :: !Text -- ^ The user's server.
} deriving (Show, Eq, Ord)
-- | An IRC message sent from the server to the bot.
data FullMessage = FullMessage
{ msgTime :: !UTCTime -- ^ The time when the message was received.
, msgLine :: !Text -- ^ The raw message line.
, message :: Message -- ^ The details of the parsed message.
} deriving (Show, Eq)
-- | The typeclass for different types of IRC messages.
class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where
toMessage :: msg -> Message
toMessage = Message
fromMessage :: Message -> Maybe msg
fromMessage (Message msg) = cast msg
-- | A wrapper over all types of IRC messages.
data Message = forall m . MessageC m => Message m deriving (Typeable)
instance Show Message where
show (Message m) = show m
instance Eq Message where
Message m1 == Message m2 = case cast m1 of
Just m1' -> m1' == m2
_ -> False
-- | The internal (non-IRC) message received when the bot is idle.
data IdleMsg = IdleMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC IdleMsg
-- | The message received when the bot's current nick is already in use.
data NickInUseMsg = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC NickInUseMsg
-- | A /PING/ message. Must be replied with a 'PongCmd'.
data PingMsg = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingMsg
-- | A /PONG/ message. Received in response to a 'PingCmd'.
data PongMsg = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongMsg
-- | A /NAMES/ message which contains a list of nicks of all users in the channel.
data NamesMsg = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesMsg
-- | A /PRIVMSG/ message sent to the channel from a user.
data ChannelMsg = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsg
-- | A /PRIVMSG/ private message sent to the bot from a user.
data PrivMsg = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsg
-- | An /PRIVMSG/ action message sent to the channel from a user.
data ActionMsg = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ActionMsg
-- | A /JOIN/ message received when a user joins the channel.
data JoinMsg = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinMsg
-- | A /QUIT/ message received when a user quits the server.
data QuitMsg = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitMsg
-- | A /PART/ message received when a user leaves the channel.
data PartMsg = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PartMsg
-- | A /NICK/ message received when a user changes their nick.
data NickMsg = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
instance MessageC NickMsg
-- | A /KICK/ message received when a user kicks another user from the channel.
data KickMsg = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
deriving (Typeable, Show, Eq, Ord)
instance MessageC KickMsg
-- | A /MODE/ message received when a user's mode changes.
data ModeMsg = ModeMsg { modeUser :: !User, modeTarget :: !Text, mode :: !Text , modeArgs :: ![Text] }
deriving (Typeable, Show, Eq, Ord)
instance MessageC ModeMsg
-- | All other messages which are not parsed as any of the above types.
data OtherMsg = OtherMsg { msgSource :: !Text, msgCommand :: !Text, msgTarget :: !Text , msg :: !Text }
deriving (Typeable, Show, Eq, Ord)
instance MessageC OtherMsg
-- | The typeclass for IRC commands sent from the bot to the server.
class (Typeable cmd, Show cmd, Eq cmd, Ord cmd) => CommandC cmd where
toCommand :: cmd -> Command
toCommand = Command
fromCommand :: Command -> Maybe cmd
fromCommand (Command cmd) = cast cmd
-- | A wrapper over all types of IRC commands.
data Command = forall m . CommandC m => Command m deriving (Typeable)
instance Show Command where
show (Command m) = show m
instance Eq Command where
Command m1 == Command m2 = case cast m1 of
Just m1' -> m1' == m2
_ -> False
-- | A /PING/ command. A 'PongMsg' is expected as a response to this.
data PingCmd = PingCmd !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PingCmd
-- | A /PONG/ command. Sent in response to a 'PingMsg'.
data PongCmd = PongCmd !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PongCmd
-- | A /PRIVMSG/ message sent to the channel.
data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC ChannelMsgReply
-- | A /PRIVMSG/ message sent to a user.
data PrivMsgReply = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord)
instance CommandC PrivMsgReply
-- | A /NICK/ command sent to set the bot's nick.
data NickCmd = NickCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC NickCmd
-- | A /USER/ command sent to identify the bot.
data UserCmd = UserCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC UserCmd
-- | A /JOIN/ command sent to join the channel.
data JoinCmd = JoinCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC JoinCmd
-- | A /QUIT/ command sent to quit the server.
data QuitCmd = QuitCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC QuitCmd
-- | A /NAMES/ command sent to ask for the nicks of the users in the channel.
data NamesCmd = NamesCmd deriving (Typeable, Show, Eq, Ord)
instance CommandC NamesCmd
-- ** Message Parsing -- ** Message Parsing
-- | Message parser id. Should be unique. -- | Message parser id. Should be unique.
@ -190,8 +28,8 @@ type MessageParserId = Text
data MessagePart = MessagePart { msgPartParserId :: !MessageParserId data MessagePart = MessagePart { msgPartParserId :: !MessageParserId
, msgPartTarget :: !Text , msgPartTarget :: !Text
, msgPartTime :: !UTCTime , msgPartTime :: !UTCTime
, msgPartLine :: !Text } , msgPartLine :: !Text
deriving (Eq, Show) } deriving (Eq, Show)
-- | The result of parsing a message line. -- | The result of parsing a message line.
data MessageParseResult = data MessageParseResult =
@ -211,48 +49,6 @@ data MessageParser = MessageParser
-- | A command formatter which optinally formats commands to texts which are then send to the server. -- | A command formatter which optinally formats commands to texts which are then send to the server.
type CommandFormatter = BotConfig -> Command -> Maybe Text type CommandFormatter = BotConfig -> Command -> Maybe Text
-- ** Events
-- | Events are used for communication between message handlers. To send events, write them to the
-- event channel provided to the 'MsgHandler' when it is created. To receive events, provide
-- an 'onEvent' function as a part of the message handler.
class (Typeable e, Show e, Eq e) => EventC e where
-- | Creates an event.
toEvent :: e -> IO Event
toEvent e = Event <$> pure e <*> getCurrentTime
-- | Extracts a received event.
fromEvent :: Event -> Maybe (e, UTCTime)
fromEvent (Event e time) = do
ev <- cast e
return (ev, time)
-- | A wrapper over all types of 'Event's to allow sending them over channel of same type.
data Event = forall e. (EventC e, Typeable e) => Event e UTCTime deriving (Typeable)
instance Show Event where
show (Event e time) = formatTime defaultTimeLocale "[%F %T] " time ++ show e
instance Eq Event where
Event e1 t1 == Event e2 t2 =
case cast e2 of
Just e2' -> e1 == e2' && t1 == t2
Nothing -> False
-- | Response to an event received by a message handler.
data EventResponse =
-- | No response
RespNothing
-- | Events as the response. They will be sent to all message handlers like usual events.
| RespEvent [Event]
-- | Messages as the response. They will be sent to all message handlers like usual messages.
| RespMessage [FullMessage]
-- | Commands as the response. They will be sent to the server like usual commands.
| RespCommand [Command]
deriving (Show, Eq)
-- | An event signifying the bot quitting the server.
data QuitEvent = QuitEvent deriving (Show, Eq, Ord, Typeable)
instance EventC QuitEvent
-- ** Bot -- ** Bot
-- | Name of a message handler. -- | Name of a message handler.
@ -286,24 +82,22 @@ data BotConfig = BotConfig
} }
instance Show BotConfig where instance Show BotConfig where
show BotConfig { .. } = "server = " ++ show server ++ "\n" ++ show BotConfig { .. } = "BotConfig[ server = " ++ show server ++ "\n" ++
"port = " ++ show port ++ "\n" ++ "port = " ++ show port ++ "\n" ++
"channel = " ++ show channel ++ "\n" ++ "channel = " ++ show channel ++ "\n" ++
"nick = " ++ show botNick ++ "\n" ++ "nick = " ++ show botNick ++ "\n" ++
"timeout = " ++ show botTimeout ++ "\n" ++ "timeout = " ++ show botTimeout ++ "\n" ++
"handlers = " ++ show (mapKeys msgHandlerInfo) "handlers = " ++ show (mapKeys msgHandlerInfo) ++ " ]"
-- | Creates a new bot config with some fields as empty. -- | Creates a new bot config with essential fields leaving rest fields empty.
newBotConfig :: Text -- ^ server newBotConfig :: Text -- ^ server
-> Int -- ^ port -> Int -- ^ port
-> Text -- ^ channel -> Text -- ^ channel
-> Nick -- ^ botNick -> Nick -- ^ botNick
-> Int -- ^ botTimeout -> Int -- ^ botTimeout
-> Map MsgHandlerName (Map Text Text) -- ^ msgHandlerInfo
-> Config -- ^ config
-> BotConfig -> BotConfig
newBotConfig server port channel botNick botTimeout msgHandlerInfo = newBotConfig server port channel botNick botTimeout =
BotConfig server port channel botNick botTimeout msgHandlerInfo [] [] [] BotConfig server port channel botNick botTimeout mempty [] [] [] CF.empty
-- | The bot. -- | The bot.
data Bot = Bot data Bot = Bot

View File

@ -12,8 +12,8 @@ import Network.IRC.Types
parseLine :: BotConfig -> UTCTime -> Text -> [MessagePart] -> (Maybe FullMessage, [MessagePart]) parseLine :: BotConfig -> UTCTime -> Text -> [MessagePart] -> (Maybe FullMessage, [MessagePart])
parseLine botConfig@BotConfig { .. } time line msgParts = parseLine botConfig@BotConfig { .. } time line msgParts =
fromMaybe (Nothing, msgParts) . msum . flip map parsers $ \MessageParser { .. } -> let fromMaybe (Nothing, msgParts) . msum . flip map parsers $ \MessageParser { .. } ->
(parserMsgParts, otherParserMsgParts) = partition ((msgParserId ==) . msgPartParserId) msgParts let (parserMsgParts, otherParserMsgParts) = partition ((msgParserId ==) . msgPartParserId) msgParts
in case msgParser botConfig time line parserMsgParts of in case msgParser botConfig time line parserMsgParts of
Reject -> Nothing Reject -> Nothing
Partial msgParts' -> Just (Nothing, msgParts' ++ otherParserMsgParts) Partial msgParts' -> Just (Nothing, msgParts' ++ otherParserMsgParts)
@ -31,11 +31,11 @@ pingParser = MessageParser "ping" go
parseMsgLine :: Text -> ([Text], Text, Text, Text, Text) parseMsgLine :: Text -> ([Text], Text, Text, Text, Text)
parseMsgLine line = (splits, command, source, target, message) parseMsgLine line = (splits, command, source, target, message)
where where
splits = words line splits = words line
command = splits !! 1 command = splits !! 1
source = drop 1 $ splits !! 0 source = drop 1 $ splits !! 0
target = splits !! 2 target = splits !! 2
message = strip . drop 1 . unwords . drop 3 $ splits message = strip . drop 1 . unwords . drop 3 $ splits
lineParser :: MessageParser lineParser :: MessageParser
lineParser = MessageParser "line" go lineParser = MessageParser "line" go
@ -111,6 +111,6 @@ defaultCommandFormatter BotConfig { .. } command
| Just (PrivMsgReply (User { .. }) msg) <- fromCommand command = | Just (PrivMsgReply (User { .. }) msg) <- fromCommand command =
Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg
| Just NamesCmd <- fromCommand command = Just $ "NAMES " ++ channel | Just NamesCmd <- fromCommand command = Just $ "NAMES " ++ channel
| otherwise = Nothing | otherwise = Nothing
where where
botNick' = nickToText botNick botNick' = nickToText botNick

View File

@ -68,4 +68,8 @@ module Network.IRC.Types
, MsgHandlerMaker (..) , MsgHandlerMaker (..)
) where ) where
import Network.IRC.Internal.Command.Types
import Network.IRC.Internal.Event.Types
import Network.IRC.Internal.Message.Types
import Network.IRC.Internal.Types import Network.IRC.Internal.Types

View File

@ -74,7 +74,10 @@ library
Network.IRC.Client, Network.IRC.Client,
Network.IRC.Util Network.IRC.Util
other-modules: Network.IRC.Internal.Types, other-modules: Network.IRC.Internal.Command.Types,
Network.IRC.Internal.Event.Types,
Network.IRC.Internal.Message.Types,
Network.IRC.Internal.Types,
Network.IRC.Protocol, Network.IRC.Protocol,
Network.IRC.Bot, Network.IRC.Bot,
Network.IRC.Handlers.Core Network.IRC.Handlers.Core

View File

@ -16,22 +16,23 @@ instance Configured a => Configured [a] where
loadBotConfig :: String -> IO BotConfig loadBotConfig :: String -> IO BotConfig
loadBotConfig configFile = do loadBotConfig configFile = do
eCfg <- try $ CF.load [CF.Required configFile] eConfig <- try $ CF.load [CF.Required configFile]
case eCfg of case eConfig of
Left (ParseError _ _) -> error "Error while loading config" Left (ParseError _ _) -> error "Error while loading config"
Right cfg -> do Right config -> do
eBotConfig <- try $ do eBotConfig <- try $ do
handlers :: [Text] <- CF.require cfg "msghandlers" handlers :: [Text] <- CF.require config "msghandlers"
let handlerInfo = foldl' (\m h -> insertMap h mempty m) mempty handlers let handlerInfo = foldl' (\m h -> insertMap h mempty m) mempty handlers
botConfig <- newBotConfig <$> botConfig <- newBotConfig <$>
CF.require cfg "server" <*> CF.require config "server" <*>
CF.require cfg "port" <*> CF.require config "port" <*>
CF.require cfg "channel" <*> CF.require config "channel" <*>
(Nick <$> CF.require cfg "nick") <*> (Nick <$> CF.require config "nick") <*>
CF.require cfg "timeout" <*> CF.require config "timeout"
pure handlerInfo <*> return botConfig { msgHandlerInfo = handlerInfo
pure cfg , msgHandlerMakers = allMsgHandlerMakers
return botConfig { msgHandlerMakers = allMsgHandlerMakers } , config = config
}
case eBotConfig of case eBotConfig of
Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k