{-# Language OverloadedStrings #-}
module Irc.Message
(
IrcMsg(..)
, CapCmd(..)
, CapMore(..)
, cookIrcMsg
, MessageTarget(..)
, ircMsgText
, msgTarget
, msgActor
, msgSource
, 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
data IrcMsg
= UnknownMsg !RawIrcMsg
| Reply !Text !ReplyCode [Text]
| Nick !Source !Identifier
| Join !Source !Identifier !Text !Text
| Part !Source !Identifier (Maybe Text)
| Quit !Source (Maybe Text)
| Kick !Source !Identifier !Identifier !Text
| Kill !Source !Identifier !Text
| Topic !Source !Identifier !Text
| Privmsg !Source !Identifier !Text
| Ctcp !Source !Identifier !Text !Text
| CtcpNotice !Source !Identifier !Text !Text
| Notice !Source !Identifier !Text
| Mode !Source !Identifier [Text]
| Authenticate !Text
| Cap !CapCmd
| Ping [Text]
| Pong [Text]
| Error !Text
| BatchStart !Text !Text [Text]
| BatchEnd !Text
| Account !Source !Text
| Chghost !Source !Text !Text
| Wallops !Source !Text
| Invite !Source !Identifier !Identifier
| Away !Source (Maybe Text)
deriving Int -> IrcMsg -> ShowS
[IrcMsg] -> ShowS
IrcMsg -> String
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
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
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]
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
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
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
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
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]
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
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
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
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]) -> 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]) -> 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]) -> forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapList (Text -> [Text]
Text.words Text
caps))
(Text
"ACK" , [ Text
caps]) -> forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapAck (Text -> [Text]
Text.words Text
caps))
(Text
"NAK" , [ Text
caps]) -> forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapNak (Text -> [Text]
Text.words Text
caps))
(Text
"NEW" , [ Text
caps]) -> forall a. a -> Maybe a
Just ([(Text, Maybe Text)] -> CapCmd
CapNew (Text -> [(Text, Maybe Text)]
splitCapList Text
caps))
(Text
"DEL" , [ Text
caps]) -> forall a. a -> Maybe a
Just ([Text] -> CapCmd
CapDel (Text -> [Text]
Text.words Text
caps))
(Text, [Text])
_ -> forall a. Maybe a
Nothing
msgSource :: RawIrcMsg -> Maybe Source
msgSource :: RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg =
case forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
msg of
Maybe UserInfo
Nothing -> forall a. Maybe a
Nothing
Just UserInfo
p ->
case [Text
a | TagEntry Text
"account" Text
a <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg
msgTags RawIrcMsg
msg ] of
[] -> forall a. a -> Maybe a
Just (UserInfo -> Text -> Source
Source UserInfo
p Text
"")
Text
a:[Text]
_ -> forall a. a -> Maybe a
Just (UserInfo -> Text -> Source
Source UserInfo
p Text
a)
cookIrcMsg :: RawIrcMsg -> IrcMsg
cookIrcMsg :: RawIrcMsg -> IrcMsg
cookIrcMsg RawIrcMsg
msg =
case forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
msg of
Text
cmd | Just UserInfo
user <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg
msgPrefix RawIrcMsg
msg
, Right (Word
n,Text
"") <- 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) (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg)
Text
"CAP" | Text
_target:Text
cmdTxt:[Text]
rest <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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]
_ <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
Text -> IrcMsg
Authenticate Text
x
Text
"PING" -> [Text] -> IrcMsg
Ping (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg)
Text
"PONG" -> [Text] -> IrcMsg
Pong (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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 <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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 <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
Source -> Maybe Text -> IrcMsg
Quit Source
source (forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)
Text
"PART" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
, Text
chan:[Text]
reasons <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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) (forall a. [a] -> Maybe a
listToMaybe [Text]
reasons)
Text
"NICK" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
, Text
newNick:[Text]
_ <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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 <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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 <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
Source -> Text -> IrcMsg
Account Source
source (if Text
acct 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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] <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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
"AWAY" | Just Source
source <- RawIrcMsg -> Maybe Source
msgSource RawIrcMsg
msg
, [Text]
message <- forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg ->
Source -> Maybe Text -> IrcMsg
Away Source
source (forall a. [a] -> Maybe a
listToMaybe [Text]
message)
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" 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 (forall a. Eq a => a -> a -> Bool
==Char
' ') Text
txt1
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
Text.null Text
cmd))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
cmd, Int -> Text -> Text
Text.drop Int
1 Text
args)
data MessageTarget
= TargetUser !Identifier
| TargetExisting !Identifier
| TargetWindow !Identifier
| TargetNetwork
deriving (Int -> MessageTarget -> ShowS
[MessageTarget] -> ShowS
MessageTarget -> String
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 Source
user Identifier
_ -> Identifier -> MessageTarget
TargetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
Mode Source
_ Identifier
tgt [Text]
_ | Identifier
tgt 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
Away Source
user Maybe Text
_ -> Identifier -> MessageTarget
TargetExisting (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
where
directed :: UserInfo -> Identifier -> MessageTarget
directed UserInfo
src Identifier
tgt
| Text -> Bool
Text.null (UserInfo -> Text
userHost UserInfo
src) = MessageTarget
TargetNetwork
| Identifier
tgt 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
RPL_NOWAWAY (Text
who:[Text]
_) = Identifier -> MessageTarget
TargetUser (Text -> Identifier
mkId Text
who)
replyTarget ReplyCode
RPL_UNAWAY (Text
who:[Text]
_) = Identifier -> MessageTarget
TargetUser (Text -> Identifier
mkId Text
who)
replyTarget ReplyCode
_ [Text]
_ = MessageTarget
TargetNetwork
msgActor :: IrcMsg -> Maybe Source
msgActor :: IrcMsg -> Maybe Source
msgActor IrcMsg
msg =
case IrcMsg
msg of
UnknownMsg{} -> forall a. Maybe a
Nothing
Reply{} -> forall a. Maybe a
Nothing
Nick Source
x Identifier
_ -> forall a. a -> Maybe a
Just Source
x
Join Source
x Identifier
_ Text
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Part Source
x Identifier
_ Maybe Text
_ -> forall a. a -> Maybe a
Just Source
x
Quit Source
x Maybe Text
_ -> forall a. a -> Maybe a
Just Source
x
Kick Source
x Identifier
_ Identifier
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Kill Source
x Identifier
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Topic Source
x Identifier
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Privmsg Source
x Identifier
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Invite Source
x Identifier
_ Identifier
_ -> forall a. a -> Maybe a
Just Source
x
Ctcp Source
x Identifier
_ Text
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
CtcpNotice Source
x Identifier
_ Text
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Notice Source
x Identifier
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Mode Source
x Identifier
_ [Text]
_ -> forall a. a -> Maybe a
Just Source
x
Account Source
x Text
_ -> forall a. a -> Maybe a
Just Source
x
Authenticate{}-> forall a. Maybe a
Nothing
Ping{} -> forall a. Maybe a
Nothing
Pong{} -> forall a. Maybe a
Nothing
Error{} -> forall a. Maybe a
Nothing
Cap{} -> forall a. Maybe a
Nothing
BatchStart{} -> forall a. Maybe a
Nothing
BatchEnd{} -> forall a. Maybe a
Nothing
Chghost Source
x Text
_ Text
_ -> forall a. a -> Maybe a
Just Source
x
Wallops Source
x Text
_ -> forall a. a -> Maybe a
Just Source
x
Away Source
x Maybe Text
_ -> 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 forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
a forall a. Semigroup a => a -> a -> a
<> Text
")"
ircMsgText :: IrcMsg -> Text
ircMsgText :: IrcMsg -> Text
ircMsgText IrcMsg
msg =
case IrcMsg
msg of
UnknownMsg RawIrcMsg
raw -> [Text] -> Text
Text.unwords (forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
raw forall a. a -> [a] -> [a]
: forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view 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 forall a. a -> [a] -> [a]
: String -> Text
Text.pack (forall a. Show a => a -> String
show Word
n) 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 forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe Text
mb)
Quit Source
x Maybe Text
mb -> [Text] -> Text
Text.unwords (Source -> Text
renderSource Source
x forall a. a -> [a] -> [a]
: 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
xforall a. a -> [a] -> [a]
:Text
"set mode"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]
Away Source
x (Just Text
t) -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
"away", Text
t]
Away Source
x Maybe Text
Nothing -> [Text] -> Text
Text.unwords [Source -> Text
renderSource Source
x, Text
"back"]
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 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 forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'9'
Bool -> Bool -> Bool
|| Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'}'
Bool -> Bool -> Bool
|| Char
'-' forall a. Eq a => a -> a -> Bool
== Char
x
nickSplit :: Text -> [Text]
nickSplit :: Text -> [Text]
nickSplit = (Char -> Char -> Bool) -> Text -> [Text]
Text.groupBy (forall a. Eq a => a -> a -> 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
forall a. Num a => a -> a -> a
- Text -> Int
Text.length (UserInfo -> Text
renderUserInfo UserInfo
myUserInfo)
forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
": PRIVMSG :\r\n"::String)
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
'=' forall a. Eq a => a -> a -> Bool
==) Text
kv
, let value :: Maybe Text
value | Text -> Bool
Text.null Text
v = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Text -> Text
Text.tail Text
v
]