{-# Language OverloadedStrings #-}

{-|
Module      : Irc.Message
Description : High-level representation of IRC messages
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module defines high-level IRC commands. Commands are interpreted
and their arguments are extracted into the appropriate types.

-}

module Irc.Message
  (
  -- * High-level messages
    IrcMsg(..)
  , CapCmd(..)
  , CapMore(..)
  , cookIrcMsg

  -- * Properties of messages
  , MessageTarget(..)
  , ircMsgText
  , msgTarget
  , msgActor
  , msgSource

  -- * Helper functions
  , nickSplit
  , computeMaxMessageLength
  , capCmdText

  , Source(..)
  ) where

import           Control.Monad
import           Data.Function
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Text.Read as Text
import           Irc.Identifier
import           Irc.RawIrcMsg
import           Irc.UserInfo
import           Irc.Codes
import           View

-- | High-level IRC message representation
data IrcMsg
  = UnknownMsg !RawIrcMsg -- ^ pass-through for unhandled messages
  | Reply !Text !ReplyCode [Text] -- ^ server code arguments
  | Nick !Source !Identifier -- ^ old new
  | Join !Source !Identifier !Text !Text -- ^ user channel account account gecos
  | Part !Source !Identifier (Maybe Text) -- ^ user channel reason
  | Quit !Source (Maybe Text) -- ^ user reason
  | Kick !Source !Identifier !Identifier !Text -- ^ kicker channel kickee comment
  | Kill !Source !Identifier !Text -- ^ killer killee reason
  | Topic !Source !Identifier !Text -- ^ user channel topic
  | Privmsg !Source !Identifier !Text -- ^ source target txt
  | Ctcp !Source !Identifier !Text !Text -- ^ source target command txt
  | CtcpNotice !Source !Identifier !Text !Text -- ^ source target command txt
  | Notice !Source !Identifier !Text -- ^ source target txt
  | Mode !Source !Identifier [Text] -- ^ source target txt
  | Authenticate !Text -- ^ parameters
  | Cap !CapCmd -- ^ cap command and parameters
  | Ping [Text] -- ^ parameters
  | Pong [Text] -- ^ parameters
  | Error !Text -- ^ message
  | BatchStart !Text !Text [Text] -- ^ reference-id type parameters
  | BatchEnd !Text -- ^ reference-id
  | Account !Source !Text -- ^ user account name changed (account-notify extension)
  | Chghost !Source !Text !Text -- ^ Target, new username and new hostname
  | Wallops  !Source !Text -- ^ Braodcast message: Source, message
  | Invite !Source !Identifier !Identifier -- ^ sender target channel
  deriving Int -> IrcMsg -> ShowS
[IrcMsg] -> ShowS
IrcMsg -> String
(Int -> IrcMsg -> ShowS)
-> (IrcMsg -> String) -> ([IrcMsg] -> ShowS) -> Show IrcMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IrcMsg] -> ShowS
$cshowList :: [IrcMsg] -> ShowS
show :: IrcMsg -> String
$cshow :: IrcMsg -> String
showsPrec :: Int -> IrcMsg -> ShowS
$cshowsPrec :: Int -> IrcMsg -> ShowS
Show

