module Network.SimpleIRC.Messages
( IrcMessage(..)
, Command(..)
, parse
, showCommand
)
where
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Control.Arrow
import Data.Typeable
data Command = Command
| MPrivmsg B.ByteString B.ByteString
| MJoin B.ByteString (Maybe B.ByteString)
| MPart B.ByteString B.ByteString
| MMode B.ByteString B.ByteString (Maybe B.ByteString)
| MTopic B.ByteString (Maybe B.ByteString)
| MInvite B.ByteString B.ByteString
| MKick B.ByteString B.ByteString B.ByteString
| MQuit B.ByteString
| MNick B.ByteString
| MNotice B.ByteString B.ByteString
| MAction B.ByteString B.ByteString
deriving (Eq, Read, Show)
data IrcMessage = IrcMessage
{ mNick :: Maybe B.ByteString
, mUser :: Maybe B.ByteString
, mHost :: Maybe B.ByteString
, mServer :: Maybe B.ByteString
, mCode :: B.ByteString
, mMsg :: B.ByteString
, mChan :: Maybe B.ByteString
, mOther :: Maybe [B.ByteString]
, mRaw :: B.ByteString
} deriving (Show, Typeable)
parse :: B.ByteString -> IrcMessage
parse txt =
case length split of
2 -> parse2 split txt
3 -> parse3 split txt
4 -> parse4 split txt
5 -> parse5 split txt
_ -> parseOther split txt
where split = smartSplit (takeCarriageRet txt)
parseFirst :: B.ByteString -> (Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString)
parseFirst first =
if '!' `B.elem` first
then let (nick, user_host) = B.break (== '!') (dropColon first)
in if '@' `B.elem` user_host
then let (user, host) = second B.tail $ B.break (== '@') $ B.tail user_host
in (Just nick, Just user, Just host, Nothing)
else (Just nick, Nothing, Just user_host, Nothing)
else (Nothing, Nothing, Nothing, Just $ dropColon first)
parse2 :: [B.ByteString] -> B.ByteString -> IrcMessage
parse2 (code:msg:_) =
IrcMessage Nothing Nothing Nothing Nothing code
(dropColon msg) Nothing Nothing
parse3 :: [B.ByteString] -> B.ByteString -> IrcMessage
parse3 (first:code:msg:_) =
let (nick, user, host, server) = parseFirst first
in IrcMessage nick user host server code (dropColon msg) Nothing Nothing
parse4 :: [B.ByteString] -> B.ByteString -> IrcMessage
parse4 (first:code:chan:msg:_) =
let (nick, user, host, server) = parseFirst first
in IrcMessage nick user host server code
(dropColon msg) (Just chan) Nothing
parse5 :: [B.ByteString] -> B.ByteString -> IrcMessage
parse5 (server:code:nick:chan:msg:_) =
IrcMessage (Just nick) Nothing Nothing (Just server) code
(dropColon msg) (Just chan) Nothing
parseOther :: [B.ByteString] -> B.ByteString -> IrcMessage
parseOther (server:code:nick:chan:other) =
IrcMessage (Just nick) Nothing Nothing (Just server) code
(B.unwords other) (Just chan) (Just other)
smartSplit :: B.ByteString -> [B.ByteString]
smartSplit txt =
case B.breakSubstring (B.pack " :") (dropColon txt) of
(x,y) | B.null y ->
B.words txt
| otherwise ->
let (_, msg) = B.break (== ':') y
in B.words x ++ [msg]
takeLast :: B.ByteString -> B.ByteString
takeLast xs = B.take (B.length xs 1) xs
takeCarriageRet :: B.ByteString -> B.ByteString
takeCarriageRet xs =
if B.drop (B.length xs 1) xs == B.pack "\r"
then takeLast xs
else xs
dropColon :: B.ByteString -> B.ByteString
dropColon xs =
if B.take 1 xs == B.pack ":"
then B.drop 1 xs
else xs
showCommand :: Command -> B.ByteString
showCommand (MPrivmsg chan msg) = "PRIVMSG " `B.append` chan `B.append`
" :" `B.append` msg
showCommand (MJoin chan (Just key)) = "JOIN " `B.append` chan `B.append`
" " `B.append` key
showCommand (MJoin chan Nothing) = "JOIN " `B.append` chan
showCommand (MPart chan msg) = "PART " `B.append` chan `B.append`
" :" `B.append` msg
showCommand (MMode chan mode (Just usr)) = "MODE " `B.append` chan `B.append`
" " `B.append` mode `B.append`
" " `B.append` usr
showCommand (MMode chan mode Nothing) = "MODE " `B.append` chan `B.append`
" " `B.append` mode
showCommand (MTopic chan (Just msg)) = "TOPIC " `B.append` chan `B.append`
" :" `B.append` msg
showCommand (MTopic chan Nothing) = "TOPIC " `B.append` chan
showCommand (MInvite usr chan) = "INVITE " `B.append` usr `B.append`
" " `B.append` chan
showCommand (MKick chan usr msg) = "KICK " `B.append` chan `B.append`
" " `B.append` usr `B.append`
" :" `B.append` msg
showCommand (MQuit msg) = "QUIT :" `B.append` msg
showCommand (MNick nick) = "NICK " `B.append` nick
showCommand (MNotice chan msg) = "NOTICE " `B.append` chan `B.append`
" :" `B.append` msg
showCommand (MAction chan msg) = showCommand $ MPrivmsg chan
("\x01 ACTION " `B.append` msg
`B.append` "\x01")