Rewrote nearly everything!

* Rewrote the whole architecture to achieve extreme modularity * Added the ability to build a multiprotocol bot * Added cabal integration * Added configuration handling the XMonad style * Added configuration in ~/.hsbot * Refactored many many named and functions * Refactored data structures * Cleaned a big bunch of stuff
2010-05-16 00:01:00 +02:00 · 2010-05-16 00:01:00 +02:00 · c1662ba7b9
commit c1662ba7b9
parent c20cfe88b3
33 changed files with 856 additions and 654 deletions
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@ -1,108 +0,0 @@
-module Hsbot.Types
-    ( Bot(..)
-    , BotMsg(..)
-    , Channel(..)
-    , Config(..)
-    , IntCmd(..)
-    , IrcServer(..)
-    , IrcBot
-    , IrcMsg(..)
-    , Plugin(..)
-    , emptyIrcMsg
-    ) 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.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
-    { commandPrefix :: Char      -- command prefixe, for example @[\'>\',\'@\',\'?\']@
-    , ircServer     :: IrcServer -- list of 'Server's to connect to
-    } deriving (Show)
-
-- | An IRC server
-data IrcServer = IrcServer
-    { serverAddress  :: String   -- the server's address
-    , serverPort     :: PortID   -- the server's port
-    , joinChannels   :: [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)
-
-- | 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) = unlines [ "Start time : " ++ (show s)
-                                            , "Handle     : " ++ (show h)
-                                            , "Channels   : " ++ (show c)
-                                            , "Plugins    : " ++ (show p)
-                                            , "Commands   : " ++ (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)
-
-- | An IRC message
-data IrcMsg = IrcMsg
-    { prefix     :: Maybe String -- the message prefix
-    , command    :: String       -- the message command
-    , parameters :: [String]     -- the message parameters
-    } deriving (Show)
-
-emptyIrcMsg :: IrcMsg
-emptyIrcMsg = IrcMsg Nothing "" []
-
-- | An internal command
-data IntCmd = IntCmd
-    { intCmdCmd    :: String -- the internal command
-    , intCmdFrom   :: String -- who issues it
-    , intCmdTo     :: String -- who it is destinated to
-    , intCmdMsg    :: String -- the message to be transfered
-    , intCmdBotMsg :: IrcMsg -- An IrcMsg attached to the command
-    } deriving (Show)
-
-data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (Show)
-
-- | A plugin (core side)
-data Plugin = Plugin
-    { pluginName     :: String      -- The plugin's name
-    , pluginThreadId :: ThreadId    -- The plugin thread
-    , pluginChannel  :: Chan BotMsg -- The plugin channel
-    }
-
-instance Show Plugin where
-    show (Plugin name _ _) = show name
-