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
|
||||
, 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)
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
||||
|
|
7
Main.hs
7
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'
|
||||
|
|
Reference in a new issue