--
-- | The IRC module processes the IRC protocol and provides a nice API for sending
--   and receiving IRC messages with an IRC server.
--
module Lambdabot.IRC
    ( IrcMessage(..)
    , joinChannel
    , partChannel
    , getTopic
    , setTopic
    , codepage
    , privmsg
    , quit
    , timeReply
    , pass
    , user
    , setNick
    ) where

import Lambdabot.Message
import Lambdabot.Nick

import Data.Char (chr,isSpace)
import Data.List.Split

import Control.Monad (liftM2)

-- | An IRC message is a server, a prefix, a command and a list of parameters.
--
-- Note that the strings here are treated as lists of bytes!
data IrcMessage
  = IrcMessage {
        IrcMessage -> String
ircMsgServer   :: !String,
        IrcMessage -> String
ircMsgLBName   :: !String,
        IrcMessage -> String
ircMsgPrefix   :: !String,
        IrcMessage -> String
ircMsgCommand  :: !String,
        IrcMessage -> [String]
ircMsgParams   :: ![String]
  }
  deriving (Int -> IrcMessage -> ShowS
[IrcMessage] -> ShowS
IrcMessage -> String
(Int -> IrcMessage -> ShowS)
-> (IrcMessage -> String)
-> ([IrcMessage] -> ShowS)
-> Show IrcMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IrcMessage] -> ShowS
$cshowList :: [IrcMessage] -> ShowS
show :: IrcMessage -> String
$cshow :: IrcMessage -> String
showsPrec :: Int -> IrcMessage -> ShowS
$cshowsPrec :: Int -> IrcMessage -> ShowS
Show)

instance Message IrcMessage where
    nick :: IrcMessage -> Nick
nick                = (String -> String -> Nick)
-> (IrcMessage -> String)
-> (IrcMessage -> String)
-> IrcMessage
-> Nick
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 String -> String -> Nick
Nick IrcMessage -> String
ircMsgServer ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'!') ShowS -> (IrcMessage -> String) -> IrcMessage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
ircMsgPrefix)
    server :: IrcMessage -> String
server              = IrcMessage -> String
ircMsgServer
    fullName :: IrcMessage -> String
fullName            = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'!') ShowS -> (IrcMessage -> String) -> IrcMessage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IrcMessage -> String
ircMsgPrefix
    channels :: IrcMessage -> [Nick]
channels IrcMessage
msg        = 
      let cstr :: String
cstr = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg
        in (String -> Nick) -> [String] -> [Nick]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg)) ([String] -> [Nick]) -> [String] -> [Nick]
forall a b. (a -> b) -> a -> b
$
           ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
x:String
xs) -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' then String
xs else Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," String
cstr)
               -- solves what seems to be an inconsistency in the parser
    lambdabotName :: IrcMessage -> Nick
lambdabotName IrcMessage
msg   = String -> String -> Nick
Nick (IrcMessage -> String
forall a. Message a => a -> String
server IrcMessage
msg) (IrcMessage -> String
ircMsgLBName IrcMessage
msg)

-- | 'mkMessage' creates a new message from a server, a cmd, and a list of parameters.
mkMessage :: String -- ^ Server
          -> String -- ^ Command
          -> [String] -- ^ Parameters
          -> IrcMessage -- ^ Returns: The created message

mkMessage :: String -> String -> [String] -> IrcMessage
mkMessage String
svr String
cmd [String]
params = IrcMessage :: String -> String -> String -> String -> [String] -> IrcMessage
IrcMessage 
    { ircMsgServer :: String
ircMsgServer = String
svr
    , ircMsgPrefix :: String
ircMsgPrefix = String
""
    , ircMsgCommand :: String
ircMsgCommand = String
cmd
    , ircMsgParams :: [String]
ircMsgParams = [String]
params
    , ircMsgLBName :: String
ircMsgLBName = String
"urk!<outputmessage>"
    }

joinChannel :: Nick -> IrcMessage
joinChannel :: Nick -> IrcMessage
joinChannel Nick
loc     = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
loc)  String
"JOIN"  [Nick -> String
nName Nick
loc]

partChannel :: Nick -> IrcMessage
partChannel :: Nick -> IrcMessage
partChannel Nick
loc     = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
loc)  String
"PART"  [Nick -> String
nName Nick
loc]

