Added the IRCParser (thx galdor), and PrivMsg handling (simply repeat)

3 files changed, 76 insertions, 19 deletions

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 ()