summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJulien Dessaux2009-08-13 00:07:08 +0200
committerJulien Dessaux2009-08-13 00:07:08 +0200
commitdfd0b3dcd72a8efa84612a4ae925204f3e4526d8 (patch)
tree574665be7df16d203337ac807eddfd70a3ebcbf0
parentAdded server states, in order to handle rebooting more cleanly (still missing... (diff)
downloadhsbot-dfd0b3dcd72a8efa84612a4ae925204f3e4526d8.tar.gz
hsbot-dfd0b3dcd72a8efa84612a4ae925204f3e4526d8.tar.bz2
hsbot-dfd0b3dcd72a8efa84612a4ae925204f3e4526d8.zip
Added the IRCParser (thx galdor), and PrivMsg handling (simply repeat)
-rw-r--r--Hsbot.hs2
-rw-r--r--Hsbot/IRC.hs25
-rw-r--r--Hsbot/IRCParser.hs36
-rw-r--r--Hsbot/Main.hs34
4 files changed, 78 insertions, 19 deletions
diff --git a/Hsbot.hs b/Hsbot.hs
index 5b423ec..f37527b 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -2,11 +2,13 @@ module Hsbot
( module Config
, module Hsbot.Core
, module Hsbot.IRC
+ , module Hsbot.IRCParser
, module Hsbot.Main
) where
import Config
import Hsbot.Core
import Hsbot.IRC
+import Hsbot.IRCParser
import Hsbot.Main
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index 7922a37..76853e2 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -5,15 +5,18 @@ module Hsbot.IRC
, parseIrcMsg
, ping
, pong
+ , sendPrivmsg
)where
import Control.Monad
import Data.List(isPrefixOf)
+import Data.Maybe
import Network
import qualified Network.IRC as IRC
import System.IO
import Hsbot.Core
+import Hsbot.IRCParser
type User = String
type Channel = String
@@ -21,7 +24,7 @@ type Command = String
type Args = [String]
-- | An IRC line
-data IrcLine = Str String -- a regular string
+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
@@ -31,8 +34,21 @@ data IrcLine = Str String -- a regular string
deriving (Eq,Show)
-- | Parses an IrcInput
-parseIrcMsg :: String -> IrcInput
-parseIrcMsg str = (Cmd "user" "channel" (str, Just "args"))
+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)
@@ -61,3 +77,6 @@ ping = isPrefixOf "PING :"
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'))
+
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
new file mode 100644
index 0000000..a76e22a
--- /dev/null
+++ b/Hsbot/IRCParser.hs
@@ -0,0 +1,36 @@
+module Hsbot.IRCParser
+ ( IrcMsg (..)
+ , ircParser
+ ) where
+
+--import Text.Parsec
+import Text.ParserCombinators.Parsec
+
+-- |An IRC message.
+data IrcMsg = IrcMsg (Maybe String) String [String] -- (Maybe first statement) cmd [chan, params/sentence]
+ deriving (Show)
+
+--ircParser :: String -> IrcInput
+ircParser :: String -> Either ParseError IrcMsg
+ircParser str = parse pMsg "" str
+
+pMsg = do
+ pfx <- optionMaybe pPrefix
+ cmd <- pCommand
+ params <- many (char ' ' >> (pLongParam <|> pShortParam))
+ char '\r'
+ eof
+ return $ IrcMsg pfx cmd params
+
+pPrefix = do
+ char ':'
+ pfx <- many1 (noneOf " ")
+ space
+ return pfx
+
+pCommand = count 3 digit <|> many1 upper
+
+pLongParam = char ':' >> (many1 (noneOf "\r"))
+
+pShortParam = many1 (noneOf " \r")
+
diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs
index 8c4be63..4c006b5 100644
--- a/Hsbot/Main.hs
+++ b/Hsbot/Main.hs
@@ -41,28 +41,30 @@ imain' modul' reboot bot = do
monitor :: (Chan IrcLine) -> Bot -> IO Bot
monitor chan bot = do
loop bot
- where loop bot' = do
- input <- readChan chan
- case input of
- Reboot ->do
+ where
+ loop bot' = do
+ input <- readChan chan :: IO IrcLine
+ case input of
+ Reboot -> do
putStrLn "Got reboot message, rebooting"
return bot'
- Str str -> putStrLn ("received : " ++ str) >> loop bot'
+ _ -> loop bot'
-- | Thread entry point for socket listeners
listener :: (Chan IrcLine) -> (IrcServer, Handle) -> IO ()
listener chan (server, handle) = forever $ do
str <- hGetLine handle
- writeChan chan (Str str)
- if ping str then pong handle str
- else eval (parseIrcMsg str)
+ let msg = parseIrcMsg str
+ writeChan chan msg
+ eval msg
where
- eval str
- | (Cmd user channel (cmd, args)) <- str = do
- let cmd' = tail cmd
- unless (null cmd') (parseCmds user cmd' args channel)
- parseCmds user cmd args channel
- | cmd == "reboot" = writeChan chan Reboot
- | otherwise = do
- putStrLn $"Unknown command : " ++ cmd
+ eval :: IrcLine -> IO ()
+ eval (Privmsg (statement, stuff')) = sendPrivmsg (server, handle) stuff'
+ eval (Quit (ircServer, handle')) = return ()
+ eval (Join (ircServer, handle')) = return ()
+ eval (Part (ircServer, handle')) = return ()
+ eval (Ping (string)) = do pong handle string
+ eval stuff' = case stuff' of
+ Reboot -> return ()
+ Nil -> return ()