getTopic :: Nick -> IrcMessage
getTopic :: Nick -> IrcMessage
getTopic Nick
chan       = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
chan) String
"TOPIC" [Nick -> String
nName Nick
chan]

setTopic :: Nick -> String -> IrcMessage
setTopic :: Nick -> String -> IrcMessage
setTopic Nick
chan String
topic = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
chan) String
"TOPIC" [Nick -> String
nName Nick
chan, Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
topic]

-- | 'privmsg' creates a private message to the person designated.
privmsg :: Nick -- ^ Who should receive the message (nick)
        -> String -- ^ What is the message?
        -> IrcMessage -- ^ Constructed message
privmsg :: Nick -> String -> IrcMessage
privmsg Nick
who String
msg = if Bool
action then [String] -> IrcMessage
mk [Nick -> String
nName Nick
who, Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> Char
chr Int
0x1)Char -> ShowS
forall a. a -> [a] -> [a]
:(String
"ACTION " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
clean_msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Int -> Char
chr Int
0x1)Char -> ShowS
forall a. a -> [a] -> [a]
:[]))]
                            else [String] -> IrcMessage
mk [Nick -> String
nName Nick
who, Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
clean_msg]
    where mk :: [String] -> IrcMessage
mk = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
who) String
"PRIVMSG"
          cleaned_msg :: String
cleaned_msg = case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\CR') String
msg of
              str :: String
str@(Char
'@':String
_) -> Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
str
              String
str         -> String
str
          (String
clean_msg,Bool
action) = case String
cleaned_msg of
              (Char
'/':Char
'm':Char
'e':String
r) -> ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
r,Bool
True)
              String
str             -> (String
str,Bool
False)

-- | 'codepage' creates a server CODEPAGE message. The input string given is the
--   codepage name for current session.
codepage :: String -> String -> IrcMessage
codepage :: String -> String -> IrcMessage
codepage String
svr String
codepage = String -> String -> [String] -> IrcMessage
mkMessage String
svr String
"CODEPAGE" [Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
codepage]

-- | 'quit' creates a server QUIT message. The input string given is the
--   quit message, given to other parties when leaving the network.
quit :: String -> String -> IrcMessage
quit :: String -> String -> IrcMessage
quit String
svr String
msg = String -> String -> [String] -> IrcMessage
mkMessage String
svr String
"QUIT" [Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
msg]

-- | Construct a privmsg from the CTCP TIME notice, to feed up to
-- the @localtime-reply plugin, which then passes the output to
-- the appropriate client.
timeReply :: IrcMessage -> IrcMessage
timeReply :: IrcMessage -> IrcMessage
timeReply IrcMessage
msg = IrcMessage
msg
    { ircMsgCommand :: String
ircMsgCommand = String
"PRIVMSG"
    , ircMsgParams :: [String]
ircMsgParams  = [[String] -> String
forall a. [a] -> a
head (IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
                   ,String
":@localtime-reply " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Nick -> String
nName (Nick -> String) -> Nick -> String
forall a b. (a -> b) -> a -> b
$ IrcMessage -> Nick
forall a. Message a => a -> Nick
nick IrcMessage
msg) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      (ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
7 ([String] -> String
forall a. [a] -> a
last (IrcMessage -> [String]
ircMsgParams IrcMessage
msg))) ]
    }

user :: String -> String -> String -> String -> IrcMessage
user :: String -> String -> String -> String -> IrcMessage
user String
svr String
nick_ String
server_ String
ircname = String -> String -> [String] -> IrcMessage
mkMessage String
svr String
"USER" [String
nick_, String
"localhost", String
server_, String
ircname]

pass :: String -> String -> IrcMessage
pass :: String -> String -> IrcMessage
pass String
svr String
pwd = String -> String -> [String] -> IrcMessage
mkMessage String
svr String
"PASS" [String
pwd]

setNick :: Nick -> IrcMessage
setNick :: Nick -> IrcMessage
setNick Nick
nick_ = String -> String -> [String] -> IrcMessage
mkMessage (Nick -> String
nTag Nick
nick_) String
"NICK" [Nick -> String
nName Nick
nick_]