{-# Language TemplateHaskell #-}
module Client.Hook
(
MessageResult(..)
, MessageHook(..)
, messageHookName
, messageHookStateful
, messageHookAction
, applyMessageHooks
) where
import Control.Lens
import Data.Text
import Irc.Message
data MessageResult
= PassMessage
| OmitMessage
| RemapMessage IrcMsg
deriving Int -> MessageResult -> ShowS
[MessageResult] -> ShowS
MessageResult -> String
(Int -> MessageResult -> ShowS)
-> (MessageResult -> String)
-> ([MessageResult] -> ShowS)
-> Show MessageResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageResult] -> ShowS
$cshowList :: [MessageResult] -> ShowS
show :: MessageResult -> String
$cshow :: MessageResult -> String
showsPrec :: Int -> MessageResult -> ShowS
$cshowsPrec :: Int -> MessageResult -> ShowS
Show
instance Semigroup MessageResult where
MessageResult
PassMessage <> :: MessageResult -> MessageResult -> MessageResult
<> MessageResult
r = MessageResult
r
MessageResult
l <> MessageResult
_ = MessageResult
l
instance Monoid MessageResult where
mempty :: MessageResult
mempty = MessageResult
PassMessage
mappend :: MessageResult -> MessageResult -> MessageResult
mappend = MessageResult -> MessageResult -> MessageResult
forall a. Semigroup a => a -> a -> a
(<>)
maybeFromResult :: IrcMsg -> MessageResult -> Maybe IrcMsg
maybeFromResult :: IrcMsg -> MessageResult -> Maybe IrcMsg
maybeFromResult IrcMsg
original MessageResult
PassMessage = IrcMsg -> Maybe IrcMsg
forall a. a -> Maybe a
Just IrcMsg
original
maybeFromResult IrcMsg
_ MessageResult
OmitMessage = Maybe IrcMsg
forall a. Maybe a
Nothing
maybeFromResult IrcMsg
_ (RemapMessage IrcMsg
new) = IrcMsg -> Maybe IrcMsg
forall a. a -> Maybe a
Just IrcMsg
new
data MessageHook = MessageHook
{ MessageHook -> Text
_messageHookName :: Text
, MessageHook -> Bool
_messageHookStateful :: Bool
, MessageHook -> IrcMsg -> MessageResult
_messageHookAction :: IrcMsg -> MessageResult
}
makeLenses ''MessageHook
applyMessageHooks :: [MessageHook] -> IrcMsg -> Maybe IrcMsg
applyMessageHooks :: [MessageHook] -> IrcMsg -> Maybe IrcMsg
applyMessageHooks [MessageHook]
hs IrcMsg
msg =
IrcMsg -> MessageResult -> Maybe IrcMsg
maybeFromResult IrcMsg
msg (MessageResult -> Maybe IrcMsg) -> MessageResult -> Maybe IrcMsg
forall a b. (a -> b) -> a -> b
$
(MessageHook -> MessageResult) -> [MessageHook] -> MessageResult
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\MessageHook
h -> Getting
(IrcMsg -> MessageResult) MessageHook (IrcMsg -> MessageResult)
-> MessageHook -> IrcMsg -> MessageResult
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(IrcMsg -> MessageResult) MessageHook (IrcMsg -> MessageResult)
Lens' MessageHook (IrcMsg -> MessageResult)
messageHookAction MessageHook
h IrcMsg
msg) [MessageHook]
hs