summaryrefslogtreecommitdiff
path: root/Hsbot/Core.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-05-16 00:01:00 +0200
committerJulien Dessaux2010-05-16 00:01:00 +0200
commitc1662ba7b982a8502dc9f32031b7cb518df7f60e (patch)
treef00dbd9cb39bf0fbc20949105ea2b93d9e868070 /Hsbot/Core.hs
parentAdded the quote module. (diff)
downloadhsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.tar.gz
hsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.tar.bz2
hsbot-c1662ba7b982a8502dc9f32031b7cb518df7f60e.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.hs110
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 }