Parse IRC messages

3 files changed, 55 insertions, 0 deletions

diff --git a/Hirc/Parser.hs b/Hirc/Parser.hs
new file mode 100644
index 0000000..2cb2451
--- /dev/null
+++ b/Hirc/Parser.hs
@@ -0,0 +1,23 @@
+module Hirc.Parser where
+
+import Data.Char
+import Hirc.Types
+import Text.Parsec
+import Text.Parsec.String
+
+message :: Parser Message
+message =
+    Message <$> optionMaybe (char ':' *> prefix) <* spaces1 <*> command <*> params
+  where
+    spaces1 = skipMany1 space
+    prefix = Prefix <$> nick
+                    <*> optionMaybe (char '!' *> user)
+                    <*> optionMaybe (char '@' *> host)
+    nick = many1 (noneOf " !@")
+    user = many1 (noneOf " !@")
+    host = many1 (noneOf " !@")
+    command = UnknownCommand <$> many1 nonspace
+    params = many1 (spaces1 *> (trailing <|> middle))
+    trailing = char ':' *> many1 anyChar
+    middle = many1 nonspace
+    nonspace = satisfy (not . isSpace)
diff --git a/Hirc/Types.hs b/Hirc/Types.hs
new file mode 100644
index 0000000..1bb258c
--- /dev/null
+++ b/Hirc/Types.hs
@@ -0,0 +1,26 @@
+module Hirc.Types where
+
+data Message =
+  Message {
+    m_prefix :: Maybe Prefix,
+    m_command :: Command,
+    m_params :: [Param]
+  }
+  deriving Show
+
+type Param = String
+
+data Prefix =
+  Prefix {
+    p_name :: String,
+    p_user :: Maybe String,
+    p_host :: Maybe String
+  }
+  deriving Show
+
+data Command =
+  PRIVMSG Receiver [Receiver] String |
+  UnknownCommand String
+  deriving Show
+
+type Receiver = String
diff --git a/hirc.hs b/hirc.hs
index 86bd135..82b6cd2 100644
--- a/hirc.hs
+++ b/hirc.hs
@@ -1,10 +1,14 @@
 import Data.List
+import Data.Monoid
 import Network
 import System.IO
 import System.Exit
 import Control.Arrow
 import Control.Monad.Reader
 import Control.Exception
+import Hirc.Parser as P
+import Hirc.Types
+import Text.Parsec (parse)
 import Text.Printf
  
 server = "irc.freenode.org"
@@ -49,12 +53,14 @@ listen :: Handle -> Net ()
 listen h = forever $ do
     s <- init `fmap` io (hGetLine h)
     io (putStrLn s)
+    io (putStrLn $ show $ parse P.message filename s)
     if ping s then pong s else eval (clean s)
   where
     forever a = a >> forever a
     clean     = drop 1 . dropWhile (/= ':') . drop 1
     ping x    = "PING :" `isPrefixOf` x
     pong x    = write "PONG" (':' : drop 6 x)
+    filename  = server <> (':' : show port)
  
 -- Dispatch a command
 eval :: String -> Net ()