module Network.IRC.Base (
Parameter
, ServerName
, UserName
, RealName
, Command
, Prefix(..)
, Message(..)
, encode
, showMessage, showPrefix, showParameters
, translateReply
, replyTable
, render
) where
import Data.Maybe
import Data.Char
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
type Parameter = ByteString
type ServerName = ByteString
type UserName = ByteString
type RealName = ByteString
type Command = ByteString
data Message = Message
{ Message -> Maybe Prefix
msg_prefix :: Maybe Prefix
, Message -> Command
msg_command :: Command
, Message -> [Command]
msg_params :: [Parameter]
} deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show,ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
(Int -> ReadS Message)
-> ReadS [Message]
-> ReadPrec Message
-> ReadPrec [Message]
-> Read Message
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Message]
$creadListPrec :: ReadPrec [Message]
readPrec :: ReadPrec Message
$creadPrec :: ReadPrec Message
readList :: ReadS [Message]
$creadList :: ReadS [Message]
readsPrec :: Int -> ReadS Message
$creadsPrec :: Int -> ReadS Message
Read,Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)
data Prefix
=
Server ServerName
|
NickName ByteString (Maybe UserName) (Maybe ServerName)
deriving (Int -> Prefix -> ShowS
[Prefix] -> ShowS
Prefix -> String
(Int -> Prefix -> ShowS)
-> (Prefix -> String) -> ([Prefix] -> ShowS) -> Show Prefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prefix] -> ShowS
$cshowList :: [Prefix] -> ShowS
show :: Prefix -> String
$cshow :: Prefix -> String
showsPrec :: Int -> Prefix -> ShowS
$cshowsPrec :: Int -> Prefix -> ShowS
Show,ReadPrec [Prefix]
ReadPrec Prefix
Int -> ReadS Prefix
ReadS [Prefix]
(Int -> ReadS Prefix)
-> ReadS [Prefix]
-> ReadPrec Prefix
-> ReadPrec [Prefix]
-> Read Prefix
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Prefix]
$creadListPrec :: ReadPrec [Prefix]
readPrec :: ReadPrec Prefix
$creadPrec :: ReadPrec Prefix
readList :: ReadS [Prefix]
$creadList :: ReadS [Prefix]
readsPrec :: Int -> ReadS Prefix
$creadsPrec :: Int -> ReadS Prefix
Read,Prefix -> Prefix -> Bool
(Prefix -> Prefix -> Bool)
-> (Prefix -> Prefix -> Bool) -> Eq Prefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prefix -> Prefix -> Bool
$c/= :: Prefix -> Prefix -> Bool
== :: Prefix -> Prefix -> Bool
$c== :: Prefix -> Prefix -> Bool
Eq)
encode :: Message -> ByteString
encode :: Message -> Command
encode = Message -> Command
showMessage
render :: Message -> ByteString
render :: Message -> Command
render = Message -> Command
encode
showMessage :: Message -> ByteString
showMessage :: Message -> Command
showMessage (Message p :: Maybe Prefix
p c :: Command
c ps :: [Command]
ps) = Maybe Prefix -> Command
showMaybe Maybe Prefix
p Command -> Command -> Command
`BS.append` Command
c Command -> Command -> Command
`BS.append` [Command] -> Command
showParameters [Command]
ps
where showMaybe :: Maybe Prefix -> Command
showMaybe Nothing = Command
BS.empty
showMaybe (Just prefix :: Prefix
prefix) = [Command] -> Command
BS.concat [ String -> Command
B8.pack ":"
, Prefix -> Command
showPrefix Prefix
prefix
, String -> Command
B8.pack " " ]
bsConsAscii :: Char -> ByteString -> ByteString
bsConsAscii :: Char -> Command -> Command
bsConsAscii c :: Char
c = Word8 -> Command -> Command
BS.cons (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> Char -> Word8
forall a b. (a -> b) -> a -> b
$ Char
c)
showPrefix :: Prefix -> ByteString
showPrefix :: Prefix -> Command
showPrefix (Server s :: Command
s) = Command
s
showPrefix (NickName n :: Command
n u :: Maybe Command
u h :: Maybe Command
h) = [Command] -> Command
BS.concat [Command
n, Char -> Maybe Command -> Command
showMaybe '!' Maybe Command
u, Char -> Maybe Command -> Command
showMaybe '@' Maybe Command
h]
where showMaybe :: Char -> Maybe Command -> Command
showMaybe c :: Char
c e :: Maybe Command
e = Command -> (Command -> Command) -> Maybe Command -> Command
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Command
BS.empty (Char -> Command -> Command
bsConsAscii Char
c) Maybe Command
e
showParameters :: [Parameter] -> ByteString
showParameters :: [Command] -> Command
showParameters [] = Command
BS.empty
showParameters params :: [Command]
params = Command -> [Command] -> Command
BS.intercalate (String -> Command
B8.pack " ") (Command
BS.empty Command -> [Command] -> [Command]
forall a. a -> [a] -> [a]
: [Command] -> [Command]
showp [Command]
params)
where showp :: [Command] -> [Command]
showp [p :: Command
p] = [Char -> Command -> Command
bsConsAscii ':' Command
p]
showp (p :: Command
p:ps :: [Command]
ps) = Command
p Command -> [Command] -> [Command]
forall a. a -> [a] -> [a]
: [Command] -> [Command]
showp [Command]
ps
showp [] = []
translateReply :: Command
-> ByteString
translateReply :: Command -> Command
translateReply r :: Command
r = Command -> Maybe Command -> Command
forall a. a -> Maybe a -> a
fromMaybe Command
r (Maybe Command -> Command) -> Maybe Command -> Command
forall a b. (a -> b) -> a -> b
$ Command -> [(Command, Command)] -> Maybe Command
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Command
r [(Command, Command)]
replyTable
replyTable :: [(ByteString, ByteString)]
replyTable :: [(Command, Command)]
replyTable = ((String, String) -> (Command, Command))
-> [(String, String)] -> [(Command, Command)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (Command, Command)
mkPair
[ ("401","ERR_NOSUCHNICK")
, ("402","ERR_NOSUCHSERVER")
, ("403","ERR_NOSUCHCHANNEL")
, ("404","ERR_CANNOTSENDTOCHAN")
, ("405","ERR_TOOMANYCHANNELS")
, ("406","ERR_WASNOSUCHNICK")
, ("407","ERR_TOOMANYTARGETS")
, ("409","ERR_NOORIGIN")
, ("411","ERR_NORECIPIENT")
, ("412","ERR_NOTEXTTOSEND")
, ("413","ERR_NOTOPLEVEL")
, ("414","ERR_WILDTOPLEVEL")
, ("421","ERR_UNKNOWNCOMMAND")
, ("422","ERR_NOMOTD")
, ("423","ERR_NOADMININFO")
, ("424","ERR_FILEERROR")
, ("431","ERR_NONICKNAMEGIVEN")
, ("432","ERR_ERRONEUSNICKNAME")
, ("433","ERR_NICKNAMEINUSE")
, ("436","ERR_NICKCOLLISION")
, ("441","ERR_USERNOTINCHANNEL")
, ("442","ERR_NOTONCHANNEL")
, ("443","ERR_USERONCHANNEL")
, ("444","ERR_NOLOGIN")
, ("445","ERR_SUMMONDISABLED")
, ("446","ERR_USERSDISABLED")
, ("451","ERR_NOTREGISTERED")
, ("461","ERR_NEEDMOREPARAMS")
, ("462","ERR_ALREADYREGISTRED")
, ("463","ERR_NOPERMFORHOST")
, ("464","ERR_PASSWDMISMATCH")
, ("465","ERR_YOUREBANNEDCREEP")
, ("467","ERR_KEYSET")
, ("471","ERR_CHANNELISFULL")
, ("472","ERR_UNKNOWNMODE")
, ("473","ERR_INVITEONLYCHAN")
, ("474","ERR_BANNEDFROMCHAN")
, ("475","ERR_BADCHANNELKEY")
, ("481","ERR_NOPRIVILEGES")
, ("482","ERR_CHANOPRIVSNEEDED")
, ("483","ERR_CANTKILLSERVER")
, ("491","ERR_NOOPERHOST")
, ("501","ERR_UMODEUNKNOWNFLAG")
, ("502","ERR_USERSDONTMATCH")
, ("300","RPL_NONE")
, ("302","RPL_USERHOST")
, ("303","RPL_ISON")
, ("301","RPL_AWAY")
, ("305","RPL_UNAWAY")
, ("306","RPL_NOWAWAY")
, ("311","RPL_WHOISUSER")
, ("312","RPL_WHOISSERVER")
, ("313","RPL_WHOISOPERATOR")
, ("317","RPL_WHOISIDLE")
, ("318","RPL_ENDOFWHOIS")
, ("319","RPL_WHOISCHANNELS")
, ("314","RPL_WHOWASUSER")
, ("369","RPL_ENDOFWHOWAS")
, ("321","RPL_LISTSTART")
, ("322","RPL_LIST")
, ("323","RPL_LISTEND")
, ("324","RPL_CHANNELMODEIS")
, ("331","RPL_NOTOPIC")
, ("332","RPL_TOPIC")
, ("341","RPL_INVITING")
, ("342","RPL_SUMMONING")
, ("351","RPL_VERSION")
, ("352","RPL_WHOREPLY")
, ("315","RPL_ENDOFWHO")
, ("353","RPL_NAMREPLY")
, ("366","RPL_ENDOFNAMES")
, ("364","RPL_LINKS")
, ("365","RPL_ENDOFLINKS")
, ("367","RPL_BANLIST")
, ("368","RPL_ENDOFBANLIST")
, ("371","RPL_INFO")
, ("374","RPL_ENDOFINFO")
, ("375","RPL_MOTDSTART")
, ("372","RPL_MOTD")
, ("376","RPL_ENDOFMOTD")
, ("381","RPL_YOUREOPER")
, ("382","RPL_REHASHING")
, ("391","RPL_TIME")
, ("392","RPL_USERSSTART")
, ("393","RPL_USERS")
, ("394","RPL_ENDOFUSERS")
, ("395","RPL_NOUSERS")
, ("200","RPL_TRACELINK")
, ("201","RPL_TRACECONNECTING")
, ("202","RPL_TRACEHANDSHAKE")
, ("203","RPL_TRACEUNKNOWN")
, ("204","RPL_TRACEOPERATOR")
, ("205","RPL_TRACEUSER")
, ("206","RPL_TRACESERVER")
, ("208","RPL_TRACENEWTYPE")
, ("261","RPL_TRACELOG")
, ("211","RPL_STATSLINKINFO")
, ("212","RPL_STATSCOMMANDS")
, ("213","RPL_STATSCLINE")
, ("214","RPL_STATSNLINE")
, ("215","RPL_STATSILINE")
, ("216","RPL_STATSKLINE")
, ("218","RPL_STATSYLINE")
, ("219","RPL_ENDOFSTATS")
, ("241","RPL_STATSLLINE")
, ("242","RPL_STATSUPTIME")
, ("243","RPL_STATSOLINE")
, ("244","RPL_STATSHLINE")
, ("221","RPL_UMODEIS")
, ("251","RPL_LUSERCLIENT")
, ("252","RPL_LUSEROP")
, ("253","RPL_LUSERUNKNOWN")
, ("254","RPL_LUSERCHANNELS")
, ("255","RPL_LUSERME")
, ("256","RPL_ADMINME")
, ("257","RPL_ADMINLOC1")
, ("258","RPL_ADMINLOC2")
, ("259","RPL_ADMINEMAIL")
]
where
mkPair :: (String, String) -> (Command, Command)
mkPair (a :: String
a,b :: String
b) = (String -> Command
B8.pack String
a, String -> Command
B8.pack String
b)