diff options
Diffstat (limited to 'Hsbot/Core.hs')
| -rw-r--r-- | Hsbot/Core.hs | 152 |
1 files changed, 21 insertions, 131 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index 41340ba..b0efc03 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -1,17 +1,6 @@ module Hsbot.Core - ( Bot(..) - , Channel(..) - , Config(..) - , IrcServer(..) - , IrcBot - , IrcMsg(..) - , Plugin(..) - , connectServer + ( connectServer , disconnectServer - , inColor - , serializeIrcMsg - , traceM - , writeMsg ) where import Control.Concurrent @@ -20,82 +9,11 @@ import Control.Monad.State import Data.List import Network import System.IO -import System.Plugins -import System.Time (ClockTime, getClockTime) +import System.Time (getClockTime) --- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot? - --- | Configuration data type -data Config = Config { - commandPrefixes :: String, -- command prefixes, for example @[\'>\',\'@\',\'?\']@ - ircServer :: IrcServer -- list of 'Server's to connect to -} deriving (Show) - --- | An IRC server -data IrcServer = IrcServer - { address :: String -- the server's address - , port :: PortID -- the server's port - , channels :: [String] -- a list of channels to join - , nickname :: String -- the hsbot's nickname - , password :: String -- the hsbot's password, optional - , realname :: String -- the hsbot's real name, optional - , administrators :: [String] -- bot admins nicknames - } - -instance Show IrcServer where - show (IrcServer a p c n pa r ad) = (show a) - ++ (case p of - PortNumber num -> show num - Service s -> show s - UnixSocket u -> show u) - ++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad) - --- instance Show PortID where --- show (PortNumber n) = show n --- show (Service s) = show s --- show (UnixSocket g) = show g - --- | The IrcBot monad -type IrcBot a = StateT Bot IO a - --- | An IRC Bot server state -data Bot = Bot - { serverConfig :: IrcServer -- original server config we are connected to - , startTime :: ClockTime -- the bot's uptime - , botHandle :: Handle -- the socket/handle - , chans :: [Channel] -- the list of channels we have joined - , botPlugins :: [Plugin] -- The list of loaded plugins - , serverChannel :: Chan IrcMsg -- The bot's communication channel - , serverThreadId :: ThreadId -- The bot's thread ID - } - -instance Show Bot where - show (Bot _ s h c p _ _) = (show s) ++ (show h) ++ (show c) ++ (show p) - --- | A channel connection -data Channel = Channel - { channelName :: String -- the channel's name - , channelNick :: String -- our nickname - , channelAdmins :: [String] -- the bot administrators - } deriving (Show) - --- |An IRC message. -data IrcMsg = IrcMsg - { prefix :: Maybe String -- the message prefix - , command :: String -- the message command - , parameters :: [String] -- the message parameters - } deriving (Show) - --- | A plugin definition -data Plugin = Plugin - { pluginName :: String -- The plugin's name - , pluginModule :: Module -- The plugin himself - , pluginThreadId :: ThreadId -- The plugin thread - , pluginChannel :: Chan IrcMsg -- The plugin channel - } - -instance Show Plugin where - show (Plugin name _ _ _) = show name +import Hsbot.IRCParser +import Hsbot.Types +import Hsbot.Utils -- Connect to the server and return the initial bot state connectServer :: IrcServer -> IO Bot @@ -107,57 +25,29 @@ connectServer server = do hSetBuffering handle NoBuffering putStrLn "done." putStr $ "Opening server communication channel... " - chan <- newChan :: IO (Chan IrcMsg) - threadId <- forkIO $ botWriter handle chan + chan <- newChan :: IO (Chan BotMsg) + threadId <- forkIO $ botReader handle chan putStrLn "done." return (Bot server starttime handle [] [] chan threadId) -- | Disconnect from the server disconnectServer :: Bot -> IO () -- IO Bot ? disconnectServer bot = do - killThread $ serverThreadId bot + killThread $ readerThreadId bot + mapM_ (killThread . pluginThreadId) (botPlugins bot) hClose $ botHandle bot return () --- | Processing loop -botWriter :: Handle -> Chan IrcMsg -> IO () -botWriter handle chan = forever $ do - input <- readChan chan :: IO IrcMsg - sendstr handle (serializeIrcMsg input) - --- | Write an IRC message to the bot's writer -writeMsg :: IrcMsg -> IrcBot () -writeMsg msg = do - chan <- gets serverChannel - liftIO $ writeChan chan msg - --- |Serialize an IRC message to a string. -serializeIrcMsg :: IrcMsg -> String -serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr - where pfxStr = case pfx of - Nothing -> "" - Just pfx' -> ":" ++ pfx' ++ " " - paramStr = concat (map paramToStr (init params) - ++ [lastParamToStr (last params)]) - paramToStr p = " " ++ p - lastParamToStr p = " :" ++ p - --- | Send a string over handle -sendstr :: Handle -> String -> IO () -sendstr handle str = do - trace $ inColor ("--> " ++ str) [33] - hPutStr handle (str ++ "\r\n") - --- | Log a message string -trace :: String -> IO () -trace msg = putStrLn msg - --- | Log a message string -traceM :: String -> IrcBot () -traceM msg = liftIO $ putStrLn msg - --- |Wrap a string with ANSI escape sequences. -inColor :: String -> [Int] -> String -inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m" - where valstr = concat $ intersperse ";" $ map show vals +-- | Socket reading loop +botReader :: Handle -> Chan BotMsg -> IO () +botReader handle chan = forever $ do + -- TODO : detect end of connection! + str <- hGetLine handle + let msg = parseIrcMsg str + case msg of + Right msg' -> do + trace $ inColor ("<-- " ++ (show msg')) [33] + writeChan chan (InputMsg msg') + _ -> do + return () |