summaryrefslogtreecommitdiff
path: root/Hsbot/Irc/Core.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-05-24 22:46:20 +0200
committerJulien Dessaux2010-05-24 22:46:20 +0200
commita12e4927728c9907537b221257c5e2914f5f1c48 (patch)
tree8b8f2dcaa3e796e53767531d654c7e437437ff05 /Hsbot/Irc/Core.hs
parentCleaned the definition of irc plugins' data structure. (diff)
downloadhsbot-a12e4927728c9907537b221257c5e2914f5f1c48.tar.gz
hsbot-a12e4927728c9907537b221257c5e2914f5f1c48.tar.bz2
hsbot-a12e4927728c9907537b221257c5e2914f5f1c48.zip
Implemented ircbot update messages.
Diffstat (limited to 'Hsbot/Irc/Core.hs')
-rw-r--r--Hsbot/Irc/Core.hs46
1 files changed, 26 insertions, 20 deletions
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 2c455ce..1a51a5c 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -11,6 +11,7 @@ import Data.Time
import Network
import Prelude hiding (catch)
import System.IO
+import System.Posix.IO (handleToFd)
import Hsbot.Irc.Command
import Hsbot.Irc.Config
@@ -18,7 +19,7 @@ import Hsbot.Irc.Message
import Hsbot.Irc.Plugin
import Hsbot.Irc.Server
import Hsbot.Irc.Types
-import Hsbot.Message (BotMsg)
+import Hsbot.Message
-- | IrcBot's main entry point
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
@@ -29,8 +30,9 @@ startIrcbot config masterChan myChan = do
putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
hSetBuffering handle NoBuffering
- myOwnThreadId <- myThreadId
+ fd <- handleToFd handle
putStrLn "[IrcBot] Spawning reader threads..."
+ myOwnThreadId <- myThreadId
readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan
putStrLn "[IrcBot] Initializing server connection..."
@@ -49,10 +51,13 @@ startIrcbot config masterChan myChan = do
, ircBotHandle = handle
, ircBotConfig = config
, ircBotReaderThreadId = readerThreadId
- , ircBotMasterReaderThreadId = masterReaderThreadId }
+ , ircBotMasterReaderThreadId = masterReaderThreadId
+ , ircBotResumeData = M.singleton "HANDLE" (show fd) }
ircBotState' <- execStateT (initBotServerConnection config) ircBotState
- putStrLn "[IrcBot] Entering main loop... "
- _ <- ircBotLoop ircBotState' `catch` (\(_ :: IOException) -> return ())
+ putStrLn "[IrcBot] Spawning plugins..."
+ ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
+ putStrLn "[IrcBot] Entering Core loop... "
+ _ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState''))
return ()
--resumeIrcBot
@@ -89,28 +94,17 @@ initBotServerConnection config = do
ircServerState' <- execStateT (initServerConnection config) ircServerState
put $ ircBot { ircBotServerState = ircServerState' }
--- | IrcBot's loop that can catch ircbot's states' updates
-ircBotLoop :: IrcBotState -> IO ()
-ircBotLoop ircBotState = do
- putStrLn "[IrcBot] Spawning plugins..."
- ircBotState' <- execStateT spawnIrcPlugins ircBotState
- -- Todo : throw new ircbotstate to hsbot
- putStrLn "[IrcBot] Entering Core loop... "
- _ <- (execStateT ircBotCore ircBotState') -- `catch` (\(_ :: NewBotStateException) -> return ircBotState')
- return ()
- -- TODO : loop!
-
-- | Run the IrcBot's main loop
-ircBotCore :: IrcBot ()
-ircBotCore = forever $ do
- ircBot <- get
- let chan = ircBotChan ircBot
+ircBotLoop :: IrcBot ()
+ircBotLoop = forever $ do
+ chan <- gets ircBotChan
msg <- liftIO $ readChan chan
case msg of
InIrcMsg inIrcMsg -> dispatchMessage $ InIrcMsg inIrcMsg
OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
IntIrcCmd intIrcCmd -> do
processInternalCommand $ IntIrcCmd intIrcCmd
+ reportUpdate
where
sendThisMessage :: IrcMsg -> IrcBot ()
sendThisMessage outputMsg = do
@@ -143,3 +137,15 @@ dispatchMessage (InIrcMsg inIrcMsg) = do
getMsgContent = unwords . tail $ ircMsgParameters inIrcMsg
dispatchMessage _ = return ()
+-- | Reports an update to the master bot
+reportUpdate :: IrcBot ()
+reportUpdate = do
+ ircbot <- get
+ let masterChan = ircBotMasterChan ircbot
+ msg = IntMsg $ Msg { msgType = "UPDATE"
+ , msgFrom = ircConfigName $ ircBotConfig ircbot
+ , msgTo = "CORE"
+ , msgCmd = show $ ircBotResumeData ircbot
+ }
+ liftIO $ writeChan masterChan msg
+