{-# Language TemplateHaskell #-}
module Client.Hook
(
MessageResult(..)
, MessageHook(..)
, messageHookName
, messageHookStateful
, messageHookAction
, applyMessageHooks
) where
import Control.Lens
import Data.Semigroup
import Data.Text
import Irc.Message
data MessageResult
= PassMessage
| OmitMessage
| RemapMessage IrcMsg
instance Semigroup MessageResult where
PassMessage <> r = r
l <> _ = l
instance Monoid MessageResult where
mempty = PassMessage
mappend = (<>)
maybeFromResult :: IrcMsg -> MessageResult -> Maybe IrcMsg
maybeFromResult original PassMessage = Just original
maybeFromResult _ OmitMessage = Nothing
maybeFromResult _ (RemapMessage new) = Just new
data MessageHook = MessageHook
{ _messageHookName :: Text
, _messageHookStateful :: Bool
, _messageHookAction :: IrcMsg -> MessageResult
}
makeLenses ''MessageHook
-- | Apply the given message hooks to an 'IrcMsg'. The hooks are tried in
-- order until one handles the message. A 'Nothing' result means the message was
-- filtered out by a hook. A 'Just' result contains the actual 'IrcMsg' to be
-- processed.
applyMessageHooks :: [MessageHook] -> IrcMsg -> Maybe IrcMsg
applyMessageHooks hs msg =
maybeFromResult msg $
foldMap (\h -> view messageHookAction h msg) hs