{-# Language QuasiQuotes, OverloadedStrings #-}
module Client.Hook.DroneBLRelay
( droneblRelayHook
) where
import Data.List (uncons)
import qualified Data.Text as Text
import Data.Text (Text)
import Data.Foldable (asum)
import Text.Regex.TDFA (match, defaultCompOpt, defaultExecOpt, Regex)
import Text.Regex.TDFA.String (compile)
import Client.Hook (MessageHook(..), MessageResult(..))
import Irc.Message
import Irc.Identifier (mkId, Identifier)
import Irc.UserInfo (UserInfo(..))
import StrQuote (str)
droneblRelayHook :: [Text] -> Maybe MessageHook
droneblRelayHook :: [Text] -> Maybe MessageHook
droneblRelayHook [Text]
args = MessageHook -> Maybe MessageHook
forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"droneblrelay" Bool
False ([Identifier] -> IrcMsg -> MessageResult
remap ((Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
mkId [Text]
args)))
remap :: [Identifier] -> IrcMsg -> MessageResult
remap :: [Identifier] -> IrcMsg -> MessageResult
remap [Identifier]
nicks (Privmsg (Source (UserInfo Identifier
nick Text
_ Text
_) Text
_) chan :: Identifier
chan@Identifier
"#dronebl" Text
msg)
| Identifier
nick Identifier -> [Identifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Identifier]
nicks
, Just IrcMsg
sub <- Identifier -> Text -> Maybe IrcMsg
rules Identifier
chan Text
msg = IrcMsg -> MessageResult
RemapMessage IrcMsg
sub
remap [Identifier]
_ IrcMsg
_ = MessageResult
PassMessage
rules ::
Identifier ->
Text ->
Maybe IrcMsg
rules :: Identifier -> Text -> Maybe IrcMsg
rules Identifier
chan Text
msg =
[Maybe IrcMsg] -> Maybe IrcMsg
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ (Text -> Text -> IrcMsg) -> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> IrcMsg
chatMsg Identifier
chan) Regex
chatRe Text
msg
, (Text -> Text -> IrcMsg) -> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> IrcMsg
actionMsg Identifier
chan) Regex
actionRe Text
msg
, (Text -> Text -> Text -> Text -> IrcMsg)
-> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> Text -> Text -> IrcMsg
joinMsg Identifier
chan) Regex
joinRe Text
msg
, (Text -> Text -> Text -> Text -> IrcMsg)
-> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> Text -> Text -> IrcMsg
partMsg Identifier
chan) Regex
partRe Text
msg
, (Text -> Text -> Text -> IrcMsg) -> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule Text -> Text -> Text -> IrcMsg
quitMsg Regex
quitRe Text
msg
, (Text -> Text -> Text -> IrcMsg) -> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule Text -> Text -> Text -> IrcMsg
nickMsg Regex
nickRe Text
msg
, (Text -> Text -> Text -> Text -> IrcMsg)
-> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> Text -> Text -> IrcMsg
kickMsg Identifier
chan) Regex
kickRe Text
msg
, (Text -> Text -> Text -> IrcMsg) -> Regex -> Text -> Maybe IrcMsg
forall r. Rule r => r -> Regex -> Text -> Maybe IrcMsg
rule (Identifier -> Text -> Text -> Text -> IrcMsg
modeMsg Identifier
chan) Regex
modeRe Text
msg
]
rule ::
Rule r =>
r ->
Regex ->
Text ->
Maybe IrcMsg
rule :: r -> Regex -> Text -> Maybe IrcMsg
rule r
mk Regex
re Text
s =
case ([String] -> [Text]) -> [[String]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack) (Regex -> String -> [[String]]
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
re (Text -> String
Text.unpack Text
s)) of
[Text
_:[Text]
xs] -> [Text] -> r -> Maybe IrcMsg
forall a. Rule a => [Text] -> a -> Maybe IrcMsg
matchRule [Text]
xs r
mk
[[Text]]
_ -> Maybe IrcMsg
forall a. Maybe a
Nothing
chatRe, actionRe, joinRe, quitRe, nickRe, partRe, kickRe, modeRe :: Regex
Right Regex
chatRe = Text -> Either String Regex
compRe [str|^<([^>]+)> (.*)$|]
Right Regex
actionRe = Text -> Either String Regex
compRe [str|^\* ([^ ]+) (.*)$|]
Right Regex
joinRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) \(([^@]+)@([^)]+)\) has joined the channel$|]
Right Regex
quitRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) has signed off \((.*)\)$|]
Right Regex
nickRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) changed nick to ([^ ]+)$|]
Right Regex
partRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) has left the channel( \((.*)\))?$|]
Right Regex
kickRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) has been kicked by ([^ ]+) \((.*)\)$|]
Right Regex
modeRe = Text -> Either String Regex
compRe [str|^\*\*\* \[([^]]+)\] ([^ ]+) sets mode (.*)$|]
compRe ::
Text ->
Either String Regex
compRe :: Text -> Either String Regex
compRe = CompOption -> ExecOption -> String -> Either String Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (String -> Either String Regex)
-> (Text -> String) -> Text -> Either String Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
chatMsg ::
Identifier ->
Text ->
Text ->
IrcMsg
chatMsg :: Identifier -> Text -> Text -> IrcMsg
chatMsg Identifier
chan Text
nick Text
msg =
Source -> Identifier -> Text -> IrcMsg
Privmsg
(Text -> Source
userInfo Text
nick)
Identifier
chan
Text
msg
actionMsg ::
Identifier ->
Text ->
Text ->
IrcMsg
actionMsg :: Identifier -> Text -> Text -> IrcMsg
actionMsg Identifier
chan Text
nick Text
msg =
Source -> Identifier -> Text -> Text -> IrcMsg
Ctcp
(Text -> Source
userInfo Text
nick)
Identifier
chan
Text
"ACTION"
Text
msg
joinMsg ::
Identifier ->
Text ->
Text ->
Text ->
Text ->
IrcMsg
joinMsg :: Identifier -> Text -> Text -> Text -> Text -> IrcMsg
joinMsg Identifier
chan Text
srv Text
nick Text
user Text
host =
Source -> Identifier -> Text -> Text -> IrcMsg
Join
(UserInfo -> Text -> Source
Source (Identifier -> Text -> Text -> UserInfo
UserInfo (Text -> Identifier
mkId (Text
nick Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv)) Text
user Text
host) Text
"")
Identifier
chan
Text
""
Text
""
partMsg ::
Identifier ->
Text ->
Text ->
Text ->
Text ->
IrcMsg
partMsg :: Identifier -> Text -> Text -> Text -> Text -> IrcMsg
partMsg Identifier
chan Text
srv Text
nick Text
msg_outer Text
msg =
Source -> Identifier -> Maybe Text -> IrcMsg
Part
(Text -> Source
userInfo (Text
nick Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
Identifier
chan
(if Text -> Bool
Text.null Text
msg_outer then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg)
quitMsg ::
Text ->
Text ->
Text ->
IrcMsg
quitMsg :: Text -> Text -> Text -> IrcMsg
quitMsg Text
srv Text
nick Text
msg =
Source -> Maybe Text -> IrcMsg
Quit
(Text -> Source
userInfo (Text
nick Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
(Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg)
nickMsg ::
Text ->
Text ->
Text ->
IrcMsg
nickMsg :: Text -> Text -> Text -> IrcMsg
nickMsg Text
srv Text
old Text
new =
Source -> Identifier -> IrcMsg
Nick
(Text -> Source
userInfo (Text
old Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
(Text -> Identifier
mkId (Text
new Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
kickMsg ::
Identifier ->
Text ->
Text ->
Text ->
Text ->
IrcMsg
kickMsg :: Identifier -> Text -> Text -> Text -> Text -> IrcMsg
kickMsg Identifier
chan Text
srv Text
kickee Text
kicker Text
reason =
Source -> Identifier -> Identifier -> Text -> IrcMsg
Kick
(Text -> Source
userInfo (Text
kicker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
Identifier
chan
(Text -> Identifier
mkId (Text
kickee Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
Text
reason
modeMsg ::
Identifier ->
Text ->
Text ->
Text ->
IrcMsg
modeMsg :: Identifier -> Text -> Text -> Text -> IrcMsg
modeMsg Identifier
chan Text
srv Text
nick Text
modes =
Source -> Identifier -> [Text] -> IrcMsg
Mode
(Text -> Source
userInfo (Text
nick Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srv))
Identifier
chan
(Text -> [Text]
Text.words Text
modes)
userInfo ::
Text ->
Source
userInfo :: Text -> Source
userInfo Text
nick = UserInfo -> Text -> Source
Source (Identifier -> Text -> Text -> UserInfo
UserInfo (Text -> Identifier
mkId Text
nick) Text
"*" Text
"*") Text
""
class Rule a where
matchRule :: [Text] -> a -> Maybe IrcMsg
instance (RuleArg a, Rule b) => Rule (a -> b) where
matchRule :: [Text] -> (a -> b) -> Maybe IrcMsg
matchRule [Text]
tts a -> b
f =
do (Text
t,[Text]
ts) <- [Text] -> Maybe (Text, [Text])
forall a. [a] -> Maybe (a, [a])
uncons [Text]
tts
a
a <- Text -> Maybe a
forall a. RuleArg a => Text -> Maybe a
matchArg Text
t
[Text] -> b -> Maybe IrcMsg
forall a. Rule a => [Text] -> a -> Maybe IrcMsg
matchRule [Text]
ts (a -> b
f a
a)
instance Rule IrcMsg where
matchRule :: [Text] -> IrcMsg -> Maybe IrcMsg
matchRule [Text]
args IrcMsg
ircMsg
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args = IrcMsg -> Maybe IrcMsg
forall a. a -> Maybe a
Just IrcMsg
ircMsg
| Bool
otherwise = Maybe IrcMsg
forall a. Maybe a
Nothing
class RuleArg a where matchArg :: Text -> Maybe a
instance RuleArg Text where matchArg :: Text -> Maybe Text
matchArg = Text -> Maybe Text
forall a. a -> Maybe a
Just