{-# Language OverloadedStrings #-}
module Client.Hook.Matterbridge (matterbridgeHook) where
import Data.Text (Text)
import Control.Lens (set, view)
import Text.Regex.TDFA ((=~))
import Client.Hook (MessageHook(..), MessageResult(..))
import Irc.Message
import Irc.Identifier (mkId, Identifier)
import Irc.UserInfo (UserInfo(..), uiNick)
data MbMsg = Msg | Act
matterbridgeHook :: [Text] -> Maybe MessageHook
matterbridgeHook :: [Text] -> Maybe MessageHook
matterbridgeHook [] = Maybe MessageHook
forall a. Maybe a
Nothing
matterbridgeHook (Text
nick:[Text]
chans) = MessageHook -> Maybe MessageHook
forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"matterbridge" Bool
False (Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap (Text -> Identifier
mkId Text
nick) Identifier -> Bool
chanfilter))
where
chanfilter :: Identifier -> Bool
chanfilter
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
chans = Bool -> Identifier -> Bool
forall a b. a -> b -> a
const Bool
True
| Bool
otherwise = (Identifier -> [Identifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId [Text]
chans)
remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult
remap Identifier
nick Identifier -> Bool
chanfilter IrcMsg
ircmsg =
case IrcMsg
ircmsg of
Privmsg (Source UserInfo
ui Text
_) Identifier
chan Text
msg
| Getting Identifier UserInfo Identifier -> UserInfo -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier UserInfo Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick UserInfo
ui Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nick, Identifier -> Bool
chanfilter Identifier
chan -> MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
Msg UserInfo
ui Identifier
chan Text
msg
Ctcp (Source UserInfo
ui Text
_) Identifier
chan Text
"ACTION" Text
msg
| Getting Identifier UserInfo Identifier -> UserInfo -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier UserInfo Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick UserInfo
ui Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
nick, Identifier -> Bool
chanfilter Identifier
chan -> MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
Act UserInfo
ui Identifier
chan Text
msg
IrcMsg
_ -> MessageResult
PassMessage
remap' :: MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' :: MbMsg -> UserInfo -> Identifier -> Text -> MessageResult
remap' MbMsg
mbmsg UserInfo
ui Identifier
chan Text
msg =
case Text
msg Text -> Text -> [[Text]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^<([^>]+)> (.*)$"::Text) of
[Text
_,Text
nick,Text
msg']:[[Text]]
_ -> IrcMsg -> MessageResult
RemapMessage (MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg MbMsg
mbmsg (Text -> UserInfo -> Source
fakeUser Text
nick UserInfo
ui) Identifier
chan Text
msg')
[[Text]]
_ -> MessageResult
PassMessage
newmsg :: MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg :: MbMsg -> Source -> Identifier -> Text -> IrcMsg
newmsg MbMsg
Msg Source
src Identifier
chan Text
msg = Source -> Identifier -> Text -> IrcMsg
Privmsg Source
src Identifier
chan Text
msg
newmsg MbMsg
Act Source
src Identifier
chan Text
msg = Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp Source
src Identifier
chan Text
"ACTION" Text
msg
fakeUser :: Text -> UserInfo -> Source
fakeUser :: Text -> UserInfo -> Source
fakeUser Text
nick UserInfo
ui = UserInfo -> Text -> Source
Source (ASetter UserInfo UserInfo Identifier Identifier
-> Identifier -> UserInfo -> UserInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UserInfo UserInfo Identifier Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick (Text -> Identifier
mkId Text
nick) UserInfo
ui) Text
""