Reorganized code and types, changed slightly the architecture.

1 files changed, 21 insertions, 131 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 ()