Reorganized code and types, changed slightly the architecture.

7 files changed, 245 insertions, 163 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 41340ba..b0efc03 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -1,17 +1,6 @@
 module Hsbot.Core
-    ( Bot(..)
-    , Channel(..)
-    , Config(..)
-    , IrcServer(..)
-    , IrcBot
-    , IrcMsg(..)
-    , Plugin(..)
-    , connectServer
+    ( connectServer
     , disconnectServer
-    , inColor
-    , serializeIrcMsg
-    , traceM
-    , writeMsg
     ) where
 
 import Control.Concurrent
@@ -20,82 +9,11 @@ import Control.Monad.State
 import Data.List
 import Network
 import System.IO
-import System.Plugins
-import System.Time (ClockTime, getClockTime)
+import System.Time (getClockTime)
 
--- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
-
--- | Configuration data type
-data Config = Config {
-   commandPrefixes :: String,   -- command prefixes, for example @[\'>\',\'@\',\'?\']@
-   ircServer       :: IrcServer -- list of 'Server's to connect to
-} deriving (Show)
-
--- | An IRC server
-data IrcServer = IrcServer
-    { address        :: String   -- the server's address
-    , port           :: PortID   -- the server's port
-    , channels       :: [String] -- a list of channels to join
-    , nickname       :: String   -- the hsbot's nickname
-    , password       :: String   -- the hsbot's password, optional
-    , realname       :: String   -- the hsbot's real name, optional
-    , administrators :: [String] -- bot admins nicknames
-    }
-
-instance Show IrcServer where
-    show (IrcServer a p c n pa r ad) = (show a)
-                                        ++ (case p of
-                                            PortNumber num -> show num
-                                            Service s      -> show s
-                                            UnixSocket u   -> show u)
-                                        ++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad)
-
--- instance Show PortID where
---     show (PortNumber n) = show n
---     show (Service s)    = show s
---     show (UnixSocket g) = show g
-
--- | The IrcBot monad
-type IrcBot a = StateT Bot IO a
-
--- | An IRC Bot server state
-data Bot = Bot
-    { serverConfig   :: IrcServer   -- original server config we are connected to
-    , startTime      :: ClockTime   -- the bot's uptime
-    , botHandle      :: Handle      -- the socket/handle
-    , chans          :: [Channel]   -- the list of channels we have joined
-    , botPlugins     :: [Plugin]    -- The list of loaded plugins
-    , serverChannel  :: Chan IrcMsg -- The bot's communication channel
-    , serverThreadId :: ThreadId    -- The bot's thread ID
-    }
-
-instance Show Bot where
-    show (Bot _ s h c p _ _) = (show s) ++ (show h) ++ (show c) ++ (show p)
-
--- | A channel connection
-data Channel = Channel
-    { channelName   :: String   -- the channel's name
-    , channelNick   :: String   -- our nickname
-    , channelAdmins :: [String] -- the bot administrators
-    } deriving (Show)
-
--- |An IRC message.
-data IrcMsg = IrcMsg
-    { prefix     :: Maybe String -- the message prefix
-    , command    :: String       -- the message command
-    , parameters :: [String]     -- the message parameters
-    } deriving (Show)
-
--- | A plugin definition
-data Plugin = Plugin
-    { pluginName     :: String      -- The plugin's name
-    , pluginModule   :: Module      -- The plugin himself
-    , pluginThreadId :: ThreadId    -- The plugin thread
-    , pluginChannel  :: Chan IrcMsg -- The plugin channel
-    }
-
-instance Show Plugin where
-    show (Plugin name _ _ _) = show name
+import Hsbot.IRCParser
+import Hsbot.Types
+import Hsbot.Utils
 
 -- Connect to the server and return the initial bot state
 connectServer :: IrcServer -> IO Bot
@@ -107,57 +25,29 @@ connectServer server = do
     hSetBuffering handle NoBuffering
     putStrLn "done."
     putStr $ "Opening server communication channel... "
-    chan <- newChan :: IO (Chan IrcMsg)
-    threadId <- forkIO $ botWriter handle chan
+    chan <- newChan :: IO (Chan BotMsg)
+    threadId <- forkIO $ botReader handle chan
     putStrLn "done."
     return (Bot server starttime handle [] [] chan threadId)
 
 -- | Disconnect from the server
 disconnectServer :: Bot -> IO ()    -- IO Bot ?
 disconnectServer bot = do
-    killThread $ serverThreadId bot
+    killThread $ readerThreadId bot
+    mapM_ (killThread . pluginThreadId) (botPlugins bot)
     hClose $ botHandle bot
     return ()
 
--- | Processing loop
-botWriter :: Handle -> Chan IrcMsg -> IO ()
-botWriter handle chan = forever $ do
-    input <- readChan chan :: IO IrcMsg
-    sendstr handle (serializeIrcMsg input)
-
--- | Write an IRC message to the bot's writer
-writeMsg :: IrcMsg -> IrcBot ()
-writeMsg msg = do
-    chan <- gets serverChannel
-    liftIO $ writeChan chan msg
-
--- |Serialize an IRC message to a string.
-serializeIrcMsg :: IrcMsg -> String
-serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr
-    where pfxStr = case pfx of
-                        Nothing  -> ""
-                        Just pfx' -> ":" ++ pfx' ++ " "
-          paramStr = concat (map paramToStr (init params)
-                             ++ [lastParamToStr (last params)])
-          paramToStr p = " " ++ p
-          lastParamToStr p = " :" ++ p
-
--- | Send a string over handle
-sendstr :: Handle -> String -> IO ()
-sendstr handle str = do
-    trace $ inColor ("--> " ++ str) [33]
-    hPutStr handle (str ++ "\r\n")
-
--- | Log a message string
-trace :: String -> IO ()
-trace msg = putStrLn msg
-
--- | Log a message string
-traceM :: String -> IrcBot ()
-traceM msg = liftIO $ putStrLn msg
-
--- |Wrap a string with ANSI escape sequences.
-inColor :: String -> [Int] -> String
-inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m"
-    where valstr = concat $ intersperse ";" $ map show vals
+-- | Socket reading loop
+botReader :: Handle -> Chan BotMsg -> IO ()
+botReader handle chan = forever $ do
+    -- TODO : detect end of connection!
+    str <- hGetLine handle
+    let msg = parseIrcMsg str
+    case msg of
+        Right msg' -> do
+            trace $ inColor ("<-- " ++ (show msg')) [33]
+            writeChan chan (InputMsg msg')
+        _ -> do
+            return ()
 
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index d3a3114..3fe2181 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -5,50 +5,38 @@ module Hsbot.IRC
 
 import Control.Concurrent.Chan
 import Control.Monad.State
-import System.IO
 
-import Hsbot.Core
 import Hsbot.IRCParser
+import Hsbot.Plugin
+import Hsbot.Types
+import Hsbot.Utils
 
 -- | Setup a newly connected server by sending nick and join stuff
 initServer :: IrcBot ()
 initServer = do
     server <- gets serverConfig
-    writeMsg $ IrcMsg Nothing "NICK" [(nickname server)]
-    writeMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
+    sendstr $ serializeIrcMsg $ IrcMsg Nothing "NICK" [(nickname server)]
+    sendstr $ serializeIrcMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
     when (not . null $ password server) $ do
-        writeMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
-    joinChans
-    return ()
+        sendstr $ serializeIrcMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
+    mapM_ joinChan (channels server)
 
 -- | Run a server
 runServer :: IrcBot ()
 runServer = do
-    handle <- gets botHandle
+    chan    <- gets botChannel
     plugins <- gets botPlugins
-    str <- liftIO $ hGetLine handle
-    traceM $ inColor ("<-- " ++ str) [33]
-    let msg = parseIrcMsg str
+    let input = readChan chan
+    msg <- liftIO input
     case msg of
-        Right msg' -> do
-            mapM_ (sendPlugin msg') plugins
-            return ()
-        _ -> do
-            return ()
-    traceM $ show msg
+        InputMsg inputMsg ->
+            mapM_ (sendToPlugin $ InputMsg inputMsg) plugins
+        OutputMsg outputMsg ->
+            sendstr (serializeIrcMsg outputMsg)
+        InternalCmd internalCmd ->
+            traceM "TODO"
     runServer
 
-sendPlugin :: IrcMsg -> Plugin -> IrcBot ()
-sendPlugin msg plugin = do
-    let chan = pluginChannel plugin
-    liftIO $ writeChan chan msg
-
--- | Join chans
-joinChans :: IrcBot ()
-joinChans = do
-    server <- gets serverConfig
-    mapM_ joinChan (channels server)
-
 -- | Joins a chan
 joinChan :: String -> IrcBot ()
 joinChan name = do
@@ -57,7 +45,6 @@ joinChan name = do
         newChannel  = Channel name
                               (nickname $ serverConfig bot)
                               (administrators $ serverConfig bot)
-    traceM $ "  Joining " ++ name
-    writeMsg $ IrcMsg Nothing "JOIN" [name]
+    sendstr $ serializeIrcMsg $ IrcMsg Nothing "JOIN" [name]
     put $ bot { chans = newChannel : oldChannels }
 
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
index 5c1034e..ebf8f71 100644
--- a/Hsbot/IRCParser.hs
+++ b/Hsbot/IRCParser.hs
@@ -1,13 +1,13 @@
 module Hsbot.IRCParser
     ( ParseError
     , parseIrcMsg
+    , serializeIrcMsg
     ) where
 
 import Control.Monad.Identity
--- import Data.List
 import Text.Parsec
 
-import Hsbot.Core
+import Hsbot.Types
 
 -- | Parses an IrcInput
 parseIrcMsg :: String -> Either ParseError IrcMsg
@@ -38,3 +38,14 @@ pLongParam = char ':' >> (many1 (noneOf "\r"))
 pShortParam :: ParsecT String u Identity [Char]
 pShortParam = many1 (noneOf " \r")
 
+-- |Serialize an IRC message to a string.
+serializeIrcMsg :: IrcMsg -> String
+serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr
+    where pfxStr = case pfx of
+                        Nothing  -> ""
+                        Just pfx' -> ":" ++ pfx' ++ " "
+          paramStr = concat (map paramToStr (init params)
+                             ++ [lastParamToStr (last params)])
+          paramToStr p = " " ++ p
+          lastParamToStr p = " :" ++ p
+
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index 3cb0ce5..c73a2e5 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -9,6 +9,7 @@ import Config
 import Hsbot.Core
 import Hsbot.IRC
 import Hsbot.Plugin
+import Hsbot.Types
 
 -- | Bot's main entry point
 imain :: IO ()
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
new file mode 100644
index 0000000..662f8e9
--- /dev/null
+++ b/Hsbot/Plugin.hs
@@ -0,0 +1,56 @@
+module Hsbot.Plugin
+    ( loadPlugin
+    , sendToPlugin
+    ) where
+
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Monad.State
+import System.IO
+import System.Plugins
+
+import Hsbot.Types
+import Hsbot.Utils
+
+-- | Loads a plugin into an ircBot
+loadPlugin :: String -> IrcBot ()
+loadPlugin name = do
+    bot <- get
+    plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
+    case plugin of
+        Just plugin' -> do
+            let oldPlugins = botPlugins bot
+            put $ bot { botPlugins = plugin' : oldPlugins } -- TODO : clean with a correct append
+        Nothing -> return ()
+
+-- | Effectively try to load a plugin
+effectivelyLoadPlugin :: String -> Chan BotMsg -> IO (Maybe Plugin)
+effectivelyLoadPlugin name serverChan = do
+    -- TODO : test if Plugins/ ++ name ++ .hs exists
+    --        Just load, do not compile if .o already present
+    m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") []
+    plugin <- case m of
+        MakeSuccess _ _ -> do
+            ldstat <- load_ ("Plugins/" ++ name ++ ".o") [".","Hsbot","Hsbot/Plugins"] ("main" ++ name)
+            case ldstat of
+                LoadSuccess v entryPoint -> do
+                    putStrLn $ inColor ("Loaded plugin: " ++ name) [32]
+                    chan <- newChan :: IO (Chan BotMsg)
+                    threadId <- forkIO $ entryPoint serverChan chan
+                    return $ Just (Plugin name v threadId chan)
+                LoadFailure e -> do
+                    putStrLn $ inColor ("Couldn't load plugin: " ++ name) [31]
+                    mapM_ putStrLn e
+                    return Nothing
+        MakeFailure e -> do
+            putStrLn $ inColor ("FATAL: Couldn't compile plugin: " ++ name) [31]
+            mapM_ putStrLn e
+            return Nothing
+    return plugin
+
+-- | Sends a msg to a plugin
+sendToPlugin :: BotMsg -> Plugin -> IrcBot ()
+sendToPlugin msg plugin = do
+    let chan = pluginChannel plugin
+    liftIO $ writeChan chan msg
+
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
new file mode 100644
index 0000000..7a37035
--- /dev/null
+++ b/Hsbot/Types.hs
@@ -0,0 +1,104 @@
+module Hsbot.Types
+    ( Bot(..)
+    , BotMsg(..)
+    , Channel(..)
+    , Config(..)
+    , IntCmd(..)
+    , IrcServer(..)
+    , IrcBot
+    , IrcMsg(..)
+    , Plugin(..)
+    ) where
+
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Monad.State
+import qualified Data.Map as M
+import Network
+import System.IO
+import System.Plugins
+import System.Time (ClockTime)
+
+-- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
+
+-- | Configuration data type
+data Config = Config {
+   commandPrefixes :: String,   -- command prefixes, for example @[\'>\',\'@\',\'?\']@
+   ircServer       :: IrcServer -- list of 'Server's to connect to
+} deriving (Show)
+
+-- | An IRC server
+data IrcServer = IrcServer
+    { address        :: String   -- the server's address
+    , port           :: PortID   -- the server's port
+    , channels       :: [String] -- a list of channels to join
+    , nickname       :: String   -- the hsbot's nickname
+    , password       :: String   -- the hsbot's password, optional
+    , realname       :: String   -- the hsbot's real name, optional
+    , administrators :: [String] -- bot admins nicknames
+    }
+
+instance Show IrcServer where
+    show (IrcServer a p c n pa r ad) = (show a)
+                                        ++ (case p of
+                                            PortNumber num -> show num
+                                            Service s      -> show s
+                                            UnixSocket u   -> show u)
+                                        ++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad)
+
+-- instance Show PortID where
+--     show (PortNumber n) = show n
+--     show (Service s)    = show s
+--     show (UnixSocket g) = show g
+
+-- | The IrcBot monad
+type IrcBot a = StateT Bot IO a
+
+-- | An IRC Bot server state
+data Bot = Bot
+    { serverConfig   :: IrcServer             -- original server config we are connected to
+    , startTime      :: ClockTime             -- the bot's uptime
+    , botHandle      :: Handle                -- the socket/handle
+    , chans          :: [Channel]             -- the list of channels we have joined
+    , botPlugins     :: M.Map String Plugin   -- Loaded plugins
+    , botChannel     :: Chan BotMsg           -- The bot's communication channel
+    , readerThreadId :: ThreadId              -- The bot's thread ID
+    , botCommands    :: M.Map String [String] -- Registered commands ("command", ["pluginName"])
+    }
+
+instance Show Bot where
+    show (Bot _ s h c p _ _ cmds) = (show s) ++ (show h) ++ (show c) ++ (show p) ++ (show cmds)
+
+-- | A channel connection
+data Channel = Channel
+    { channelName   :: String   -- the channel's name
+    , channelNick   :: String   -- our nickname
+    , channelAdmins :: [String] -- the bot administrators
+    } deriving (Show)
+
+-- | A Bot command
+data IntCmd = IntCmd
+    { intCmd       :: String   -- the bot's internal command
+    , intCmdParams :: [String] -- the parameters
+    } deriving (Show)
+
+-- |An IRC message.
+data IrcMsg = IrcMsg
+    { prefix     :: Maybe String -- the message prefix
+    , command    :: String       -- the message command
+    , parameters :: [String]     -- the message parameters
+    } deriving (Show)
+
+-- | A plugin definition
+data Plugin = Plugin
+    { pluginName     :: String      -- The plugin's name
+    , pluginModule   :: Module      -- The plugin himself
+    , pluginThreadId :: ThreadId    -- The plugin thread
+    , pluginChannel  :: Chan BotMsg -- The plugin channel
+    }
+
+instance Show Plugin where
+    show (Plugin name _ _ _) = show name
+
+data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd
+
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
new file mode 100644
index 0000000..640d16f
--- /dev/null
+++ b/Hsbot/Utils.hs
@@ -0,0 +1,33 @@
+module Hsbot.Utils
+    ( inColor
+    , sendstr
+    , trace
+    , traceM
+    ) where
+
+import Control.Monad.State
+import Data.List
+import System.IO
+
+import Hsbot.Types
+
+-- |Wrap a string with ANSI escape sequences.
+inColor :: String -> [Int] -> String
+inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m"
+    where valstr = concat $ intersperse ";" $ map show vals
+
+-- | Sends a string over handle
+sendstr :: String -> IrcBot ()
+sendstr str = do
+    handle <- gets botHandle
+    traceM $ inColor ("--> " ++ str) [33]
+    liftIO $ hPutStr handle (str ++ "\r\n")
+
+-- | Log a message string
+trace :: String -> IO ()
+trace msg = putStrLn msg
+
+-- | Log a message string
+traceM :: String -> IrcBot ()
+traceM msg = liftIO $ putStrLn msg
+