Wrote the ping pong stuff
This commit is contained in:
parent
2f270f8bdf
commit
14f87adb8b
3 changed files with 28 additions and 2 deletions
11
Hsbot/IRC.hs
11
Hsbot/IRC.hs
|
@ -4,9 +4,12 @@ module Hsbot.IRC
|
||||||
, connectServer
|
, connectServer
|
||||||
, initServer
|
, initServer
|
||||||
, parseIrcMsg
|
, parseIrcMsg
|
||||||
|
, ping
|
||||||
|
, pong
|
||||||
)where
|
)where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.List(isPrefixOf)
|
||||||
import Network
|
import Network
|
||||||
import qualified Network.IRC as IRC
|
import qualified Network.IRC as IRC
|
||||||
import System.IO
|
import System.IO
|
||||||
|
@ -56,3 +59,11 @@ initServer (server, handle) = do
|
||||||
mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (channels server)
|
mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (channels server)
|
||||||
return ()
|
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)
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,9 @@ module Hsbot.Main
|
||||||
( imain
|
( imain
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Concurrent
|
||||||
|
import Control.Concurrent.Chan
|
||||||
|
import Control.Monad
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Plugins
|
import System.Plugins
|
||||||
|
|
||||||
|
@ -18,9 +21,18 @@ imain modul' reboot = imain' modul' reboot newbot
|
||||||
-- | Bot's main entry point
|
-- | Bot's main entry point
|
||||||
imain' :: Module -> Reboot -> Bot -> IO ()
|
imain' :: Module -> Reboot -> Bot -> IO ()
|
||||||
imain' modul' reboot bot = do
|
imain' modul' reboot bot = do
|
||||||
|
putStrLn "yeah"
|
||||||
putStrLn "Connecting servers..."
|
putStrLn "Connecting servers..."
|
||||||
servers' <- mapM connectServer (ircServers C.config)
|
servers' <- mapM connectServer (ircServers C.config)
|
||||||
putStrLn "Joining channels..."
|
putStrLn "Joining channels..."
|
||||||
mapM_ initServer servers'
|
mapM_ initServer servers'
|
||||||
return ()
|
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 ()
|
||||||
|
|
||||||
|
|
7
Main.hs
7
Main.hs
|
@ -2,11 +2,14 @@ module Main where
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.Plugins
|
import System.Plugins
|
||||||
|
|
||||||
|
ghcargs :: [String]
|
||||||
|
ghcargs = ["-XPatternGuards"]
|
||||||
|
|
||||||
-- | Dynamic launching function
|
-- | Dynamic launching function
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
putStrLn "hsbot starting..."
|
putStrLn "hsbot starting..."
|
||||||
m <- makeAll "Hsbot.hs" [] -- ghcargs
|
m <- makeAll "Hsbot.hs" ghcargs
|
||||||
(modul', imain) <- case m of
|
(modul', imain) <- case m of
|
||||||
MakeSuccess _ _ -> do
|
MakeSuccess _ _ -> do
|
||||||
ldstat <- load_ "Hsbot/Main.o" [".","Hsbot","Hsbot/Plugins"] "imain"
|
ldstat <- load_ "Hsbot/Main.o" [".","Hsbot","Hsbot/Plugins"] "imain"
|
||||||
|
@ -26,7 +29,7 @@ main = do
|
||||||
-- | Dynamic rebooting function
|
-- | Dynamic rebooting function
|
||||||
reboot :: Module -> a -> IO ()
|
reboot :: Module -> a -> IO ()
|
||||||
reboot modul' state = do
|
reboot modul' state = do
|
||||||
mkstat <- makeAll "Hsbot.hs" [] --ghcargs
|
mkstat <- makeAll "Hsbot.hs" ghcargs
|
||||||
case mkstat of
|
case mkstat of
|
||||||
MakeSuccess _ _ -> do
|
MakeSuccess _ _ -> do
|
||||||
unloadAll modul'
|
unloadAll modul'
|
||||||
|
|
Reference in a new issue