Wrote most of the resume code for the core and the irc plugin.

6 files changed, 57 insertions, 50 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index b6c4d9c..dad965d 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -18,12 +18,23 @@ import Hsbot.Plugin
 import Hsbot.Types
 
 -- | Bot's main entry point
-hsbot :: [BotConfig] -> IO ()
-hsbot config = do
-    startTime <- getCurrentTime
+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 M.empty :: IO (MVar BotResumeData)
+    mvar <- newMVar resumeData' :: IO (MVar BotResumeData)
     putStrLn "[Hsbot] Installing signal handlers... "
     _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
     _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
@@ -36,10 +47,10 @@ hsbot config = do
     putStrLn "[Hsbot] Entering main loop... "
     (status, botState') <- runLoop botState
     putStrLn "[Hsbot] Killing active plugins... "
-    resumeData <- takeMVar mvar
-    evalStateT (mapM_ killPlugin $ M.keys resumeData) botState'
+    newResumeData <- takeMVar mvar
+    evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState'
     if status == BotReboot
-      then resumeHsbot resumeData
+      then hsbot config (Just $ show newResumeData)  -- TODO : exec on the hsbot launcher with the reload string
       else return ()
   where
     runLoop :: BotState -> IO (BotStatus, BotState)
@@ -50,10 +61,6 @@ hsbot config = do
             BotContinue -> runLoop botState'
             _           -> return (status, botState')
 
-resumeHsbot :: BotResumeData -> IO ()
-resumeHsbot resumeData = do
-    print resumeData
-
 -- | Run the bot main loop
 botCore :: Bot (BotStatus)
 botCore = do
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 51032a8..d65e975 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -7,11 +7,11 @@ import Control.Exception (AsyncException, Handler (..), IOException, catch, catc
 import Control.Monad.State
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
-import Data.Time
 import Network
 import Prelude hiding (catch)
 import System.IO
-import System.Posix.IO (handleToFd)
+import System.Posix.IO (fdToHandle, handleToFd)
+import System.Posix.Types (Fd)
 
 import Hsbot.Irc.Command
 import Hsbot.Irc.Config
@@ -22,14 +22,24 @@ import Hsbot.Irc.Types
 import Hsbot.Types
 
 -- | IrcBot's main entry point
-startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
-startIrcbot config masterChan myChan = do
-    startTime <- getCurrentTime
+startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> Maybe String -> IO ()
+startIrcbot config masterChan myChan txtResumeData = do
+    let resumeData = case txtResumeData of
+            Just txtData -> read txtData :: ResumeData  -- TODO : catch exception
+            Nothing -> M.empty :: ResumeData
+    print resumeData
     putStrLn "[IrcBot] Opening communication channel... "
     chan <- newChan :: IO (Chan IrcBotMsg)
-    putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
-    handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
-    hSetBuffering handle NoBuffering
+    handle <- case M.lookup "HANDLE" resumeData of
+        Just txtFd -> do
+            let fd = read txtFd :: Fd
+            fdToHandle fd
+        Nothing -> do
+            putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
+            handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
+            hSetBuffering handle NoBuffering
+            hSetEncoding handle utf8
+            return handle
     fd <- handleToFd handle
     putStrLn "[IrcBot] Spawning reader threads..."
     myOwnThreadId  <- myThreadId
@@ -41,8 +51,7 @@ startIrcbot config masterChan myChan = do
                                         , ircServerNickname      = ircConfigNickname config
                                         , ircServerCommandPrefix = ircConfigCommandPrefix config
                                         , ircServerChan          = chan }
-        ircBotState = IrcBotState { ircBotStartTime            = startTime
-                                  , ircBotPlugins              = M.empty
+        ircBotState = IrcBotState { ircBotPlugins              = M.empty
                                   , ircBotCommands             = M.empty
                                   , ircBotChan                 = chan
                                   , ircBotMasterChan           = masterChan
@@ -60,8 +69,8 @@ startIrcbot config masterChan myChan = do
     killThread readerThreadId
     killThread masterReaderThreadId
     putStrLn "[IrcBot] Killing active plugins... "
-    let resumeData = ircBotResumeData ircBotState'''
-        ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String]
+    let resumeData' = ircBotResumeData ircBotState'''
+        ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData')) :: [String]
     evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
     return ()
 
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index 4b75085..63411df 100644
--- a/Hsbot/Irc/Types.hs
+++ b/Hsbot/Irc/Types.hs
@@ -9,7 +9,6 @@ module Hsbot.Irc.Types
 import Control.Concurrent
 import Control.Monad.State
 import qualified Data.Map as M
-import Data.Time
 import System.IO
 
 import Hsbot.Irc.Config
@@ -22,8 +21,7 @@ type IrcBot = StateT IrcBotState IO
 
 -- | An Ircbot state
 data IrcBotState = IrcBotState
-    { ircBotStartTime            :: UTCTime                 -- the bot's uptime
-    , ircBotPlugins              :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins
+    { ircBotPlugins              :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins
     , ircBotCommands             :: M.Map String [String]   -- Loaded plugins
     , ircBotChan                 :: Chan IrcBotMsg          -- The IrcBot's communication channel
     , ircBotMasterChan           :: Chan BotMsg             -- The Hsbot communication channel
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 3feffa8..1493c73 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -11,6 +11,7 @@ import Control.Concurrent.MVar
 import Control.Exception
 import Control.Monad.State
 import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
 import Prelude hiding (catch)
 
 import Hsbot.Config
@@ -28,17 +29,20 @@ spawnPlugins = do
 spawnPlugin :: BotConfig -> Bot ()
 spawnPlugin (IrcBotConfig ircConfig) = do
     bot <- get
-    let chan  = botChan bot
+    let mvar = botResumeData bot
+        name = ircConfigName ircConfig
+    resumeData <- liftIO $ takeMVar mvar
+    let pluginResumeData = fromMaybe M.empty $ M.lookup name resumeData
+        chan = botChan bot
     pchan <- liftIO (newChan :: IO (Chan BotMsg))
-    mvar  <- liftIO newEmptyMVar
-    threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan) (putMVar mvar ())
-    let plugin  = PluginState { pluginName    = ircConfigName ircConfig
+    pluginMVar <- liftIO newEmptyMVar
+    threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ())
+    let plugin  = PluginState { pluginName    = name
                               , pluginChan    = pchan
                               , pluginHandles = M.empty }
         plugins = botPlugins bot
-    put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, mvar, threadId) plugins }
-    resumeData <- gets botResumeData
-    liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert (ircConfigName ircConfig) M.empty oldData)
+    put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins }
+    liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
 
 -- | Unloads a plugin
 unloadPlugin :: String -> Bot ()
diff --git a/TODO b/TODO
index c457ed4..9e9f3c0 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,9 @@
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
+* Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
+* Design another way to launch and manage hsbot and it's configuration
 * Find a way to handle bot reloading threw exec
+* Find a way so that not a single message/information would be lost in the case of a reboot
 
 * write the vote system for the quote module
 * only the quote reporter should be able to edit it
@@ -20,10 +23,8 @@
 * add register for casual conversations for plugins?
 * add a "I have stuff to save so don't kill me too hard" status for plugins
 
-* Handle unix signals properly
 * Make the bot auto-reconnect (/!\ admin plugin!)
 * discard all trace with a color param and replace those with functions info/warn/error/debug
 * write a safe reload : try reload before unloading
 * remove from Types.hs what can be removed from it
 
-
diff --git a/hsbot.cabal b/hsbot.cabal
index 9fb8549..fcf5533 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -1,5 +1,5 @@
 name: hsbot
-version: 0.1.0
+version: 0.2.1
 cabal-version: >= 1.8
 build-type: Simple
 license: BSD3
@@ -20,20 +20,10 @@ Executable hsbot
   Main-Is: Main.hs
   ghc-options: -Wall
   extensions: DeriveDataTypeable ScopedTypeVariables
-  build-depends: base >= 4.1,
-                 containers >= 0.3,
+  build-depends: base >= 4.1 && < 5,
                  directory >= 1.0,
                  filepath >= 1.1,
-                 ghc >= 6.12,
-                 haskell98 >= 1.0,
-                 mtl >= 1.1,
-                 network >= 2.2,
-                 old-time >= 1.0,
-                 parsec >= 3.1,
                  process >= 1.0,
-                 random >= 1.0,
-                 text >= 0.7,
-                 time >= 1.1,
                  unix >= 2.4
 
 Library
@@ -58,15 +48,13 @@ Library
                  Hsbot.Types
   ghc-options: -Wall
   extensions: DeriveDataTypeable ScopedTypeVariables
-  build-depends: base >= 4.1,
+  build-depends: base >= 4.1 && < 5,
                  containers >= 0.3,
                  directory >= 1.0,
                  filepath >= 1.1,
-                 ghc >= 6.12,
                  haskell98 >= 1.0,
                  mtl >= 1.1,
                  network >= 2.2,
-                 old-time >= 1.0,
                  parsec >= 3.1,
                  random >= 1.0,
                  text >= 0.7,