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