{-# Language OverloadedStrings #-}
module Irc.Message
(
IrcMsg(..)
, CapCmd(..)
, CapMore(..)
, cookIrcMsg
, MessageTarget(..)
, ircMsgText
, msgTarget
, msgActor
, nickSplit
, computeMaxMessageLength
, capCmdText
) 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
data IrcMsg
= UnknownMsg !RawIrcMsg
| Reply !Text !ReplyCode [Text]
| Nick !UserInfo !Identifier
| Join !UserInfo !Identifier !Text !Text
| Part !UserInfo !Identifier (Maybe Text)
| Quit !UserInfo (Maybe Text)
| Kick !UserInfo !Identifier !Identifier !Text
| Topic !UserInfo !Identifier !Text
| Privmsg !UserInfo !Identifier !Text
| Ctcp !UserInfo !Identifier !Text !Text
| CtcpNotice !UserInfo !Identifier !Text !Text
| Notice !UserInfo !Identifier !Text
| Mode !UserInfo !Identifier [Text]
| Authenticate !Text
| Cap !CapCmd
| Ping [Text]
| Pong [Text]
| Error !Text
| BatchStart !Text !Text [Text]
| BatchEnd !Text
| Account !UserInfo !Text
| Chghost !UserInfo !Text !Text
| Wallops !UserInfo !Text
| Invite !UserInfo !Identifier !Identifier
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 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)
data CapCmd
= CapLs !CapMore [(Text, Maybe Text)]
| CapList [Text]
| CapAck [Text]
| CapNak [Text]
| CapNew [(Text, Maybe Text)]
| CapDel [Text]
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)
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
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 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
, [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) -> UserInfo -> Identifier -> Text -> Text -> IrcMsg
Ctcp UserInfo
user (Text -> Identifier
mkId Text
chan) (Text -> Text
Text.toUpper Text
cmd) Text
args
Maybe (Text, Text)
Nothing -> UserInfo -> Identifier -> Text -> IrcMsg
Privmsg UserInfo
user (Text -> Identifier
mkId Text
chan) Text
txt
Text
"NOTICE" | 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
, [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) -> UserInfo -> Identifier -> Text -> Text -> IrcMsg
CtcpNotice UserInfo
user (Text -> Identifier
mkId Text
chan) (Text -> Text
Text.toUpper Text
cmd) Text
args
Maybe (Text, Text)
Nothing -> UserInfo -> Identifier -> Text -> IrcMsg
Notice UserInfo
user (Text -> Identifier
mkId Text
chan) Text
txt
Text
"JOIN" | 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
, 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
"") ->
UserInfo -> Identifier -> Text -> Text -> IrcMsg
Join UserInfo
user (Text -> Identifier
mkId Text
chan) Text
a Text
r
Text
"QUIT" | 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
, [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 ->
UserInfo -> Maybe Text -> IrcMsg
Quit UserInfo
user ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)
Text
"PART" | 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
, 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 ->
UserInfo -> Identifier -> Maybe Text -> IrcMsg
Part UserInfo
user (Text -> Identifier
mkId Text
chan) ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)
Text
"NICK" | 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
, 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 ->
UserInfo -> Identifier -> IrcMsg
Nick UserInfo
user (Text -> Identifier
mkId Text
newNick)
Text
"KICK" | 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
, [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 ->
UserInfo -> Identifier -> Identifier -> Text -> IrcMsg
Kick UserInfo
user (Text -> Identifier
mkId Text
chan) (Text -> Identifier
mkId Text
nick) Text
reason
Text
"TOPIC" | 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
, [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 ->
UserInfo -> Identifier -> Text -> IrcMsg
Topic UserInfo
user (Text -> Identifier
mkId Text
chan) Text
topic
Text
"MODE" | 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
, 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 ->
UserInfo -> Identifier -> [Text] -> IrcMsg
Mode UserInfo
user (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 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
, [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 ->
UserInfo -> Text -> IrcMsg
Account UserInfo
user (if Text
acct Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" then Text
"" else Text
acct)
Text
"CHGHOST" | 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
, [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 ->
UserInfo -> Text -> Text -> IrcMsg
Chghost UserInfo
user Text
newuser Text
newhost
Text
"WALLOPS" | 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
, [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 ->
UserInfo -> Text -> IrcMsg
Wallops UserInfo
user Text
txt
Text
"INVITE" | 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
, [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 ->
UserInfo -> Identifier -> Identifier -> IrcMsg
Invite UserInfo
user (Text -> Identifier
mkId Text
target) (Text -> Identifier
mkId Text
channel)
Text
_ -> RawIrcMsg -> IrcMsg
UnknownMsg RawIrcMsg
msg
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)
data MessageTarget
= TargetUser !Identifier
| TargetWindow !Identifier
| TargetNetwork
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)
msgTarget :: Identifier -> IrcMsg -> MessageTarget
msgTarget :: Identifier -> IrcMsg -> MessageTarget
msgTarget Identifier
me IrcMsg
msg =
case IrcMsg
msg of
UnknownMsg{} -> MessageTarget
TargetNetwork
Nick UserInfo
user Identifier
_ -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick UserInfo
user)
Mode UserInfo
_ 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 UserInfo
_ Identifier
chan Text
_ Text
_ -> Identifier -> MessageTarget
TargetWindow Identifier
chan
Part UserInfo
_ Identifier
chan Maybe Text
_ -> Identifier -> MessageTarget
TargetWindow Identifier
chan
Quit UserInfo
user Maybe Text
_ -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick UserInfo
user)
Kick UserInfo
_ Identifier
chan Identifier
_ Text
_ -> Identifier -> MessageTarget
TargetWindow Identifier
chan
Topic UserInfo
_ Identifier
chan Text
_ -> Identifier -> MessageTarget
TargetWindow Identifier
chan
Invite{} -> MessageTarget
TargetNetwork
Privmsg UserInfo
src Identifier
tgt Text
_ -> UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
Ctcp UserInfo
src Identifier
tgt Text
_ Text
_ -> UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
CtcpNotice UserInfo
src Identifier
tgt Text
_ Text
_ -> UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
Notice UserInfo
src Identifier
tgt Text
_ -> UserInfo -> Identifier -> MessageTarget
directed UserInfo
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 UserInfo
user Text
_ -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick UserInfo
user)
Chghost UserInfo
user Text
_ Text
_ -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick UserInfo
user)
Wallops UserInfo
src Text
_ -> Identifier -> MessageTarget
TargetWindow (UserInfo -> Identifier
userNick UserInfo
src)
where
directed :: UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
| Text -> Bool
Text.null (UserInfo -> Text
userHost UserInfo
src) = MessageTarget
TargetNetwork
| 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
msgActor :: IrcMsg -> Maybe UserInfo
msgActor :: IrcMsg -> Maybe UserInfo
msgActor IrcMsg
msg =
case IrcMsg
msg of
UnknownMsg{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Reply{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Nick UserInfo
x Identifier
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Join UserInfo
x Identifier
_ Text
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Part UserInfo
x Identifier
_ Maybe Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Quit UserInfo
x Maybe Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Kick UserInfo
x Identifier
_ Identifier
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Topic UserInfo
x Identifier
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Privmsg UserInfo
x Identifier
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Invite UserInfo
x Identifier
_ Identifier
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Ctcp UserInfo
x Identifier
_ Text
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
CtcpNotice UserInfo
x Identifier
_ Text
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Notice UserInfo
x Identifier
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Mode UserInfo
x Identifier
_ [Text]
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Account UserInfo
x Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Authenticate{}-> Maybe UserInfo
forall a. Maybe a
Nothing
Ping{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Pong{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Error{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Cap{} -> Maybe UserInfo
forall a. Maybe a
Nothing
BatchStart{} -> Maybe UserInfo
forall a. Maybe a
Nothing
BatchEnd{} -> Maybe UserInfo
forall a. Maybe a
Nothing
Chghost UserInfo
x Text
_ Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
Wallops UserInfo
x Text
_ -> UserInfo -> Maybe UserInfo
forall a. a -> Maybe a
Just UserInfo
x
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 UserInfo
x Identifier
y -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Identifier -> Text
idText Identifier
y]
Join UserInfo
x Identifier
_ Text
_ Text
_ -> UserInfo -> Text
renderUserInfo UserInfo
x
Part UserInfo
x Identifier
_ Maybe Text
mb -> [Text] -> Text
Text.unwords (UserInfo -> Text
renderUserInfo UserInfo
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mb)
Quit UserInfo
x Maybe Text
mb -> [Text] -> Text
Text.unwords (UserInfo -> Text
renderUserInfo UserInfo
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mb)
Kick UserInfo
x Identifier
_ Identifier
z Text
r -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Identifier -> Text
idText Identifier
z, Text
r]
Topic UserInfo
x Identifier
_ Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
t]
Privmsg UserInfo
x Identifier
_ Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
t]
Ctcp UserInfo
x Identifier
_ Text
c Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
c, Text
t]
CtcpNotice UserInfo
x Identifier
_ Text
c Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
c, Text
t]
Notice UserInfo
x Identifier
_ Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
t]
Mode UserInfo
x Identifier
_ [Text]
xs -> [Text] -> Text
Text.unwords (UserInfo -> Text
renderUserInfo UserInfo
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 UserInfo
x Text
a -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
a]
Authenticate{} -> Text
""
BatchStart{} -> Text
""
BatchEnd{} -> Text
""
Invite UserInfo
_ Identifier
_ Identifier
_ -> Text
""
Chghost UserInfo
x Text
a Text
b -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
x, Text
a, Text
b]
Wallops UserInfo
x Text
t -> [Text] -> Text
Text.unwords [UserInfo -> Text
renderUserInfo UserInfo
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 ]
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
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)
computeMaxMessageLength :: UserInfo -> Text -> Int
computeMaxMessageLength :: UserInfo -> Text -> Int
computeMaxMessageLength UserInfo
myUserInfo Text
target
= Int
512
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
]