diff options
author | Julien Dessaux | 2010-05-16 00:01:00 +0200 |
---|---|---|
committer | Julien Dessaux | 2010-05-16 00:01:00 +0200 |
commit | c1662ba7b982a8502dc9f32031b7cb518df7f60e (patch) | |
tree | f00dbd9cb39bf0fbc20949105ea2b93d9e868070 /Hsbot/Core.hs | |
parent | Added the quote module. (diff) | |
download | hsbot-0.2.0.tar.gz hsbot-0.2.0.tar.bz2 hsbot-0.2.0.zip |
Rewrote nearly everything!v0.2.0
* Rewrote the whole architecture to achieve extreme modularity
* Added the ability to build a multiprotocol bot
* Added cabal integration
* Added configuration handling the XMonad style
* Added configuration in ~/.hsbot
* Refactored many many named and functions
* Refactored data structures
* Cleaned a big bunch of stuff
Diffstat (limited to '')
-rw-r--r-- | Hsbot/Core.hs | 110 |
1 files changed, 54 insertions, 56 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index ab2989a..cae873b 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -1,71 +1,69 @@ module Hsbot.Core - ( connectServer - , disconnectServer + ( hsbot ) where import Control.Concurrent -import Control.Concurrent.Chan() -import Control.Exception(IOException, catch) +import Control.Concurrent.Chan () +import Control.Exception import Control.Monad.State -import Data.List() import qualified Data.Map as M -import Network +import Data.Time import Prelude hiding (catch) -import System.IO -import System.Time (getClockTime) +import System.IO() -import Hsbot.IRCParser +import Hsbot.Config +import Hsbot.Irc.Config +import Hsbot.Irc.Core (ircbot) +import Hsbot.Message import Hsbot.Plugin -import Hsbot.Types -import Hsbot.Utils --- Connect to the server and return the initial bot state -connectServer :: IrcServer -> IO Bot -connectServer server = do - let name = serverAddress server - starttime <- getClockTime - putStr $ "Connecting to " ++ name ++ "... " - handle <- connectTo name $ serverPort server - hSetBuffering handle NoBuffering - putStrLn "done." - putStr "Opening server communication channel... " +-- | The Bot monad +type Bot = StateT BotState IO + +-- | An Hsbot state +data BotState = BotState + { botStartTime :: UTCTime -- the bot's uptime + , botPlugins :: M.Map String PluginState -- Loaded plugins + , botChan :: Chan BotMsg -- The bot's communication channel + , botConfig :: Config -- the bot's starting config + } + +-- | Bot's main entry point +hsbot :: Config -> IO () +hsbot config = do + startTime <- getCurrentTime + putStrLn "[Hsbot] Opening communication channel... " chan <- newChan :: IO (Chan BotMsg) - myFatherThreadId <- myThreadId - threadId <- forkIO $ botReader handle chan myFatherThreadId - putStrLn "done." - return $ Bot server starttime handle [] M.empty chan threadId M.empty + putStrLn "[Hsbot] Spawning IrcBot plugins... " + botState <- execStateT spawnIrcPlugins BotState { botStartTime = startTime + , botPlugins = M.empty + , botChan = chan + , botConfig = config } + putStrLn "[Hsbot] Entering main loop... " + botState' <- (execStateT botLoop botState) `catch` (\(_ :: IOException) -> return botState) + return () --- | Disconnect from the server -disconnectServer :: IrcBot () -disconnectServer = do - bot <- get - let name = serverAddress $ serverConfig bot - liftIO $ putStr "Shutting down plugins..." - mapM_ unloadPlugin (M.keys $ botPlugins bot) - liftIO $ putStrLn"done." - liftIO $ putStr "Closing server communication channel... " - liftIO . killThread $ readerThreadId bot - liftIO $ putStrLn "done." - liftIO . putStr $ "Disconnecting from " ++ name ++ "... " - liftIO . hClose $ botHandle bot - liftIO $ putStrLn "done." +-- | Run the bot main loop +botLoop :: Bot () +botLoop = forever $ do + chan <- gets botChan + msg <- liftIO $ readChan chan + -- process messages + return () --- | Socket reading loop -botReader :: Handle -> Chan BotMsg -> ThreadId -> IO () -botReader handle chan fatherThreadId = forever $ do - str <- (hGetLine handle) `catch` handleIOException - let msg = parseIrcMsg str - case msg of - Right msg' -> do - trace $ inColor ("<-- " ++ (show msg')) [33] - writeChan chan (InputMsg msg') - _ -> do - return () +-- | spawns IrcPlugins +spawnIrcPlugins :: Bot () +spawnIrcPlugins = do + config <- gets botConfig + mapM_ (spawnIrcPlugin) (ircConfigs config) where - handleIOException :: IOException -> IO (String) - handleIOException ioException = do - throwTo fatherThreadId ioException - myId <- myThreadId - killThread myId - return "" + spawnIrcPlugin :: IrcConfig -> Bot () + spawnIrcPlugin config = do + bot <- get + let chan = botChan bot + pchan <- liftIO (newChan :: IO (Chan BotMsg)) + threadId <- liftIO $ forkIO (ircbot config chan pchan) + let plugin = PluginState (ircConfigName config) threadId pchan M.empty + plugins = botPlugins bot + put $ bot { botPlugins = M.insert (pluginName plugin) plugin plugins } |