-- | The Topic plugin is an interface for messing with the channel topic.
--   It can alter the topic in various ways and keep track of the changes.
--   The advantage of having the bot maintain the topic is that we get an
--   authoritative source for the current topic, when the IRC server decides
--   to delete it due to Network Splits.
module Lambdabot.Plugin.IRC.Topic (topicPlugin) where

import Lambdabot.IRC
import Lambdabot.Monad
import Lambdabot.Plugin
import Lambdabot.Util

import qualified Data.Map as M

import Control.Monad.State (gets)

type Topic = ModuleT () LB

type TopicAction = Nick -> String -> Cmd Topic ()
data TopicCommand = TopicCommand
    { TopicCommand -> [String]
_commandAliases    :: [String]
    , TopicCommand -> String
_commandHelp       :: String
    , TopicCommand -> TopicAction
_invokeCommand     :: TopicAction
    }

commands :: [TopicCommand]
commands :: [TopicCommand]
commands =
    [ [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"set-topic"]
      String
"Set the topic of the channel, without using all that listy stuff"
      (TopicAction
installTopic)
    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"get-topic"]
      String
"Recite the topic of the channel"
      (TopicAction
reciteTopic)

    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"unshift-topic", String
"queue-topic"]
      String
"Add a new topic item to the front of the topic list"
      ((String -> [String] -> [String]) -> TopicAction
alterListTopic (:))
    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"shift-topic"]
      String
"Remove a topic item from the front of the topic list"
      ((String -> [String] -> [String]) -> TopicAction
alterListTopic (([String] -> [String]) -> String -> [String] -> [String]
forall a b. a -> b -> a
const [String] -> [String]
forall a. [a] -> [a]
tail))

    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"push-topic"]
      String
"Add a new topic item to the end of the topic stack"
      ((String -> [String] -> [String]) -> TopicAction
alterListTopic (\String
arg -> ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
arg])))
    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"pop-topic", String
"dequeue-topic"]
      String
"Pop an item from the end of the topic stack"
      ((String -> [String] -> [String]) -> TopicAction
alterListTopic (([String] -> [String]) -> String -> [String] -> [String]
forall a b. a -> b -> a
const [String] -> [String]
forall a. [a] -> [a]
init))

    , [String] -> String -> TopicAction -> TopicCommand
TopicCommand [String
"clear-topic"]
      String
"Empty the topic stack"
      ((String -> [String] -> [String]) -> TopicAction
alterListTopic (\String
_ [String]
_ -> []))
    ]

topicPlugin :: Module ()
topicPlugin :: Module ()
topicPlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
name)
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , aliases :: [String]
aliases = [String]
aliases'
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
args -> do
                Nick
tgt <- Cmd (ModuleT () LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
                (Maybe Nick
chan, String
rest) <- case String -> (String, String)
splitFirstWord String
args of
                        (c :: String
c@(Char
'#':String
_), String
r)  -> do
                            Nick
c' <- String -> Cmd (ModuleT () LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
c
                            (Maybe Nick, String) -> Cmd (ModuleT () LB) (Maybe Nick, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Nick -> Maybe Nick
forall a. a -> Maybe a
Just Nick
c', String
r)
                        (String, String)
_               -> case Nick -> String
nName Nick
tgt of
                            (Char
'#':String
_)         -> (Maybe Nick, String) -> Cmd (ModuleT () LB) (Maybe Nick, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Nick -> Maybe Nick
forall a. a -> Maybe a
Just Nick
tgt, String
args)
                            String
_               -> (Maybe Nick, String) -> Cmd (ModuleT () LB) (Maybe Nick, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Nick
forall a. Maybe a
Nothing, String
args)

                case Maybe Nick
chan of
                    Just Nick
chan' -> TopicAction
invoke Nick
chan' String
rest
                    Maybe Nick
Nothing    -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"What channel?"
            }
        | TopicCommand (String
name:[String]
aliases') String
helpStr TopicAction
invoke <- [TopicCommand]
commands
        ]
    }

------------------------------------------------------------------------
-- Topic action implementations

installTopic :: TopicAction
installTopic :: TopicAction
installTopic Nick
chan String
topic = Nick
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
withTopic Nick
chan ((String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ())
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
    LB () -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (IrcMessage -> LB ()
send (Nick -> String -> IrcMessage
setTopic Nick
chan String
topic))

reciteTopic :: TopicAction
reciteTopic :: TopicAction
reciteTopic Nick
chan String
""       = Nick
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
withTopic Nick
chan ((String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ())
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
forall a b. (a -> b) -> a -> b
$ \String
topic -> do
    String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (Nick -> String
nName Nick
chan String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
topic)
reciteTopic Nick
_ (Char
'#':String
_)     = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"One channel at a time.  Jeepers!"
reciteTopic Nick
_ String
_           = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"I don't know what all that extra stuff is about."

alterTopic :: (String -> String -> String) -> TopicAction
alterTopic :: (String -> String -> String) -> TopicAction
alterTopic String -> String -> String
f Nick
chan String
args = Nick
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
withTopic Nick
chan ((String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ())
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
forall a b. (a -> b) -> a -> b
$ \String
oldTopic -> do
    LB () -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (IrcMessage -> LB ()
send (Nick -> String -> IrcMessage
setTopic Nick
chan (String -> String -> String
f String
args String
oldTopic)))

alterListTopic :: (String -> [String] -> [String]) -> TopicAction
alterListTopic :: (String -> [String] -> [String]) -> TopicAction
alterListTopic String -> [String] -> [String]
f = (String -> String -> String) -> TopicAction
alterTopic ((String -> String -> String) -> TopicAction)
-> (String -> String -> String) -> TopicAction
forall a b. (a -> b) -> a -> b
$ \String
args String
topic -> [String] -> String
forall a. Show a => a -> String
show ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ case ReadS [String]
forall a. Read a => ReadS a
reads String
topic of
    [([String]
xs, String
"")]  -> String -> [String] -> [String]
f String
args [String]
xs
    [([String], String)]
_           -> String -> [String] -> [String]
f String
args [String
topic]

------------------------------------------------------------------------

lookupTopic :: Nick -> LB (Maybe String)
lookupTopic :: Nick -> LB (Maybe String)
lookupTopic Nick
chan = (IRCRWState -> Maybe String) -> LB (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\IRCRWState
s -> ChanName -> Map ChanName String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> ChanName
mkCN Nick
chan) (IRCRWState -> Map ChanName String
ircChannels IRCRWState
s))

-- | 'withTopic' is like 'lookupTopic' except that it ditches the Maybe in
--   favor of just yelling at the user when things don't work out as planned.
withTopic :: Nick -> (String -> Cmd Topic ()) -> Cmd Topic ()
withTopic :: Nick
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
withTopic Nick
chan String -> Cmd (ModuleT () LB) ()
f = do
    Maybe String
maybetopic <- LB (Maybe String) -> Cmd (ModuleT () LB) (Maybe String)
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (Nick -> LB (Maybe String)
lookupTopic Nick
chan)
    case Maybe String
maybetopic of
        Just String
t  -> String -> Cmd (ModuleT () LB) ()
f String
t
        Maybe String
Nothing -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"I don't know that channel."