{-# Language TemplateHaskell #-}

{-|
Module      : Client.Hook
Description : Hooks into the operation of the client.
Copyright   : (c) Dan Doel, 2016
License     : ISC
Maintainer  : dan.doel@gmail.com

This module defines types for hooking into the operation of the client.

-}

module Client.Hook
  ( -- | * Message hook results
    MessageResult(..)
    -- | * Message hooks
  , MessageHook(..)
  , messageHookName
  , messageHookStateful
  , messageHookAction
  , applyMessageHooks
  ) where

import Control.Lens
import Data.Text

import Irc.Message

-- | The possible results of a 'MessageHook' action. A hook can decline to
-- handle a message ('PassMessage'), filter out a message ('OmitMessage'),
-- or change a message into an arbitrary other message ('RemapMessage').
data MessageResult
  = PassMessage -- ^ continue processing
  | OmitMessage -- ^ stop processing and drop message
  | RemapMessage IrcMsg -- ^ stop processing and return new message
  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

-- 'PassMessage' is an identity element
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

-- A hook into the IRC message portion of the event loop. 'MessageHook's are
-- able to filter out or alter 'IrcMsg's, and may do so in a way that either
-- affects the overall 'ClientState' or just the chat view.
data MessageHook = MessageHook
  { MessageHook -> Text
_messageHookName     :: Text -- ^ Identifying name for the hook
  , MessageHook -> Bool
_messageHookStateful :: Bool -- ^ Whether the remapping should affect client state
  , MessageHook -> IrcMsg -> MessageResult
_messageHookAction   :: IrcMsg -> MessageResult
      -- ^ (Partial) message remapping action
  }

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 :: [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