summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
Diffstat (limited to 'Hsbot')
-rw-r--r--Hsbot/Core.hs78
-rw-r--r--Hsbot/Irc/Core.hs2
-rw-r--r--Hsbot/Irc/Types.hs2
-rw-r--r--Hsbot/Message.hs40
-rw-r--r--Hsbot/Plugin.hs35
-rw-r--r--Hsbot/PluginUtils.hs15
-rw-r--r--Hsbot/Types.hs50
7 files changed, 159 insertions, 63 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 772a31a..0ae337b 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -12,21 +12,9 @@ import Prelude hiding (catch)
import System.IO()
import Hsbot.Config
-import Hsbot.Irc.Config
-import Hsbot.Irc.Core
import Hsbot.Message
import Hsbot.Plugin
-
--- | 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, ThreadId) -- Loaded plugins
- , botChan :: Chan BotMsg -- The bot's communication channel
- , botConfig :: Config -- the bot's starting config
- }
+import Hsbot.Types
-- | Bot's main entry point
hsbot :: Config -> IO ()
@@ -34,38 +22,54 @@ hsbot config = do
startTime <- getCurrentTime
putStrLn "[Hsbot] Opening communication channel... "
chan <- newChan :: IO (Chan BotMsg)
+ putStrLn "[Hsbot] Spawning bot state manager... "
+ processUpdateChan <- newChan :: IO (Chan String)
+ reportUpdateChan <- newChan :: IO (Chan String)
+ updaterThreadId <- forkIO $ readUpdates processUpdateChan reportUpdateChan ""
putStrLn "[Hsbot] Spawning IrcBot plugins... "
- botState <- execStateT spawnIrcPlugins BotState { botStartTime = startTime
- , botPlugins = M.empty
- , botChan = chan
- , botConfig = config }
+ botState <- execStateT spawnIrcPlugins BotState { botStartTime = startTime
+ , botPlugins = M.empty
+ , botChan = chan
+ , botConfig = config
+ , botUpdateChan = processUpdateChan
+ , botResumeData = M.empty }
putStrLn "[Hsbot] Entering main loop... "
- botState' <- (execStateT botLoop botState) `catch` (\(_ :: IOException) -> return botState)
+ _ <- (execStateT botLoop botState) `catch` (\(_ :: IOException) -> return botState)
+ killThread updaterThreadId
+ resumeData <- readChan reportUpdateChan
+ print resumeData
return ()
-- | Run the bot main loop
botLoop :: Bot ()
botLoop = forever $ do
chan <- gets botChan
- msg <- liftIO $ readChan chan
- -- process messages
- return ()
+ msg <- liftIO $ readChan chan
+ case msg of
+ InMsg _ -> return ()
+ OutMsg _ -> return ()
+ IntMsg intMsg -> do
+ processInternalMessage $ IntMsg intMsg
+ reportUpdate
+
+-- | Reports an update to the master bot
+reportUpdate :: Bot ()
+reportUpdate = do
+ bot <- get
+ let updateChan = botUpdateChan bot
+ stuff = show $ botResumeData bot
+ liftIO $ writeChan updateChan stuff
--- | spawns IrcPlugins
-spawnIrcPlugins :: Bot ()
-spawnIrcPlugins = do
- config <- gets botConfig
- mapM_ (spawnIrcPlugin) (ircConfigs config)
+-- | Runs bot updates' manager thread
+readUpdates :: Chan String -> Chan String -> String -> IO ()
+readUpdates processChan reportChan resumeData = do
+ resumeData' <- (readChan processChan) `catch` handleException
+ readUpdates processChan reportChan resumeData'
where
- spawnIrcPlugin :: IrcConfig -> Bot ()
- spawnIrcPlugin config = do
- bot <- get
- let chan = botChan bot
- pchan <- liftIO (newChan :: IO (Chan BotMsg))
- threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
- let plugin = PluginState { pluginName = ircConfigName config
- , pluginChan = pchan
- , pluginHandles = M.empty }
- plugins = botPlugins bot
- put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
+ handleException :: AsyncException -> IO (String)
+ handleException _ = do
+ writeChan reportChan resumeData
+ myId <- myThreadId
+ killThread myId
+ return ""
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 1a51a5c..936ced6 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -19,7 +19,7 @@ import Hsbot.Irc.Message
import Hsbot.Irc.Plugin
import Hsbot.Irc.Server
import Hsbot.Irc.Types
-import Hsbot.Message
+import Hsbot.Types
-- | IrcBot's main entry point
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index 90bd728..440de64 100644
--- a/Hsbot/Irc/Types.hs
+++ b/Hsbot/Irc/Types.hs
@@ -14,7 +14,7 @@ import System.IO
import Hsbot.Irc.Config
import Hsbot.Irc.Message
import Hsbot.Irc.Plugin.Utils
-import Hsbot.Message
+import Hsbot.Types
-- | The Ircbot monad
type IrcBot = StateT IrcBotState IO
diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs
index 83d4c08..d2cb085 100644
--- a/Hsbot/Message.hs
+++ b/Hsbot/Message.hs
@@ -1,18 +1,36 @@
module Hsbot.Message
- ( BotMsg (..)
- , Msg (..)
- , processInternalMessage
+ ( processInternalMessage
) where
+import Control.Monad.State
+import qualified Data.Map as M
+
import Hsbot.PluginUtils
+import Hsbot.Types
+
+-- | Processes an internal message
+processInternalMessage :: BotMsg -> Bot ()
+processInternalMessage (IntMsg msg)
+ | msgTo msg == "CORE" = processCoreMessage msg
+ | otherwise = do
+ plugins <- gets botPlugins
+ case M.lookup (msgTo msg) plugins of
+ Just (plugin, _) -> sendToPlugin (IntMsg msg) plugin
+ Nothing -> return ()
+processInternalMessage _ = return ()
--- | A hsbot message
-data Msg = Msg
- { msgType :: String -- the message type
- , msgFrom :: String -- who issues it
- , msgTo :: String -- who it is destinated to
- , msgCmd :: String -- the message to be transfered
- } deriving (Show)
+processCoreMessage :: Msg -> Bot ()
+processCoreMessage msg = do
+ case msgCmd msg of
+ "UPDATE" -> processUpdateCommand msg
+ _ -> return ()
-data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
+-- | Process an update command
+processUpdateCommand :: Msg -> Bot ()
+processUpdateCommand msg = do
+ bot <- get
+ let oldData = botResumeData bot
+ from = msgFrom msg
+ stuff = msgCmd msg
+ put $ bot { botResumeData = M.insert from stuff oldData }
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 47dd0f5..aafa495 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -1,23 +1,32 @@
module Hsbot.Plugin
- ( Plugin
- , PluginState (..)
+ ( spawnIrcPlugins
) where
import Control.Concurrent
import Control.Concurrent.Chan ()
import Control.Monad.State
import qualified Data.Map as M
-import IO (Handle)
-import Hsbot.Message
+import Hsbot.Config
+import Hsbot.Irc.Config
+import Hsbot.Irc.Core
+import Hsbot.Types
--- | The Plugin monad
-type Plugin = StateT PluginState IO
-
--- | A plugin state
-data PluginState = PluginState
- { pluginName :: String -- The plugin's name
- , pluginChan :: Chan BotMsg -- The plugin chan
- , pluginHandles :: M.Map String Handle -- the plugins's handles
- }
+-- | spawns IrcPlugins
+spawnIrcPlugins :: Bot ()
+spawnIrcPlugins = do
+ config <- gets botConfig
+ mapM_ (spawnIrcPlugin) (ircConfigs config)
+ where
+ spawnIrcPlugin :: IrcConfig -> Bot ()
+ spawnIrcPlugin config = do
+ bot <- get
+ let chan = botChan bot
+ pchan <- liftIO (newChan :: IO (Chan BotMsg))
+ threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
+ let plugin = PluginState { pluginName = ircConfigName config
+ , pluginChan = pchan
+ , pluginHandles = M.empty }
+ plugins = botPlugins bot
+ put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
diff --git a/Hsbot/PluginUtils.hs b/Hsbot/PluginUtils.hs
new file mode 100644
index 0000000..d09b3b4
--- /dev/null
+++ b/Hsbot/PluginUtils.hs
@@ -0,0 +1,15 @@
+module Hsbot.PluginUtils
+ ( sendToPlugin
+ ) where
+
+import Control.Concurrent
+import Control.Concurrent.Chan ()
+import Control.Monad.State
+
+import Hsbot.Types
+
+-- | Sends a msg to a plugin
+sendToPlugin :: BotMsg -> PluginState -> Bot ()
+sendToPlugin botMsg plugin = do
+ liftIO $ writeChan (pluginChan plugin) botMsg
+
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
new file mode 100644
index 0000000..3afbff5
--- /dev/null
+++ b/Hsbot/Types.hs
@@ -0,0 +1,50 @@
+module Hsbot.Types
+ ( Bot
+ , BotMsg (..)
+ , BotState (..)
+ , Msg (..)
+ , Plugin
+ , PluginState (..)
+ ) where
+
+import Control.Concurrent
+import Control.Monad.State
+import qualified Data.Map as M
+import Data.Time
+import System.IO
+
+import Hsbot.Config
+
+-- | 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, ThreadId) -- Loaded plugins
+ , botChan :: Chan BotMsg -- the bot's communication channel
+ , botConfig :: Config -- the bot's starting config
+ , botUpdateChan :: Chan String -- the bot's chan to report updates on
+ , botResumeData :: M.Map String String -- the necessary data to resume the bot's operations on reboot
+ }
+
+-- | The Plugin monad
+type Plugin = StateT PluginState IO
+
+-- | A plugin state
+data PluginState = PluginState
+ { pluginName :: String -- The plugin's name
+ , pluginChan :: Chan BotMsg -- The plugin chan
+ , pluginHandles :: M.Map String Handle -- the plugins's handles
+ }
+
+-- | A hsbot message
+data Msg = Msg
+ { msgType :: String -- the message type
+ , msgFrom :: String -- who issues it
+ , msgTo :: String -- who it is destinated to
+ , msgCmd :: String -- the message to be transfered
+ } deriving (Show)
+
+data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg deriving (Show)
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 06:36:22 +0000