data Source = Source { Source -> UserInfo
srcUser :: {-# UNPACK #-}!UserInfo, Source -> Text
srcAcct :: !Text }
  deriving Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show

data CapMore = CapMore | CapDone
  deriving (Int -> CapMore -> ShowS
[CapMore] -> ShowS
CapMore -> String
(Int -> CapMore -> ShowS)
-> (CapMore -> String) -> ([CapMore] -> ShowS) -> Show CapMore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapMore] -> ShowS
$cshowList :: [CapMore] -> ShowS
show :: CapMore -> String
$cshow :: CapMore -> String
showsPrec :: Int -> CapMore -> ShowS
$cshowsPrec :: Int -> CapMore -> ShowS
Show, ReadPrec [CapMore]
ReadPrec CapMore
Int -> ReadS CapMore
ReadS [CapMore]
(Int -> ReadS CapMore)
-> ReadS [CapMore]
-> ReadPrec CapMore
-> ReadPrec [CapMore]
-> Read CapMore
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CapMore]
$creadListPrec :: ReadPrec [CapMore]
readPrec :: ReadPrec CapMore
$creadPrec :: ReadPrec CapMore
readList :: ReadS [CapMore]
$creadList :: ReadS [CapMore]
readsPrec :: Int -> ReadS CapMore
$creadsPrec :: Int -> ReadS CapMore
Read, CapMore -> CapMore -> Bool
(CapMore -> CapMore -> Bool)
-> (CapMore -> CapMore -> Bool) -> Eq CapMore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapMore -> CapMore -> Bool
$c/= :: CapMore -> CapMore -> Bool
== :: CapMore -> CapMore -> Bool
$c== :: CapMore -> CapMore -> Bool
Eq, Eq CapMore
Eq CapMore
-> (CapMore -> CapMore -> Ordering)
-> (CapMore -> CapMore -> Bool)
-> (CapMore -> CapMore -> Bool)
-> (CapMore -> CapMore -> Bool)
-> (CapMore -> CapMore -> Bool)
-> (CapMore -> CapMore -> CapMore)
-> (CapMore -> CapMore -> CapMore)
-> Ord CapMore
CapMore -> CapMore -> Bool
CapMore -> CapMore -> Ordering
CapMore -> CapMore -> CapMore
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CapMore -> CapMore -> CapMore
$cmin :: CapMore -> CapMore -> CapMore
max :: CapMore -> CapMore -> CapMore
$cmax :: CapMore -> CapMore -> CapMore
>= :: CapMore -> CapMore -> Bool
$c>= :: CapMore -> CapMore -> Bool
> :: CapMore -> CapMore -> Bool
$c> :: CapMore -> CapMore -> Bool
<= :: CapMore -> CapMore -> Bool
$c<= :: CapMore -> CapMore -> Bool
< :: CapMore -> CapMore -> Bool
$c< :: CapMore -> CapMore -> Bool
compare :: CapMore -> CapMore -> Ordering
$ccompare :: CapMore -> CapMore -> Ordering
$cp1Ord :: Eq CapMore
Ord)

-- | Sub-commands of the CAP command sent by server
data CapCmd
  = CapLs !CapMore [(Text, Maybe Text)] -- ^ list of supported caps
  | CapList [Text] -- ^ list of active caps
  | CapAck [Text] -- ^ request accepted
  | CapNak [Text] -- ^ request denied
  | CapNew [(Text, Maybe Text)] -- ^ new capability available (cap-notify extension)
  | CapDel [Text] -- ^ capability removed (cap-notify extension)
  deriving (Int -> CapCmd -> ShowS
[CapCmd] -> ShowS
CapCmd -> String
(Int -> CapCmd -> ShowS)
-> (CapCmd -> String) -> ([CapCmd] -> ShowS) -> Show CapCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapCmd] -> ShowS
$cshowList :: [CapCmd] -> ShowS
show :: CapCmd -> String
$cshow :: CapCmd -> String
showsPrec :: Int -> CapCmd -> ShowS
$cshowsPrec :: Int -> CapCmd -> ShowS
Show, ReadPrec [CapCmd]
ReadPrec CapCmd
Int -> ReadS CapCmd
ReadS [CapCmd]
(Int -> ReadS CapCmd)
-> ReadS [CapCmd]
-> ReadPrec CapCmd
-> ReadPrec [CapCmd]
-> Read CapCmd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CapCmd]
$creadListPrec :: ReadPrec [CapCmd]
readPrec :: ReadPrec CapCmd
$creadPrec :: ReadPrec CapCmd
readList :: ReadS [CapCmd]
$creadList :: ReadS [CapCmd]
readsPrec :: Int -> ReadS CapCmd
$creadsPrec :: Int -> ReadS CapCmd
Read, CapCmd -> CapCmd -> Bool
(CapCmd -> CapCmd -> Bool)
-> (CapCmd -> CapCmd -> Bool) -> Eq CapCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapCmd -> CapCmd -> Bool
$c/= :: CapCmd -> CapCmd -> Bool
== :: CapCmd -> CapCmd -> Bool
$c== :: CapCmd -> CapCmd -> Bool
Eq, Eq CapCmd
Eq CapCmd
-> (CapCmd -> CapCmd -> Ordering)
-> (CapCmd -> CapCmd -> Bool)
-> (CapCmd -> CapCmd -> Bool)
-> (CapCmd -> CapCmd -> Bool)
-> (CapCmd -> CapCmd -> Bool)
-> (CapCmd -> CapCmd -> CapCmd)
-> (CapCmd -> CapCmd -> CapCmd)
-> Ord CapCmd
CapCmd -> CapCmd -> Bool
CapCmd -> CapCmd -> Ordering
CapCmd -> CapCmd -> CapCmd
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CapCmd -> CapCmd -> CapCmd
$cmin :: CapCmd -> CapCmd -> CapCmd
max :: CapCmd -> CapCmd -> CapCmd
$cmax :: CapCmd -> CapCmd -> CapCmd
>= :: CapCmd -> CapCmd -> Bool
$c>= :: CapCmd -> CapCmd -> Bool
> :: CapCmd -> CapCmd -> Bool
$c> :: CapCmd -> CapCmd -> Bool
<= :: CapCmd -> CapCmd -> Bool
$c<= :: CapCmd -> CapCmd -> Bool
< :: CapCmd -> CapCmd -> Bool
$c< :: CapCmd -> CapCmd -> Bool
compare :: CapCmd -> CapCmd -> Ordering
$ccompare :: CapCmd -> CapCmd -> Ordering
$cp1Ord :: Eq CapCmd
Ord)

