summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJulien Dessaux2009-08-07 00:19:14 +0200
committerJulien Dessaux2009-08-07 00:19:14 +0200
commit14f87adb8b3cfc019b7de7f082e3851a91b6a364 (patch)
tree6860704ec357ebcba4518cfd354a880907073800
parentRefactored some minor stuff (diff)
downloadhsbot-14f87adb8b3cfc019b7de7f082e3851a91b6a364.tar.gz
hsbot-14f87adb8b3cfc019b7de7f082e3851a91b6a364.tar.bz2
hsbot-14f87adb8b3cfc019b7de7f082e3851a91b6a364.zip
Wrote the ping pong stuff
-rw-r--r--Hsbot/IRC.hs11
-rw-r--r--Hsbot/Main.hs12
-rw-r--r--Main.hs7
3 files changed, 28 insertions, 2 deletions
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index d397456..cd6b7b8 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -4,9 +4,12 @@ module Hsbot.IRC
, connectServer
, initServer
, parseIrcMsg
+ , ping
+ , pong
)where
import Control.Monad
+import Data.List(isPrefixOf)
import Network
import qualified Network.IRC as IRC
import System.IO
@@ -56,3 +59,11 @@ initServer (server, handle) = do
mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (channels server)
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)
+
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index 23b3991..dad568a 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -2,6 +2,9 @@ module Hsbot.Main
( imain
) where
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Monad
import System.IO
import System.Plugins
@@ -18,9 +21,18 @@ imain modul' reboot = imain' modul' reboot newbot
-- | Bot's main entry point
imain' :: Module -> Reboot -> Bot -> IO ()
imain' modul' reboot bot = do
+ putStrLn "yeah"
putStrLn "Connecting servers..."
servers' <- mapM connectServer (ircServers C.config)
putStrLn "Joining channels..."
mapM_ initServer servers'
return ()
+-- | Thread entry point for socket listeners
+listener :: (Chan IrcOutput) -> (IrcServer, Handle) -> IO ()
+listener chan (server, handle) = forever $ do
+ str <- hGetLine handle
+ writeChan chan (Str str)
+ if ping str then pong handle str
+ else return ()
+
diff --git a/Main.hs b/Main.hs
index 87f7588..f0db040 100644
--- a/Main.hs
+++ b/Main.hs
@@ -2,11 +2,14 @@ module Main where
import System.Exit
import System.Plugins
+ghcargs :: [String]
+ghcargs = ["-XPatternGuards"]
+
-- | Dynamic launching function
main :: IO ()
main = do
putStrLn "hsbot starting..."
- m <- makeAll "Hsbot.hs" [] -- ghcargs
+ m <- makeAll "Hsbot.hs" ghcargs
(modul', imain) <- case m of
MakeSuccess _ _ -> do
ldstat <- load_ "Hsbot/Main.o" [".","Hsbot","Hsbot/Plugins"] "imain"
@@ -26,7 +29,7 @@ main = do
-- | Dynamic rebooting function
reboot :: Module -> a -> IO ()
reboot modul' state = do
- mkstat <- makeAll "Hsbot.hs" [] --ghcargs
+ mkstat <- makeAll "Hsbot.hs" ghcargs
case mkstat of
MakeSuccess _ _ -> do
unloadAll modul'