1 files changed, 73 insertions, 0 deletions
diff --git a/Hsbot/Irc/Message.hs b/Hsbot/Irc/Message.hs
new file mode 100644
index 0000000..e92a9d0
--- /dev/null
+++ b/Hsbot/Irc/Message.hs
@@ -0,0 +1,73 @@
+module Hsbot.Irc.Message
+    ( IrcBotMsg (..)
+    , IrcCmd (..)
+    , IrcMsg (..)
+    , emptyIrcMsg
+    , parseIrcMsg
+    , serializeIrcMsg
+    ) where
+
+import Control.Monad.Identity
+import Text.Parsec
+
+-- | An IRC message
+data IrcMsg = IrcMsg
+    { ircMsgPrefix     :: Maybe String -- the message prefix
+    , ircMsgCommand    :: String       -- the message command
+    , ircMsgParameters :: [String]     -- the message parameters
+    } deriving (Show)
+
+emptyIrcMsg :: IrcMsg
+emptyIrcMsg = IrcMsg Nothing "" []
+
+-- | An internal command
+data IrcCmd = IrcCmd
+    { ircCmdCmd    :: String -- the internal command
+    , ircCmdFrom   :: String -- who issues it
+    , ircCmdTo     :: String -- who it is destinated to
+    , ircCmdMsg    :: String -- the message to be transfered
+    , ircCmdBotMsg :: IrcMsg -- An IrcMsg attached to the command
+    } deriving (Show)
+
+data IrcBotMsg = InIrcMsg IrcMsg | OutIrcMsg IrcMsg | IntIrcCmd IrcCmd deriving (Show)
+
+-- | Parses an IrcInput
+parseIrcMsg :: String -> Either ParseError IrcMsg
+parseIrcMsg line = parse pMsg "" line
+
+pMsg :: ParsecT String u Identity IrcMsg
+pMsg = do
+    pfx <- optionMaybe pPrefix
+    cmd <- pCommand
+    params <- many (char ' ' >> (pLongParam <|> pShortParam))
+    _ <- char '\r'
+    --eof
+    return $ IrcMsg pfx cmd params
+
+pPrefix :: ParsecT String u Identity [Char]
+pPrefix = do
+    _ <- char ':'
+    pfx <- many1 (noneOf " ")
+    _ <- space
+    return pfx
+
+pCommand :: ParsecT String u Identity [Char]
+pCommand = count 3 digit <|> many1 upper
+
+pLongParam :: ParsecT String u Identity [Char]
+pLongParam = char ':' >> (many1 (noneOf "\r"))
+
+pShortParam :: ParsecT String u Identity [Char]
+pShortParam = many1 (noneOf " \r")
+
+-- | Serialize an IRC message to a string.
+serializeIrcMsg :: IrcMsg -> String
+serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr
+    where pfxStr = case pfx of
+                        Nothing  -> ""
+                        Just pfx' -> ":" ++ pfx' ++ " "
+          paramStr = concat (map paramToStr (init params)
+                             ++ [lastParamToStr (last params)])
+          paramToStr p = " " ++ p
+          lastParamToStr p = " :" ++ p
+