Rewrote the whole architecture.

1 files changed, 135 insertions, 28 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index fddcb72..41340ba 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -1,56 +1,163 @@
 module Hsbot.Core
     ( Bot(..)
+    , Channel(..)
     , Config(..)
     , IrcServer(..)
-    , isConnected
-    , newbot
-    , sendstr
-    , saveServersStates
+    , IrcBot
+    , IrcMsg(..)
+    , Plugin(..)
+    , connectServer
+    , disconnectServer
+    , inColor
+    , serializeIrcMsg
+    , traceM
+    , writeMsg
     ) where
 
-import qualified Data.Map as M
-import System.IO (Handle)
-import Text.Printf (hPrintf)
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Monad.State
+import Data.List
+import Network
+import System.IO
+import System.Plugins
+import System.Time (ClockTime, getClockTime)
 
--- | An IRC Bot server state (socket handles)
-data Bot = Bot
-    { joinedServers :: M.Map IrcServer Handle -- servers we are connected to
-    } deriving (Eq, Show)
+-- | 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 @[\'>\',\'@\',\'?\']@
-   ircServers      :: [IrcServer]  -- list of 'Server's to connect to
-} deriving (Eq,Show)
+   ircServer       :: IrcServer -- list of 'Server's to connect to
+} deriving (Show)
 
 -- | An IRC server
 data IrcServer = IrcServer
     { address        :: String   -- the server's address
-    , port           :: Int      -- the server's port
+    , 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
-    } deriving (Eq, Ord, Show)
+    }
+
+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
+
+-- Connect to the server and return the initial bot state
+connectServer :: IrcServer -> IO Bot
+connectServer server = do
+    let name  = address server
+    starttime <- getClockTime
+    putStr $ "Connecting to " ++ name ++ "... "
+    handle <- connectTo name $ port server
+    hSetBuffering handle NoBuffering
+    putStrLn "done."
+    putStr $ "Opening server communication channel... "
+    chan <- newChan :: IO (Chan IrcMsg)
+    threadId <- forkIO $ botWriter 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
+    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
 
--- | Returns a new, empty bot
-newbot :: Bot
-newbot = Bot (M.empty)
+-- |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 = hPrintf handle "%s\r\n" str
+sendstr handle str = do
+    trace $ inColor ("--> " ++ str) [33]
+    hPutStr handle (str ++ "\r\n")
 
--- | Are we already connected to this server?
-isConnected :: Bot -> IrcServer -> Bool
-isConnected (Bot bot) ircServer = ircServer `M.member` bot
+-- | Log a message string
+trace :: String -> IO ()
+trace msg = putStrLn msg
 
-saveServerState :: Handle -> IrcServer -> Bot -> Bot
-saveServerState handle ircServer x@(Bot bot) = 
-    if ircServer `M.member` bot then x
-      else (Bot $ M.insert ircServer handle bot)
+-- | Log a message string
+traceM :: String -> IrcBot ()
+traceM msg = liftIO $ putStrLn msg
 
-saveServersStates :: [(IrcServer, Handle)] -> Bot -> Bot
-saveServersStates liste bot = foldl (\bot' (ircServer, handle) -> saveServerState handle ircServer bot') bot liste
+-- |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