module Network.FastIRC.Messages
(
Message(..),
messageParser,
readMessage,
showMessage,
Command(..),
commandParser,
showCommand
)
where
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Control.Applicative
import Data.Attoparsec.Char8 as P hiding (many)
import Data.Char
import Data.Map (Map)
import Data.Maybe
import Network.FastIRC.ServerSet
import Network.FastIRC.Types
import Network.FastIRC.Users
import Network.FastIRC.Utils
import Text.Printf
data Message =
Message {
msgOrigin :: !(Maybe UserSpec),
msgCommand :: !Command
}
deriving (Eq, Show)
data Command
= StringCmd CommandName [CommandArg]
| NumericCmd Integer [CommandArg]
| JoinCmd (Map ChannelName (Maybe ChannelKey))
deriving (Eq, Show)
commandParser :: Parser Command
commandParser =
try numCmd <|>
stringCmd
where
cmdArg :: Parser CommandArg
cmdArg = do
skipMany1 (char ' ')
try lastArg <|> takeWhile1 isIRCTokChar
where
lastArg :: Parser CommandArg
lastArg = char ':' *> P.takeWhile isMessageChar
joinCmd :: Parser Command
joinCmd = do
channels <- B.split ',' <$> cmdArg
keys <- option [] $ B.split ',' <$> cmdArg
many cmdArg
return . JoinCmd . M.fromList $ zip channels (map Just keys ++ repeat Nothing)
numCmd :: Parser Command
numCmd = NumericCmd <$> decimal <*> many cmdArg
stringCmd :: Parser Command
stringCmd = do
cmd <- B.map toUpper <$> takeWhile1 isCommandChar
case cmd of
"JOIN" -> joinCmd
_ -> StringCmd cmd <$> many cmdArg
messageParser :: ServerSet -> Parser Message
messageParser servers =
Message <$> option Nothing (Just <$> try userSpec)
<*> commandParser
where
userSpec :: Parser UserSpec
userSpec = char ':' *> userParser servers <* skipMany1 (char ' ')
readMessage :: ServerSet -> MsgString -> Maybe Message
readMessage = parseComplete . messageParser
showCommand :: Command -> MsgString
showCommand cmd =
case cmd of
StringCmd cmdStr args -> B.append cmdStr (showArgs args)
NumericCmd cmdNum args ->
B.append (B.pack . printf "%03i" $ cmdNum)
(showArgs args)
JoinCmd channels ->
case formatJoins channels of
(chanList, "") -> B.append "JOIN" (showArgs [chanList])
(chanList, keyList) -> B.append "JOIN" (showArgs [chanList, keyList])
where
formatJoins :: Map ChannelName (Maybe ChannelKey) ->
(CommandArg, CommandArg)
formatJoins channels = (chanList, keyList)
where
(withKey, withoutKey) = M.partition isJust channels
chanWithKeyAssocs = M.assocs withKey
chanList = B.intercalate "," $ map fst chanWithKeyAssocs ++
M.keys withoutKey
keyList = B.intercalate "," $ map (fromJust . snd) chanWithKeyAssocs
showArgs :: [CommandArg] -> MsgString
showArgs [] = B.empty
showArgs [arg]
| B.null arg = " :"
| B.head arg == ':' = B.append " :" arg
| B.elem ' ' arg = B.append " :" arg
| otherwise = B.cons ' ' arg
showArgs (arg:args) =
B.append (B.cons ' ' arg) (showArgs args)
showMessage :: Message -> MsgString
showMessage (Message origin cmd) =
case origin of
Nothing -> B.append (showCommand cmd) "\r\n"
Just o ->
B.concat [ ':' `B.cons` showUserSpec o,
' ' `B.cons` showCommand cmd,
"\r\n" ]