From e61cab74ed032bce8be044d7dfc1c5cdf4647c5e Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 8 Jun 2014 07:12:33 +0530 Subject: [PATCH] Some restructuring and refactoring --- hask-irc-core/Network/IRC/Bot.hs | 1 + hask-irc-core/Network/IRC/Client.hs | 1 + hask-irc-core/Network/IRC/Handlers/Core.hs | 2 +- .../Network/IRC/Internal/Command/Types.hs | 67 +++++ .../Network/IRC/Internal/Event/Types.hs | 57 +++++ .../Network/IRC/Internal/Message/Types.hs | 123 +++++++++ hask-irc-core/Network/IRC/Internal/Types.hs | 238 ++---------------- hask-irc-core/Network/IRC/Protocol.hs | 16 +- hask-irc-core/Network/IRC/Types.hs | 4 + hask-irc-core/hask-irc-core.cabal | 5 +- hask-irc-runner/Network/IRC/Config.hs | 27 +- 11 files changed, 296 insertions(+), 245 deletions(-) create mode 100644 hask-irc-core/Network/IRC/Internal/Command/Types.hs create mode 100644 hask-irc-core/Network/IRC/Internal/Event/Types.hs create mode 100644 hask-irc-core/Network/IRC/Internal/Message/Types.hs diff --git a/hask-irc-core/Network/IRC/Bot.hs b/hask-irc-core/Network/IRC/Bot.hs index 7d7aef8..08f5b39 100644 --- a/hask-irc-core/Network/IRC/Bot.hs +++ b/hask-irc-core/Network/IRC/Bot.hs @@ -27,6 +27,7 @@ import System.Log.Logger.TH (deriveLoggers) import Network.IRC.Internal.Types import Network.IRC.Protocol +import Network.IRC.Types import Network.IRC.Util $(deriveLoggers "HSL" [HSL.DEBUG, HSL.INFO, HSL.ERROR]) diff --git a/hask-irc-core/Network/IRC/Client.hs b/hask-irc-core/Network/IRC/Client.hs index c69864b..6664899 100644 --- a/hask-irc-core/Network/IRC/Client.hs +++ b/hask-irc-core/Network/IRC/Client.hs @@ -31,6 +31,7 @@ import qualified Network.IRC.Handlers.Core as Core import Network.IRC.Bot import Network.IRC.Internal.Types +import Network.IRC.Types import Network.IRC.Util $(deriveLoggers "HSL" [HSL.DEBUG, HSL.ERROR]) diff --git a/hask-irc-core/Network/IRC/Handlers/Core.hs b/hask-irc-core/Network/IRC/Handlers/Core.hs index 159d958..7fb65c2 100644 --- a/hask-irc-core/Network/IRC/Handlers/Core.hs +++ b/hask-irc-core/Network/IRC/Handlers/Core.hs @@ -53,4 +53,4 @@ help FullMessage { .. } = case fromMessage message of let mHelp = find ((\c -> c == command || c == cons '!' command) . fst) . concatMap mapToList . mapValues $ msgHandlerInfo return [toCommand . ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp] - _ -> return [] + _ -> return [] diff --git a/hask-irc-core/Network/IRC/Internal/Command/Types.hs b/hask-irc-core/Network/IRC/Internal/Command/Types.hs new file mode 100644 index 0000000..4e96708 --- /dev/null +++ b/hask-irc-core/Network/IRC/Internal/Command/Types.hs @@ -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 diff --git a/hask-irc-core/Network/IRC/Internal/Event/Types.hs b/hask-irc-core/Network/IRC/Internal/Event/Types.hs new file mode 100644 index 0000000..7d1b026 --- /dev/null +++ b/hask-irc-core/Network/IRC/Internal/Event/Types.hs @@ -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 diff --git a/hask-irc-core/Network/IRC/Internal/Message/Types.hs b/hask-irc-core/Network/IRC/Internal/Message/Types.hs new file mode 100644 index 0000000..a7ebf60 --- /dev/null +++ b/hask-irc-core/Network/IRC/Internal/Message/Types.hs @@ -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 diff --git a/hask-irc-core/Network/IRC/Internal/Types.hs b/hask-irc-core/Network/IRC/Internal/Types.hs index 8b47ae8..329ee22 100644 --- a/hask-irc-core/Network/IRC/Internal/Types.hs +++ b/hask-irc-core/Network/IRC/Internal/Types.hs @@ -1,186 +1,24 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} module Network.IRC.Internal.Types where +import qualified Data.Configurator as CF + import ClassyPrelude import Control.Concurrent.Lifted (Chan) import Control.Monad.Base (MonadBase) import Control.Monad.Reader (ReaderT, MonadReader, runReaderT) import Control.Monad.State (StateT, MonadState, execStateT) 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 --- * 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 parser id. Should be unique. @@ -190,8 +28,8 @@ type MessageParserId = Text data MessagePart = MessagePart { msgPartParserId :: !MessageParserId , msgPartTarget :: !Text , msgPartTime :: !UTCTime - , msgPartLine :: !Text } - deriving (Eq, Show) + , msgPartLine :: !Text + } deriving (Eq, Show) -- | The result of parsing a message line. 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. 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 -- | Name of a message handler. @@ -286,24 +82,22 @@ data BotConfig = BotConfig } 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 (mapKeys msgHandlerInfo) + show BotConfig { .. } = "BotConfig[ server = " ++ show server ++ "\n" ++ + "port = " ++ show port ++ "\n" ++ + "channel = " ++ show channel ++ "\n" ++ + "nick = " ++ show botNick ++ "\n" ++ + "timeout = " ++ show botTimeout ++ "\n" ++ + "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 -> Int -- ^ port -> Text -- ^ channel -> Nick -- ^ botNick -> Int -- ^ botTimeout - -> Map MsgHandlerName (Map Text Text) -- ^ msgHandlerInfo - -> Config -- ^ config -> BotConfig -newBotConfig server port channel botNick botTimeout msgHandlerInfo = - BotConfig server port channel botNick botTimeout msgHandlerInfo [] [] [] +newBotConfig server port channel botNick botTimeout = + BotConfig server port channel botNick botTimeout mempty [] [] [] CF.empty -- | The bot. data Bot = Bot diff --git a/hask-irc-core/Network/IRC/Protocol.hs b/hask-irc-core/Network/IRC/Protocol.hs index d74140a..813c1b0 100644 --- a/hask-irc-core/Network/IRC/Protocol.hs +++ b/hask-irc-core/Network/IRC/Protocol.hs @@ -12,8 +12,8 @@ import Network.IRC.Types parseLine :: BotConfig -> UTCTime -> Text -> [MessagePart] -> (Maybe FullMessage, [MessagePart]) parseLine botConfig@BotConfig { .. } time line msgParts = - fromMaybe (Nothing, msgParts) . msum . flip map parsers $ \MessageParser { .. } -> let - (parserMsgParts, otherParserMsgParts) = partition ((msgParserId ==) . msgPartParserId) msgParts + fromMaybe (Nothing, msgParts) . msum . flip map parsers $ \MessageParser { .. } -> + let (parserMsgParts, otherParserMsgParts) = partition ((msgParserId ==) . msgPartParserId) msgParts in case msgParser botConfig time line parserMsgParts of Reject -> Nothing Partial msgParts' -> Just (Nothing, msgParts' ++ otherParserMsgParts) @@ -31,11 +31,11 @@ pingParser = MessageParser "ping" go parseMsgLine :: Text -> ([Text], Text, Text, Text, Text) parseMsgLine line = (splits, command, source, target, message) where - splits = words line - command = splits !! 1 - source = drop 1 $ splits !! 0 - target = splits !! 2 - message = strip . drop 1 . unwords . drop 3 $ splits + splits = words line + command = splits !! 1 + source = drop 1 $ splits !! 0 + target = splits !! 2 + message = strip . drop 1 . unwords . drop 3 $ splits lineParser :: MessageParser lineParser = MessageParser "line" go @@ -111,6 +111,6 @@ defaultCommandFormatter BotConfig { .. } command | Just (PrivMsgReply (User { .. }) msg) <- fromCommand command = Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg | Just NamesCmd <- fromCommand command = Just $ "NAMES " ++ channel - | otherwise = Nothing + | otherwise = Nothing where botNick' = nickToText botNick diff --git a/hask-irc-core/Network/IRC/Types.hs b/hask-irc-core/Network/IRC/Types.hs index 5e05934..4736079 100644 --- a/hask-irc-core/Network/IRC/Types.hs +++ b/hask-irc-core/Network/IRC/Types.hs @@ -68,4 +68,8 @@ module Network.IRC.Types , MsgHandlerMaker (..) ) where +import Network.IRC.Internal.Command.Types +import Network.IRC.Internal.Event.Types +import Network.IRC.Internal.Message.Types import Network.IRC.Internal.Types + diff --git a/hask-irc-core/hask-irc-core.cabal b/hask-irc-core/hask-irc-core.cabal index 3814550..548947b 100644 --- a/hask-irc-core/hask-irc-core.cabal +++ b/hask-irc-core/hask-irc-core.cabal @@ -74,7 +74,10 @@ library Network.IRC.Client, 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.Bot, Network.IRC.Handlers.Core diff --git a/hask-irc-runner/Network/IRC/Config.hs b/hask-irc-runner/Network/IRC/Config.hs index d45c085..3b2569c 100644 --- a/hask-irc-runner/Network/IRC/Config.hs +++ b/hask-irc-runner/Network/IRC/Config.hs @@ -16,22 +16,23 @@ instance Configured a => Configured [a] where loadBotConfig :: String -> IO BotConfig loadBotConfig configFile = do - eCfg <- try $ CF.load [CF.Required configFile] - case eCfg of + eConfig <- try $ CF.load [CF.Required configFile] + case eConfig of Left (ParseError _ _) -> error "Error while loading config" - Right cfg -> do + Right config -> 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 - botConfig <- newBotConfig <$> - CF.require cfg "server" <*> - CF.require cfg "port" <*> - CF.require cfg "channel" <*> - (Nick <$> CF.require cfg "nick") <*> - CF.require cfg "timeout" <*> - pure handlerInfo <*> - pure cfg - return botConfig { msgHandlerMakers = allMsgHandlerMakers } + botConfig <- newBotConfig <$> + CF.require config "server" <*> + CF.require config "port" <*> + CF.require config "channel" <*> + (Nick <$> CF.require config "nick") <*> + CF.require config "timeout" + return botConfig { msgHandlerInfo = handlerInfo + , msgHandlerMakers = allMsgHandlerMakers + , config = config + } case eBotConfig of Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k