Message.hs

{-# Language OverloadedStrings, TemplateHaskell #-}
{-|
Module      : Client.Message
Description : Messages to be added to buffers
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the type used to track messages just before they
are added to a window.

-}
module Client.Message
  (
  -- * Client message type
    ClientMessage(..)
  , msgNetwork
  , msgBody
  , msgTime

  -- * Message body type
  , MessageBody(..)
  , _IrcBody
  , _ErrorBody
  , _NormalBody

  -- * Client message operations
  , IrcSummary(..)
  , msgSummary
  , summaryActor

  -- * Quit message details
  , QuitKind(..)

  -- * Client message operations
  , msgText
  ) where

import           Control.Lens
import           Data.Text (Text)
import           Data.Time (ZonedTime)
import           Irc.Message
import           Irc.Identifier
import           Irc.UserInfo
import           Irc.Codes

data MessageBody
  = IrcBody    !IrcMsg
  | ErrorBody  {-# UNPACK #-} !Text
  | NormalBody {-# UNPACK #-} !Text

makePrisms ''MessageBody

data ClientMessage = ClientMessage
  { _msgNetwork :: !Text
  , _msgBody    :: !MessageBody
  , _msgTime    :: !ZonedTime
  }

makeLenses ''ClientMessage

data QuitKind
  = NormalQuit -- ^ User quit
  | MassQuit   -- ^ Mass event like a netsplit
  deriving (Eq, Show)

data IrcSummary
  = JoinSummary {-# UNPACK #-} !Identifier
  | QuitSummary {-# UNPACK #-} !Identifier !QuitKind
  | PartSummary {-# UNPACK #-} !Identifier
  | NickSummary {-# UNPACK #-} !Identifier {-# UNPACK #-} !Identifier
  | ReplySummary {-# UNPACK #-} !ReplyCode
  | ChatSummary {-# UNPACK #-} !UserInfo
  | CtcpSummary {-# UNPACK #-} !Identifier
  | ChngSummary {-# UNPACK #-} !Identifier -- ^ Chghost command
  | AcctSummary {-# UNPACK #-} !Identifier -- ^ Account command
  | NoSummary
  deriving (Eq, Show)


-- | Compute a searchable text representation of the message
msgText :: MessageBody -> Text
msgText (IrcBody    irc) = ircMsgText irc
msgText (ErrorBody  txt) = txt
msgText (NormalBody txt) = txt


msgSummary :: MessageBody -> IrcSummary
msgSummary (IrcBody    irc) = ircSummary irc
msgSummary (ErrorBody  _  ) = NoSummary
msgSummary (NormalBody _  ) = NoSummary


ircSummary :: IrcMsg -> IrcSummary
ircSummary msg =
  case msg of
    Join who _ _ _  -> JoinSummary (userNick (srcUser who))
    Part who _ _    -> PartSummary (userNick (srcUser who))
    Quit who mbTxt  -> QuitSummary (userNick (srcUser who)) (quitKind mbTxt)
    Nick who who'   -> NickSummary (userNick (srcUser who)) who'
    Privmsg who _ _ -> ChatSummary (srcUser who)
    Notice who _ _  -> ChatSummary (srcUser who)
    Ctcp who _ "ACTION" _ -> ChatSummary (srcUser who)
    Ctcp who _ _ _ -> CtcpSummary (userNick (srcUser who))
    CtcpNotice who _ _ _ -> ChatSummary (srcUser who)
    Reply _ code _  -> ReplySummary code
    Account who _   -> AcctSummary (userNick (srcUser who))
    Chghost who _ _ -> ChngSummary (userNick (srcUser who))
    _               -> NoSummary

quitKind :: Maybe Text -> QuitKind
quitKind mbReason =
  case mbReason of
    Just "*.net *.split"        -> MassQuit
    _                           -> NormalQuit

summaryActor :: IrcSummary -> Maybe Identifier
summaryActor s =
  case s of
    JoinSummary who   -> Just who
    QuitSummary who _ -> Just who
    PartSummary who   -> Just who
    NickSummary who _ -> Just who
    ChatSummary who   -> Just (userNick who)
    CtcpSummary who   -> Just who
    AcctSummary who   -> Just who
    ChngSummary who   -> Just who
    ReplySummary {}   -> Nothing
    NoSummary         -> Nothing