From 57f559f3a119b400e4f6288d3b5753185b8f19a7 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 4 Feb 2010 20:27:22 +0100
Subject: Rewrote the whole architecture.

---
 Hsbot/IRC.hs | 121 +++++++++++++++++++++++++----------------------------------
 1 file changed, 51 insertions(+), 70 deletions(-)

(limited to 'Hsbot/IRC.hs')

diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index 76853e2..d3a3114 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -1,82 +1,63 @@
 module Hsbot.IRC
-    ( IrcLine(..)
-    , connectServer
-    , initServer
-    , parseIrcMsg
-    , ping
-    , pong
-    , sendPrivmsg
-    )where
+    ( initServer
+    , runServer
+    ) where
 
-import Control.Monad
-import Data.List(isPrefixOf)
-import Data.Maybe
-import Network
-import qualified Network.IRC as IRC
+import Control.Concurrent.Chan
+import Control.Monad.State
 import System.IO
 
 import Hsbot.Core
 import Hsbot.IRCParser
 
-type User    = String
-type Channel = String
-type Command = String
-type Args    = [String]
-
--- | An IRC line
-data IrcLine = Privmsg (String, [String])   -- statement (chan, sentence...)
-               | Quit (IrcServer, Handle)   -- a quit message from a server
-               | Join (IrcServer, Channel)  -- joined a channel
-               | Part (IrcServer, Channel)  -- parted the channel
-               | Ping (String)              -- pinged by the server
-               | Reboot                     -- reboot message sent
-               | Nil                        -- signifies thread death, only happens after reboot
-    deriving (Eq,Show)
-
--- | Parses an IrcInput
-parseIrcMsg :: String -> IrcLine
-parseIrcMsg str = 
-    case (ircParser str) of
-        Left err -> Nil
-        Right x  -> eval x
-    where
-        eval :: IrcMsg -> IrcLine
-        eval x@(IrcMsg statement cmd stuff)
-            | cmd == "PING" = Ping $ head stuff
-            | cmd == "PRIVMSG" =
-		    case statement of
-		        Nothing -> Nil
-			Just statement' -> if stuff!!1 == "reboot" then Reboot
-                                              else  Privmsg $ (statement', stuff)
-            | otherwise = Nil
-
--- | Connects to a server
-connectServer :: IrcServer -> IO (IrcServer, Handle)
-connectServer server = do
-    let name  = address server
-        port_number = port server
-    handle <- connectTo name (PortNumber $ fromIntegral port_number)
-    hSetBuffering handle NoBuffering
-    return (server, handle)
-
 -- | Setup a newly connected server by sending nick and join stuff
-initServer :: (IrcServer, Handle) -> IO ()
-initServer (server, handle) = do
-    sendstr handle (IRC.encode . IRC.nick $ nickname server)
-    sendstr handle (IRC.encode $ IRC.user (nickname server) "0" "*" (realname server))
+initServer :: IrcBot ()
+initServer = do
+    server <- gets serverConfig
+    writeMsg $ IrcMsg Nothing "NICK" [(nickname server)]
+    writeMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
     when (not . null $ password server) $ do
-        sendstr handle (IRC.encode $ IRC.privmsg "nickserv" ("identify" ++ (password server)))
-    mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (channels server)
+        writeMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
+    joinChans
     return ()
 
--- | Check if a message is a PING
-ping :: String -> Bool
-ping = isPrefixOf "PING :"
-
--- | Send a pong message given a ping message
-pong :: Handle -> String -> IO ()
-pong handle str = sendstr handle $ "PONG " ++ (drop 5 str)
-
-sendPrivmsg :: (IrcServer, Handle) -> [String] -> IO ()
-sendPrivmsg (server, handle) stuff' = sendstr handle (IRC.encode $ IRC.privmsg (head stuff') (unwords . tail $ stuff'))
+-- | Run a server
+runServer :: IrcBot ()
+runServer = do
+    handle <- gets botHandle
+    plugins <- gets botPlugins
+    str <- liftIO $ hGetLine handle
+    traceM $ inColor ("<-- " ++ str) [33]
+    let msg = parseIrcMsg str
+    case msg of
+        Right msg' -> do
+            mapM_ (sendPlugin msg') plugins
+            return ()
+        _ -> do
+            return ()
+    traceM $ show msg
+    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
+    bot <- get
+    let oldChannels = chans bot
+        newChannel  = Channel name
+                              (nickname $ serverConfig bot)
+                              (administrators $ serverConfig bot)
+    traceM $ "  Joining " ++ name
+    writeMsg $ IrcMsg Nothing "JOIN" [name]
+    put $ bot { chans = newChannel : oldChannels }
 
-- 
cgit v1.2.3