-- | Match command text to structured cap sub-command
cookCapCmd :: Text -> [Text] -> Maybe CapCmd
cookCapCmd :: Text -> [Text] -> Maybe CapCmd
cookCapCmd Text
cmd [Text]
args =
  case (Text
cmd, [Text]
args) of
    (Text
"LS"  , [Text
"*", Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just (CapMore -> [(Text, Maybe Text)] -> CapCmd
CapLs CapMore
CapMore (Text -> [(Text, Maybe Text)]
splitCapList Text
caps))
    (Text
"LS"  , [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just (CapMore -> [(Text, Maybe Text)] -> CapCmd
CapLs CapMore
CapDone (Text -> [(Text, Maybe Text)]
splitCapList Text
caps))
    (Text
"LIST", [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapList (Text -> [Text]
Text.words Text
caps))
    (Text
"ACK" , [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapAck (Text -> [Text]
Text.words Text
caps))
    (Text
"NAK" , [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapNak (Text -> [Text]
Text.words Text
caps))
    (Text
"NEW" , [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just ([(Text, Maybe Text)] -> CapCmd
CapNew (Text -> [(Text, Maybe Text)]
splitCapList Text
caps))
    (Text
"DEL" , [     Text
caps]) -> CapCmd -> Maybe CapCmd
forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapDel (Text -> [Text]
Text.words Text
caps))
    (Text, [Text])
_                     -> Maybe CapCmd
forall a. Maybe a
Nothing

msgSource :: RawIrcMsg -> Maybe Source
msgSource :: RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg =
  case ((Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
 -> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg)
-> RawIrcMsg -> Maybe UserInfo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
-> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg
forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
msg of
    Maybe UserInfo
Nothing -> Maybe Source
forall a. Maybe a
Nothing
    Just UserInfo
p ->
      case [Text
a | TagEntry Text
"account" Text
a <- (([TagEntry] -> Const [TagEntry] [TagEntry])
 -> RawIrcMsg -> Const [TagEntry] RawIrcMsg)
-> RawIrcMsg -> [TagEntry]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([TagEntry] -> Const [TagEntry] [TagEntry])
-> RawIrcMsg -> Const [TagEntry] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags RawIrcMsg
msg ] of
        []  -> Source -> Maybe Source
forall a. a -> Maybe a
Just (UserInfo -> Text -> Source
Source UserInfo
p Text
"")
        Text
a:[Text]
_ -> Source -> Maybe Source
forall a. a -> Maybe a
Just (UserInfo -> Text -> Source
Source UserInfo
p Text
a)


-- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'.
-- Messages that can't be understood are wrapped in 'UnknownMsg'.
cookIrcMsg :: RawIrcMsg -> IrcMsg
cookIrcMsg :: RawIrcMsg -> IrcMsg
cookIrcMsg RawIrcMsg
msg =
  case ((Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg)
-> RawIrcMsg -> Text
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
msg of
    Text
cmd | Just UserInfo
user <- ((Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
 -> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg)
-> RawIrcMsg -> Maybe UserInfo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (Maybe UserInfo -> Const (Maybe UserInfo) (Maybe UserInfo))
-> RawIrcMsg -> Const (Maybe UserInfo) RawIrcMsg
forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
msg
        , Right (Word
n,Text
"") <- Reader Word
forall a. Integral a => Reader a
decimal Text
cmd ->
        Text -> ReplyCode -> [Text] -> IrcMsg
Reply (Identifier -> Text
idText (UserInfo -> Identifier
userNick UserInfo
user)) (Word -> ReplyCode
ReplyCode Word
n) ((([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg)
    Text
"CAP" | Text
_target:Text
cmdTxt:[Text]
rest <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg
          , Just CapCmd
cmd <- Text -> [Text] -> Maybe CapCmd
cookCapCmd Text
cmdTxt [Text]
rest -> CapCmd -> IrcMsg
Cap CapCmd
cmd

    Text
"AUTHENTICATE" | Text
x:[Text]
_ <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
        Text -> IrcMsg
Authenticate Text
x

    Text
"PING" -> [Text] -> IrcMsg
Ping ((([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg)
    Text
"PONG" -> [Text] -> IrcMsg
Pong ((([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg)

    Text
"PRIVMSG" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
           , [Text
chan,Text
txt]   <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->

           case Text -> Maybe (Text, Text)
parseCtcp Text
txt of
             Just (Text
cmd,Text
args) -> Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp Source
source (Text -> Identifier
mkId Text
chan) (Text -> Text
Text.toUpper Text
cmd) Text
args
             Maybe (Text, Text)
Nothing         -> Source -> Identifier -> Text -> IrcMsg
Privmsg Source
source (Text -> Identifier
mkId Text
chan) Text
txt

    Text
"NOTICE" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
           , [Text
chan,Text
txt]    <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->

           case Text -> Maybe (Text, Text)
parseCtcp Text
txt of
             Just (Text
cmd,Text
args) -> Source -> Identifier -> Text -> Text -> IrcMsg
CtcpNotice Source
source (Text -> Identifier
mkId Text
chan) (Text -> Text
Text.toUpper Text
cmd) Text
args
             Maybe (Text, Text)
Nothing         -> Source -> Identifier -> Text -> IrcMsg
Notice Source
source (Text -> Identifier
mkId Text
chan) Text
txt

    Text
"JOIN" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
           , Text
chan:[Text]
rest <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg
           , let (Text
a, Text
r) = case [Text]
rest of
                            [Text
acct, Text
real] -> (Text
acct, Text
real)
                            [Text]
_            -> (Text
"", Text
"") ->
           Source -> Identifier -> Text -> Text -> IrcMsg
Join Source
source (Text -> Identifier
mkId Text
chan) Text
a Text
r

    Text
"QUIT" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
           , [Text]
reasons   <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
           Source -> Maybe Text -> IrcMsg
Quit Source
source ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)

    Text
"PART" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
           , Text
chan:[Text]
reasons <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
           Source -> Identifier -> Maybe Text -> IrcMsg
Part Source
source (Text -> Identifier
mkId Text
chan) ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)

    Text
"NICK"  | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
            , Text
newNick:[Text]
_ <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
           Source -> Identifier -> IrcMsg
Nick Source
source (Text -> Identifier
mkId Text
newNick)

    Text
"KICK"  | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
            , [Text
chan,Text
nick,Text
reason] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
           Source -> Identifier -> Identifier -> Text -> IrcMsg
Kick Source
source (Text -> Identifier
mkId Text
chan) (Text -> Identifier
mkId Text
nick) Text
reason

    Text
"KILL"  | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
            , [Text
nick,Text
reason] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
           Source -> Identifier -> Text -> IrcMsg
Kill Source
source (Text -> Identifier
mkId Text
nick) Text
reason

    Text
"TOPIC" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
            , [Text
chan,Text
topic] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
            Source -> Identifier -> Text -> IrcMsg
Topic Source
source (Text -> Identifier
mkId Text
chan) Text
topic

    Text
"MODE"  | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
            , Text
target:[Text]
modes <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
            Source -> Identifier -> [Text] -> IrcMsg
Mode Source
source (Text -> Identifier
mkId Text
target) [Text]
modes

    Text
"ERROR" | [Text
reason] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
            Text -> IrcMsg
Error Text
reason

    Text
"BATCH" | Text
refid : Text
ty : [Text]
params <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg
            , Just (Char
'+',Text
refid') <- Text -> Maybe (Char, Text)
Text.uncons Text
refid ->
            Text -> Text -> [Text] -> IrcMsg
BatchStart Text
refid' Text
ty [Text]
params

    Text
"BATCH" | [Text
refid] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg
            , Just (Char
'-',Text
refid') <- Text -> Maybe (Char, Text)
Text.uncons Text
refid ->
            Text -> IrcMsg
BatchEnd Text
refid'

    Text
"ACCOUNT" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
              , [Text
acct] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
      Source -> Text -> IrcMsg
Account Source
source (if Text
acct Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" then Text
"" else Text
acct)

    Text
"CHGHOST" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
              , [Text
newuser, Text
newhost] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
      Source -> Text -> Text -> IrcMsg
Chghost Source
source Text
newuser Text
newhost

    Text
"WALLOPS" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
              , [Text
txt] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
      Source -> Text -> IrcMsg
Wallops Source
source Text
txt

    Text
"INVITE" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
             , [Text
target, Text
channel] <- (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
      Source -> Identifier -> Identifier -> IrcMsg
Invite Source
source (Text -> Identifier
mkId Text
target) (Text -> Identifier
mkId Text
channel)

    Text
_      -> RawIrcMsg -> IrcMsg
UnknownMsg RawIrcMsg
msg

-- | Parse a CTCP encoded message:
--
-- @\^ACOMMAND arguments\^A@
parseCtcp :: Text -> Maybe (Text, Text)
parseCtcp :: Text -> Maybe (Text, Text)
parseCtcp Text
txt =
  do Text
txt1 <- Text -> Text -> Maybe Text
Text.stripSuffix Text
"\^A" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
Text.stripPrefix Text
"\^A" Text
txt
     let (Text
cmd,Text
args) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') Text
txt1
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
Text.null Text
cmd))
     (Text, Text) -> Maybe (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
cmd, Int -> Text -> Text
Text.drop Int
1 Text
args)


-- | Targets used to direct a message to a window for display
data MessageTarget
  = TargetUser   !Identifier -- ^ Metadata update for a user
  | TargetWindow !Identifier -- ^ Directed message to channel or from user
  | TargetNetwork            -- ^ Network-level message
  deriving (Int -> MessageTarget -> ShowS
[MessageTarget] -> ShowS
MessageTarget -> String
(Int -> MessageTarget -> ShowS)
-> (MessageTarget -> String)
-> ([MessageTarget] -> ShowS)
-> Show MessageTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageTarget] -> ShowS
$cshowList :: [MessageTarget] -> ShowS
show :: MessageTarget -> String
$cshow :: MessageTarget -> String
showsPrec :: Int -> MessageTarget -> ShowS
$cshowsPrec :: Int -> MessageTarget -> ShowS
Show)

-- | Target information for the window that could be appropriate to
-- display this message in.
msgTarget :: Identifier -> IrcMsg -> MessageTarget
msgTarget :: Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
me IrcMsg
msg =
  case IrcMsg
msg of
    UnknownMsg{}             -> MessageTarget
TargetNetwork
    Nick Source
user Identifier
_              -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
    Mode Source
_ Identifier
tgt [Text]
_ | Identifier
tgt Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
me -> MessageTarget
TargetNetwork
                 | Bool
otherwise -> Identifier -> MessageTarget
TargetWindow Identifier
tgt
    Join Source
_ Identifier
chan Text
_ Text
_          -> Identifier -> MessageTarget
TargetWindow Identifier
chan
    Part Source
_ Identifier
chan Maybe Text
_            -> Identifier -> MessageTarget
TargetWindow Identifier
chan
    Quit Source
user Maybe Text
_              -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
    Kick Source
_ Identifier
chan Identifier
_ Text
_          -> Identifier -> MessageTarget
TargetWindow Identifier
chan
    Kill Source
_ Identifier
_ Text
_               -> MessageTarget
TargetNetwork
    Topic Source
_ Identifier
chan Text
_           -> Identifier -> MessageTarget
TargetWindow Identifier
chan
    Invite{}                 -> MessageTarget
TargetNetwork
    Privmsg Source
src Identifier
tgt Text
_        -> UserInfo -> Identifier -> MessageTarget
directed (Source -> UserInfo
srcUser Source
src) Identifier
tgt
    Ctcp Source
src Identifier
tgt Text
_ Text
_         -> UserInfo -> Identifier -> MessageTarget
directed (Source -> UserInfo
srcUser Source
src) Identifier
tgt
    CtcpNotice Source
src Identifier
tgt Text
_ Text
_   -> UserInfo -> Identifier -> MessageTarget
directed (Source -> UserInfo
srcUser Source
src) Identifier
tgt
    Notice  Source
src Identifier
tgt Text
_        -> UserInfo -> Identifier -> MessageTarget
directed (Source -> UserInfo
srcUser Source
src) Identifier
tgt
    Authenticate{}           -> MessageTarget
TargetNetwork
    Ping{}                   -> MessageTarget
TargetNetwork
    Pong{}                   -> MessageTarget
TargetNetwork
    Error{}                  -> MessageTarget
TargetNetwork
    Cap{}                    -> MessageTarget
TargetNetwork
    Reply Text
_ ReplyCode
code [Text]
args        -> ReplyCode -> [Text] -> MessageTarget
replyTarget ReplyCode
code [Text]
args
    BatchStart{}             -> MessageTarget
TargetNetwork
    BatchEnd{}               -> MessageTarget
TargetNetwork
    Account Source
user Text
_           -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
    Chghost Source
user Text
_ Text
_         -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
    Wallops Source
_ Text
_              -> MessageTarget
TargetNetwork
  where
    directed :: UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
      | Text -> Bool
Text.null (UserInfo -> Text
userHost UserInfo
src) = MessageTarget
TargetNetwork -- server message
      | Identifier
tgt Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
me = Identifier -> MessageTarget
TargetWindow (UserInfo -> Identifier
userNick UserInfo
src)
      | Bool
otherwise = Identifier -> MessageTarget
TargetWindow Identifier
tgt

    replyTarget :: ReplyCode -> [Text] -> MessageTarget
replyTarget ReplyCode
RPL_TOPIC    (Text
_:Text
chan:[Text]
_)   = Identifier -> MessageTarget
TargetWindow (Text -> Identifier
mkId Text
chan)
    replyTarget ReplyCode
RPL_INVITING (Text
_:Text
_:Text
chan:[Text]
_) = Identifier -> MessageTarget
TargetWindow (Text -> Identifier
mkId Text
chan)
    replyTarget ReplyCode
_                [Text]
_        = MessageTarget
TargetNetwork

-- | 'UserInfo' of the user responsible for a message.
msgActor :: IrcMsg -> Maybe Source
msgActor :: IrcMsg -> Maybe Source
msgActor IrcMsg
msg =
  case IrcMsg
msg of
    UnknownMsg{}  -> Maybe Source
forall a. Maybe a
Nothing
    Reply{}       -> Maybe Source
forall a. Maybe a
Nothing
    Nick Source
x Identifier
_      -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Join Source
x Identifier
_ Text
_ Text
_  -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Part Source
x Identifier
_ Maybe Text
_    -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Quit Source
x Maybe Text
_      -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Kick Source
x Identifier
_ Identifier
_ Text
_  -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Kill Source
x Identifier
_ Text
_    -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Topic Source
x Identifier
_ Text
_   -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Privmsg Source
x Identifier
_ Text
_ -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Invite Source
x Identifier
_ Identifier
_  -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Ctcp Source
x Identifier
_ Text
_ Text
_  -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    CtcpNotice Source
x Identifier
_ Text
_ Text
_ -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Notice Source
x Identifier
_ Text
_  -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Mode Source
x Identifier
_ [Text]
_    -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Account Source
x Text
_   -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Authenticate{}-> Maybe Source
forall a. Maybe a
Nothing
    Ping{}        -> Maybe Source
forall a. Maybe a
Nothing
    Pong{}        -> Maybe Source
forall a. Maybe a
Nothing
    Error{}       -> Maybe Source
forall a. Maybe a
Nothing
    Cap{}         -> Maybe Source
forall a. Maybe a
Nothing
    BatchStart{}  -> Maybe Source
forall a. Maybe a
Nothing
    BatchEnd{}    -> Maybe Source
forall a. Maybe a
Nothing
    Chghost Source
x Text
_ Text
_ -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x
    Wallops Source
x Text
_   -> Source -> Maybe Source
forall a. a -> Maybe a
Just Source
x

renderSource :: Source -> Text
renderSource :: Source -> Text
renderSource (Source UserInfo
u Text
"") = UserInfo -> Text
renderUserInfo UserInfo
u
renderSource (Source UserInfo
u Text
a) = UserInfo -> Text
renderUserInfo UserInfo
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Text representation of an IRC message to be used for matching with
-- regular expressions.
ircMsgText :: IrcMsg -> Text
ircMsgText :: IrcMsg -> Text
ircMsgText IrcMsg
msg =
  case IrcMsg
msg of
    UnknownMsg RawIrcMsg
raw -> [Text] -> Text
Text.unwords (((Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg)
-> RawIrcMsg -> Text
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (Text -> Const Text Text) -> RawIrcMsg -> Const Text RawIrcMsg
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
raw Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (([Text] -> Const [Text] [Text])
 -> RawIrcMsg -> Const [Text] RawIrcMsg)
-> RawIrcMsg -> [Text]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Text] -> Const [Text] [Text])
-> RawIrcMsg -> Const [Text] RawIrcMsg
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
raw)
    Reply Text
srv (ReplyCode Word
n) [Text]
xs -> [Text] -> Text
Text.unwords (Text
srv Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: String -> Text
Text.pack (Word -> String
forall a. Show a => a -> String
show Word
n) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
    Nick Source
x Identifier
y       -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Identifier -> Text
idText Identifier
y]
    Join Source
x Identifier
_ Text
_ Text
_   -> Source -> Text
renderSource Source
x
    Part Source
x Identifier
_ Maybe Text
mb    -> [Text] -> Text
Text.unwords (Source -> Text
renderSource Source
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mb)
    Quit Source
x Maybe Text
mb      -> [Text] -> Text
Text.unwords (Source -> Text
renderSource Source
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mb)
    Kick Source
x Identifier
_ Identifier
z Text
r   -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Identifier -> Text
idText Identifier
z, Text
r]
    Kill Source
x Identifier
z Text
r     -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Identifier -> Text
idText Identifier
z, Text
r]
    Topic Source
x Identifier
_ Text
t    -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
t]
    Privmsg Source
x Identifier
_ Text
t  -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
t]
    Ctcp Source
x Identifier
_ Text
c Text
t   -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
c, Text
t]
    CtcpNotice Source
x Identifier
_ Text
c Text
t -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
c, Text
t]
    Notice Source
x Identifier
_ Text
t   -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
t]
    Mode Source
x Identifier
_ [Text]
xs    -> [Text] -> Text
Text.unwords (Source -> Text
renderSource Source
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
"set mode"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
    Ping [Text]
xs        -> [Text] -> Text
Text.unwords [Text]
xs
    Pong [Text]
xs        -> [Text] -> Text
Text.unwords [Text]
xs
    Cap CapCmd
cmd        -> CapCmd -> Text
capCmdText CapCmd
cmd
    Error Text
t        -> Text
t
    Account Source
x Text
a    -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
a]
    Authenticate{} -> Text
""
    BatchStart{}   -> Text
""
    BatchEnd{}     -> Text
""
    Invite Source
_ Identifier
_ Identifier
_   -> Text
""
    Chghost Source
x Text
a Text
b  -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
a, Text
b]
    Wallops Source
x Text
t    -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
t]

capCmdText :: CapCmd -> Text
capCmdText :: CapCmd -> Text
capCmdText CapCmd
cmd =
  case CapCmd
cmd of
    CapLs CapMore
more [(Text, Maybe Text)]
caps -> CapMore -> Text
capMoreText CapMore
more Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Maybe Text)] -> Text
capUnsplitCaps [(Text, Maybe Text)]
caps
    CapNew     [(Text, Maybe Text)]
caps -> [(Text, Maybe Text)] -> Text
capUnsplitCaps [(Text, Maybe Text)]
caps
    CapList    [Text]
caps -> [Text] -> Text
Text.unwords [Text]
caps
    CapAck     [Text]
caps -> [Text] -> Text
Text.unwords [Text]
caps
    CapNak     [Text]
caps -> [Text] -> Text
Text.unwords [Text]
caps
    CapDel     [Text]
caps -> [Text] -> Text
Text.unwords [Text]
caps

capMoreText :: CapMore -> Text
capMoreText :: CapMore -> Text
capMoreText CapMore
CapDone = Text
""
capMoreText CapMore
CapMore = Text
"* "

capUnsplitCaps :: [(Text, Maybe Text)] -> Text
capUnsplitCaps :: [(Text, Maybe Text)] -> Text
capUnsplitCaps [(Text, Maybe Text)]
xs = [Text] -> Text
Text.unwords [ Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
v | (Text
k, Maybe Text
v) <- [(Text, Maybe Text)]
xs ]

-- nickname   =  ( letter / special ) *8( letter / digit / special / "-" )
-- letter     =  %x41-5A / %x61-7A       ; A-Z / a-z
-- digit      =  %x30-39                 ; 0-9
-- special    =  %x5B-60 / %x7B-7D
isNickChar :: Char -> Bool
isNickChar :: Char -> Bool
isNickChar Char
x = Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
              Bool -> Bool -> Bool
|| Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'}'
              Bool -> Bool -> Bool
|| Char
'-' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x

-- | Split a nick into text parts group by whether or not those parts are valid
-- nickname characters.
nickSplit :: Text -> [Text]
nickSplit :: Text -> [Text]
nickSplit = (Char -> Char -> Bool) -> Text -> [Text]
Text.groupBy (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Char -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Bool
isNickChar)

-- | Maximum length computation for the message part for
-- privmsg and notice. Note that the need for the limit is because
-- the server will limit the length of the message sent out to each
-- client, not just the length of the messages it will recieve.
--
-- Note that the length is on the *encoded message* which is UTF-8
-- The calculation isn't using UTF-8 on the userinfo part because
-- I'm assuming that the channel name and userinfo are all ASCII
--
-- @
-- :my!user@info PRIVMSG #channel :messagebody\r\n
-- @
computeMaxMessageLength :: UserInfo -> Text -> Int
computeMaxMessageLength :: UserInfo -> Text -> Int
computeMaxMessageLength UserInfo
myUserInfo Text
target
  = Int
512 -- max IRC command
  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length (UserInfo -> Text
renderUserInfo UserInfo
myUserInfo)
  Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
": PRIVMSG  :\r\n"::String)
  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
target

splitCapList :: Text -> [(Text, Maybe Text)]
splitCapList :: Text -> [(Text, Maybe Text)]
splitCapList Text
caps =
  [ (Text
name, Maybe Text
value)
    | Text
kv <- Text -> [Text]
Text.words Text
caps
    , let (Text
name, Text
v) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char
'=' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
kv
    , let value :: Maybe Text
value | Text -> Bool
Text.null Text
v = Maybe Text
forall a. Maybe a
Nothing
                | Bool
otherwise   = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Text -> Text
Text.tail Text
v
    ]