blob: 772a31a83ac6858be3113c7603e2c0894e06dd56 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
module Hsbot.Core
( hsbot
) where
import Control.Concurrent
import Control.Concurrent.Chan ()
import Control.Exception
import Control.Monad.State
import qualified Data.Map as M
import Data.Time
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
}
-- | Bot's main entry point
hsbot :: Config -> IO ()
hsbot config = do
startTime <- getCurrentTime
putStrLn "[Hsbot] Opening communication channel... "
chan <- newChan :: IO (Chan BotMsg)
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 ()
-- | Run the bot main loop
botLoop :: Bot ()
botLoop = forever $ do
chan <- gets botChan
msg <- liftIO $ readChan chan
-- process messages
return ()
-- | 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 }
|
