summaryrefslogtreecommitdiff
path: root/Hsbot/Core.hs
blob: 025e0c5f6492ca23c300572fee3531dc430f7faa (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.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 Hsbot.Config
import Hsbot.Message
import Hsbot.Plugin
import Hsbot.Types

-- | Bot's main entry point
hsbot :: [BotConfig] -> IO ()
hsbot config = do
    startTime <- getCurrentTime
    putStrLn "[Hsbot] Opening communication channel... "
    chan <- newChan :: IO (Chan BotMsg)
    mvar <- newMVar M.empty :: IO (MVar BotResumeData)
    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... "
    resumeData <- takeMVar mvar
    evalStateT (mapM_ killPlugin $ M.keys resumeData) botState'
    if status == BotReboot
      then resumeHsbot resumeData
      else return ()
  where
    runLoop :: BotState -> IO (BotStatus, BotState)
    runLoop botState = do
        (status, botState') <- (runStateT botCore botState) `catch` (\(_ :: IOException) -> return (BotExit, botState))
        case status of
            BotContinue -> runLoop botState'
            _           -> return (status, botState')

resumeHsbot :: BotResumeData -> IO ()
resumeHsbot resumeData = do
    print resumeData

-- | Run the bot main loop
botCore :: Bot (BotStatus)
botCore = do
    chan <- gets botChan
    msg  <- liftIO $ readChan chan
    case msg of
        InMsg  _      -> return BotContinue
        OutMsg _      -> return BotContinue
        IntMsg intMsg -> processInternalMessage $ IntMsg intMsg
        UpdMsg updMsg -> processUpdateMessage updMsg

-- | 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