{-# Language OverloadedStrings #-}
module Client.Hook.Znc.Buffextras
( buffextrasHook
) where
import Client.Hook (MessageHook(MessageHook), MessageResult(..))
import Data.Attoparsec.Text as P
import Data.Text as Text (Text, null, words)
import Irc.Identifier (Identifier, mkId)
import Irc.Message (IrcMsg(Topic, Privmsg, Join, Quit, Part, Nick, Mode, Kick), Source(Source, srcUser))
import Irc.RawIrcMsg (prefixParser, simpleTokenParser)
import Irc.UserInfo (UserInfo(userNick))
buffextrasHook :: [Text] -> Maybe MessageHook
[Text]
args =
case [Text]
args of
[] -> forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
False))
[Text
"debug"] -> forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
True))
[Text]
_ -> forall a. Maybe a
Nothing
remap ::
Bool ->
IrcMsg -> MessageResult
remap :: Bool -> IrcMsg -> MessageResult
remap Bool
debug (Privmsg Source
user Identifier
chan Text
msg)
| UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user) forall a. Eq a => a -> a -> Bool
== Identifier
"*buffextras"
, Right IrcMsg
newMsg <- forall a. Parser a -> Text -> Either String a
parseOnly (Identifier -> Parser IrcMsg
prefixedParser Identifier
chan) Text
msg
= IrcMsg -> MessageResult
RemapMessage IrcMsg
newMsg
| UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user) forall a. Eq a => a -> a -> Bool
== Identifier
"*buffextras"
, Bool -> Bool
not Bool
debug
= MessageResult
OmitMessage
remap Bool
_ IrcMsg
_ = MessageResult
PassMessage
prefixedParser :: Identifier -> Parser IrcMsg
prefixedParser :: Identifier -> Parser IrcMsg
prefixedParser Identifier
chan = do
UserInfo
pfx <- Parser UserInfo
prefixParser
let src :: Source
src = UserInfo -> Text -> Source
Source UserInfo
pfx Text
""
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ Source -> Identifier -> Text -> Text -> IrcMsg
Join Source
src Identifier
chan Text
"" Text
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"joined"
, Source -> Maybe Text -> IrcMsg
Quit Source
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"quit:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
, Source -> Identifier -> Maybe Text -> IrcMsg
Part Source
src Identifier
chan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"parted:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
, Source -> Identifier -> IrcMsg
Nick Source
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"is now known as" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
simpleTokenParser
, Source -> Identifier -> [Text] -> IrcMsg
Mode Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"set mode:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
allTokens
, Source -> Identifier -> Identifier -> Text -> IrcMsg
Kick Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"kicked" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Identifier
parseId forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser ()
skipToken Text
"with reason:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
, Source -> Identifier -> Text -> IrcMsg
Topic Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"changed the topic to:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
]
allTokens :: Parser [Text]
allTokens :: Parser [Text]
allTokens = Text -> [Text]
Text.words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
P.takeText
skipToken :: Text -> Parser ()
skipToken :: Text -> Parser ()
skipToken Text
m = Text -> Parser Text
string Text
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
==Char
' ')
parseId :: Parser Identifier
parseId :: Parser Identifier
parseId = Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
simpleTokenParser
filterEmpty :: Text -> Maybe Text
filterEmpty :: Text -> Maybe Text
filterEmpty Text
txt
| Text -> Bool
Text.null Text
txt = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just Text
txt