Messages.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module:     Network.FastIRC.Messages
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez
-- Stability:  experimental
--
-- Parser and printer for IRC messages.

module Network.FastIRC.Messages
  ( -- * IRC messages
    Message(..),
    messageParser,
    readMessage,
    showMessage,

    -- * IRC commands
    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 type for IRC messages.

data Message =
  Message {
    msgOrigin  :: !(Maybe UserSpec), -- ^ Message origin (user/server).
    msgCommand :: !Command           -- ^ Message command or numeric.
  }
  deriving (Eq, Show)


-- | Data type for IRC commands.

data Command
  = StringCmd CommandName [CommandArg]  -- ^ Arbitrary string command.
  | NumericCmd Integer [CommandArg]     -- ^ Arbitrary numeric command.

  -- | Join command with a list of channels as well as channel keys.
  | JoinCmd (Map ChannelName (Maybe ChannelKey))

  deriving (Eq, Show)


-- | Parser for IRC commands and their arguments.

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


-- | Parser for IRC messages.

messageParser :: ServerSet -> Parser Message
messageParser servers =
  Message <$> option Nothing (Just <$> try userSpec)
          <*> commandParser

  where
    userSpec :: Parser UserSpec
    userSpec = char ':' *> userParser servers <* skipMany1 (char ' ')


-- | Run the 'messageParser' parser.

readMessage :: ServerSet -> MsgString -> Maybe Message
readMessage = parseComplete . messageParser


-- | Turn a 'Command' into a 'B.ByteString'.  Please note that a command
-- does not contain an origin specification.  You should use
-- 'showMessage' to format a an IRC message to be sent to the server.

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)


-- | Turn a 'Message' into a 'B.ByteString'.  It will already contain
-- \"\\r\\n\" and can be sent as is to the IRC server.

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" ]