-- | Datatypes for representing IRC messages, as well as formatting them.
module Network.IRC.Base (
    -- * Type Synonyms
    Parameter
  , ServerName
  , UserName
  , RealName
  , Command

    -- * IRC Datatypes
  , Prefix(..)
  , Message(..)

    -- * Formatting functions
  , encode         -- :: Message -> String
  , showMessage, showPrefix, showParameters
  , translateReply -- :: String -> String
  , replyTable     -- :: [(String,String)]

    -- * Deprecated
  , 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

-- ---------------------------------------------------------
-- Data Types

type Parameter  = ByteString
type ServerName = ByteString
type UserName   = ByteString
type RealName   = ByteString
type Command    = ByteString


-- | IRC messages are parsed as:
--   [ ':' prefix space ] command { space param } crlf
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)


-- | The optional beginning of an IRC messages
data Prefix
  = -- | Server Prefix
    Server ServerName
  | -- | Nickname Prefix
    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)


-- ---------------------------------------------------------
-- Formatting


-- | Encode a message to its string representation
encode :: Message -> ByteString
encode :: Message -> Command
encode = Message -> Command
showMessage

-- | This is the deprecated version of encode
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 []     = []

-- ---------------------------------------------------------
-- Message Translation

-- | Translate a reply into its text description.
--   If no text is available, the argument is returned.
translateReply :: Command -- ^ Reply
               -> ByteString  -- ^ Text translation
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


-- One big lookup table of codes and errors
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)