module Network.IRC.ByteString.Parser
(
ServerName, IRCMsg(..), UserInfo(..)
, toIRCMsg, fromIRCMsg, ircMsg
, ircLine
) where
import Control.Applicative
import Data.Attoparsec.Char8 as Char8
import qualified Data.Attoparsec as Word8
import Data.ByteString.Char8 as BS
(cons, append, intercalate, ByteString, null, concat, pack, unpack)
import Data.Maybe (fromMaybe)
import Data.Char (isAlphaNum, isNumber, isAlpha)
import Prelude hiding (takeWhile)
--Types--
type ServerName = ByteString
data IRCMsg = IRCMsg { msgPrefix :: Maybe (Either UserInfo ServerName)
, msgCmd :: ByteString
, msgParams :: [ByteString]
, msgTrail :: ByteString
}
deriving (Show, Eq, Read)
data UserInfo = UserInfo { userNick :: ByteString
, userName :: Maybe ByteString
, userHost :: Maybe ByteString
}
deriving (Eq, Show, Read)
toIRCMsg :: ByteString -> Result IRCMsg
toIRCMsg = parse ircLine
fromIRCMsg :: IRCMsg -> ByteString
fromIRCMsg msg = BS.concat $ [prefix, command, params, trail, "\r\n"]
where prefix = case msgPrefix msg of
Nothing -> ""
Just (Right serv) -> ':' `cons` serv `append` " "
Just (Left info) -> ':' `cons` userNick info
`append` maybeUser
`append` maybeHost
`append` " "
where
maybeUser = maybe "" ('!' `cons`) (userName info)
maybeHost = maybe "" ('@' `cons`) (userHost info)
command = msgCmd msg
paramList = msgParams msg
params
| Prelude.null paramList = ""
| otherwise = ' ' `cons` intercalate " " (msgParams msg)
t = msgTrail msg
trail
| BS.null t = ""
| otherwise = " :" `append` msgTrail msg
ircMsg :: ByteString -> [ByteString] -> ByteString -> IRCMsg
ircMsg = IRCMsg Nothing
--Parsers--
spaces = skipSpace <?> "optional whitespace"
spaces1 = Word8.skip (==32) >> skipSpace <?> "required whitespace"
isNonWhite c = c /= ' ' && c /= '\r' && c /= '\n' && c /= '\0'
isChanPrefix c = c == '#' || c == '$'
isChanChar c = isNonWhite c && c /= '\x007' && c /= ','
chan = cons
<$> (satisfy isChanPrefix <?> "channel prefix")
<*> (takeWhile1 isChanChar <?> "channel name")
isNickChar c = isAlphaNum c || isSpecial c
isSpecial c = c == '-' || c == '[' || c == ']' || c == '\\' || c == '`'
|| c == '^' || c == '{' || c == '}' || c == '_'
nick = BS.cons <$> satisfy isAlpha
<*> takeWhile isNickChar
<?> "nick"
isUserChar c = isNonWhite c && c /= '@'
user = takeWhile1 isUserChar <?> "username"
isHostChar c = isAlphaNum c || c == '.' || c == '-'
host = cons
<$> satisfy isAlpha
<*> takeWhile1 isHostChar
<?> "hostname"
prefix = char ':' *> eitherP (userInfo <* end) (serverName <* end)
<?> "prefix"
where
end = spaces1 <|> endOfInput
serverName = host
userInfo = UserInfo <$> nick
<*> optional (char '!' >> user)
<*> optional (char '@' >> host)
command = alpha <|> numeric
where
alpha = takeWhile1 isAlpha
numeric =
cons
<$> satisfy isNumber
<*> (cons
<$> satisfy isNumber
<*> (cons
<$> satisfy isNumber
<*> pure "")
)
<?> "command name"
params = fromMaybe [] <$> optional
(spaces1 >> param `sepBy` spaces1) <?> "params list"
where param = cons
<$> satisfy (\c -> isNonWhite c && c /= ':')
<*> Char8.takeWhile isNonWhite
mess = spaces >> fromMaybe "" <$>
optional (char ':' >> Word8.takeWhile (not . isEndOfLine))
<?> "message body"
ircLine = IRCMsg <$> optional prefix <*> command <*> params <*> mess
<?> "IRC line"