From 11c2c16835b3e8368be77ccc5b7ddf949021eccd Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sat, 3 Jul 2010 21:26:00 +0200 Subject: Moved files around as a preliminary for architectural changes. --- Hsbot/Core.hs | 91 ----------------------------------------------------------- 1 file changed, 91 deletions(-) delete mode 100644 Hsbot/Core.hs (limited to 'Hsbot/Core.hs') diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs deleted file mode 100644 index dad965d..0000000 --- a/Hsbot/Core.hs +++ /dev/null @@ -1,91 +0,0 @@ -module Hsbot.Core - ( hsbot - ) where - -import Control.Concurrent.Chan -import Control.Concurrent.MVar -import Control.Exception -import Control.Monad.State -import qualified Data.Map as M -import Data.Time -import Prelude hiding (catch) -import System.IO() -import System.Posix.Signals - -import Hsbot.Config -import Hsbot.Message -import Hsbot.Plugin -import Hsbot.Types - --- | Bot's main entry point -hsbot :: [BotConfig] -> Maybe String -> IO () -hsbot config txtResumeData= do - let resumeData = case txtResumeData of - Just txtData -> read txtData :: BotResumeData -- TODO : catch exception - Nothing -> M.empty :: BotResumeData - startTime <- case M.lookup "HSBOT" resumeData of - Just hsbotData -> do - case M.lookup "STARTTIME" hsbotData of - Just txtStartTime -> do - let gotStartTime = read txtStartTime :: UTCTime - return gotStartTime - Nothing -> getCurrentTime - Nothing -> getCurrentTime - let resumeData' = M.insert "HSBOT" (M.singleton "STARTTIME" $ show startTime) resumeData - putStrLn "[Hsbot] Opening communication channel... " - chan <- newChan :: IO (Chan BotMsg) - mvar <- newMVar resumeData' :: IO (MVar BotResumeData) - putStrLn "[Hsbot] Installing signal handlers... " - _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing - _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing - putStrLn "[Hsbot] Spawning IrcBot plugins... " - botState <- execStateT spawnPlugins BotState { botStartTime = startTime - , botPlugins = M.empty - , botChan = chan - , botConfig = config - , botResumeData = mvar } - putStrLn "[Hsbot] Entering main loop... " - (status, botState') <- runLoop botState - putStrLn "[Hsbot] Killing active plugins... " - newResumeData <- takeMVar mvar - evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState' - if status == BotReboot - then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string - else return () - where - runLoop :: BotState -> IO (BotStatus, BotState) - runLoop botState = do - (status, botState') <- (runStateT botCore botState) `catches` [ Handler (\ (_ :: IOException) -> return (BotExit, botState)) - , Handler (\ (_ :: AsyncException) -> return (BotExit, botState)) ] - case status of - BotContinue -> runLoop botState' - _ -> return (status, botState') - --- | Run the bot main loop -botCore :: Bot (BotStatus) -botCore = do - chan <- gets botChan - msg <- liftIO $ readChan chan - case msg of - IntMsg intMsg -> processInternalMessage intMsg - UpdMsg updMsg -> processUpdateMessage updMsg - RebMsg rebMsg -> processRebootMessage rebMsg - ExiMsg exiMsg -> processExitMessage exiMsg - --- | Process an update command -processUpdateMessage :: ResumeMsg -> Bot (BotStatus) -processUpdateMessage msg = do - resumeData <- gets botResumeData - let from = resMsgFrom msg - stuff = resMsgData msg - liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData) - return BotContinue - --- | signals handlers -sigHupHandler :: Chan BotMsg -> IO () -sigHupHandler chan = writeChan chan $ RebMsg RebootMsg { rebMsgFrom = "HUP handler" } - --- | signals handlers -sigTermHandler :: Chan BotMsg -> IO () -sigTermHandler chan = writeChan chan $ ExiMsg ExitMsg { exiMsgFrom = "TERM handler" } - -- cgit v1.2.3