summaryrefslogtreecommitdiff
path: root/Hsbot/Core.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-02-04 20:36:58 +0100
committerJulien Dessaux2010-02-04 20:36:58 +0100
commit884c6c9f2e3a03d6666c8dd6c6d6b6513db88ad5 (patch)
treec5941649d7fe1ac23d5ee673c240efb8508b3db2 /Hsbot/Core.hs
parentRewrote the whole architecture. (diff)
downloadhsbot-884c6c9f2e3a03d6666c8dd6c6d6b6513db88ad5.tar.gz
hsbot-884c6c9f2e3a03d6666c8dd6c6d6b6513db88ad5.tar.bz2
hsbot-884c6c9f2e3a03d6666c8dd6c6d6b6513db88ad5.zip
Reorganized code and types, changed slightly the architecture.
Diffstat (limited to 'Hsbot/Core.hs')
-rw-r--r--Hsbot/Core.hs152
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 ()