-- This file is part of irc.

-- irc is free software; you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation; either version 3 of the License, or
-- (at your option) any later version.

-- irc is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.

-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- |
-- Module      : Network.IRC
-- Copyright   : (c) Trevor Elliott 2007
-- License     : LGPL
--
-- Maintainer  : trevor@geekgateway.com
-- Stability   : experimental
-- Portability : non-portable (not tested)
--
-- library for parsing IRC messages
module Network.IRC (
    -- * Type Synonyms
    Parameter
  , ServerName
  , UserName
  , RealName
  , Command

    -- * IRC Datatypes
  , Prefix(Server, NickName)
  , Message(Message)

    -- * Parsing and Formatting Functions
  , parseMessage   -- :: String -> Maybe Message
  , formatMessage  -- :: Message -> String
  , translateReply -- :: String -> String

    -- * Parsec Combinators for Parsing IRC messages
  , prefix    -- :: CharParser st Prefix
  , server    -- :: CharParser st Prefix
  , nickname  -- :: CharParser st Prefix
  , command   -- :: CharParser st Command
  , parameter -- :: CharParser st Parameter
  , message   -- :: CharParser st Message
  , crlf      -- :: CharParser st ()
  , spaces    -- :: CharParser st ()

    -- * Other Parser Combinators
  , maybeP    -- :: GenParser tok st a -> GenParser tok st (Maybe a)
  , tokenize  -- :: CharParser st a -> CharParser st a
  , takeUntil -- :: String -> CharParser st String
  ) where

import Control.Monad
import Data.Maybe
import Text.ParserCombinators.Parsec hiding (spaces)

type Command    = String
type Parameter  = String
type ServerName = String
type UserName   = String
type RealName   = String

-- | IRC messages are parsed as:
--   [ ':' prefix space ] command { space param } crlf
data Message
  = -- | IRC Message
    Message (Maybe Prefix) Command [Parameter]
    deriving (Show)

-- | The optional beginning of an IRC messages
data Prefix
  = -- | Server Prefix
    Server ServerName
  | -- | Nickname Prefix
    NickName String (Maybe UserName) (Maybe ServerName)
    deriving (Show)

-- | Parse a String into a Message.
parseMessage :: String        -- ^ Message string
             -> Maybe Message -- ^ Parsed message
parseMessage  = (either (const Nothing) Just) . (parse message "")

-- | Take all tokens until one character from a given string is found
takeUntil :: String -> CharParser st String
takeUntil  = many1 . noneOf

-- | Convert a parser into an optional one that returns a Maybe
maybeP  :: GenParser tok st a -> GenParser tok st (Maybe a)
maybeP p = option Nothing (liftM Just p)

-- | Convert a parser that consumes all space after it
tokenize  :: CharParser st a -> CharParser st a
tokenize p = p >>= \x -> spaces >> return x

-- | Consume only spaces tabs or the bell character
spaces :: CharParser st ()
spaces  = skipMany1 (oneOf " \t\b")

-- | Parse a Prefix
prefix :: CharParser st Prefix
prefix  = char ':' >> (try nickname <|> server)

-- | Parse a Server prefix
server :: CharParser st Prefix
server  = takeUntil " " >>= return . Server

-- | Parse a NickName prefix
nickname :: CharParser st Prefix
nickname  = do
  n <- takeUntil " .!@"
  p <- option False (char '.' >> return True)
  when p (fail "")
  u <- maybeP $ char '!' >> takeUntil " @"
  s <- maybeP $ char '@' >> takeUntil " "
  return $ NickName n u s

-- | Parse a command.  Either a string of capital letters, or 3 digits.
command :: CharParser st Command
command  = many1 upper
        <|> do x <- digit
               y <- digit
               z <- digit
               return [x,y,z]

-- | Parse a command parameter.
parameter :: CharParser st Parameter
parameter  =  (char ':' >> takeUntil "\r\n")
          <|> (takeUntil " \r\n")

-- | Parse a cr lf
crlf :: CharParser st ()
crlf  = string "\r\n" >> return ()

-- | Parse a Message
message :: CharParser st Message
message  = do
  p <- maybeP $ tokenize prefix
  c <- command
  ps <- many (spaces >> parameter)
  crlf <|> eof
  return $ Message p c ps

-- | Message formatting
formatMessage :: Message -- ^ IRC Message
              -> String  -- ^ Formatted message
formatMessage m@(Message p c args) =
  (maybe "" (\p' -> formatPrefix p' ++ " ") p) ++ c ++ " "
  ++ formatArgs args
  
formatPrefix :: Prefix -> String
formatPrefix (Server n)       = ":" ++ n
formatPrefix (NickName n u s) = ":" ++ n
                                    ++ maybe "" (\u' -> "!" ++ u') u
                                    ++ maybe "" (\s' -> "@" ++ s') s

formatArgs :: [Parameter] -> String
formatArgs  = unwords . formatArgs' . filter ((>0) . length)

formatArgs' :: [Parameter] -> [String]
formatArgs' []                    = []
formatArgs' l@(p:ps) | elem ' ' p = [":" ++ unwords l]
                     | otherwise  = p : formatArgs' ps

-- | Translate a reply into the text version of the reply.
--   If no text version is available, the argument is returned.
translateReply :: Command -- ^ Reply
               -> String  -- ^ Text translation
translateReply r = fromMaybe r $ lookup r replyTable

replyTable :: [(String,String)]
replyTable  =
  [ ("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")
  ]