    -- | 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. HasCallStack => [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. HasCallStack => [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 = return
            [ (command name)
                { help = say helpStr
                , aliases = aliases'
                , process = \String
    args -> do
                    tgt <- Cmd Topic Nick
    forall (m :: * -> *). Monad m => Cmd m Nick
    getTarget
                    (chan, rest) <- case splitFirstWord args of
                            (c :: String
    c@(Char
    '#':String
    _), String
    r)  -> do
                                c' <- String -> Cmd Topic Nick
    forall (m :: * -> *). Monad m => String -> Cmd m Nick
    readNick String
    c
                                return (Just c', r)
                            (String, String)
    _               -> case Nick -> String
    nName Nick
    tgt of
                                (Char
    '#':String
    _)         -> (Maybe Nick, String) -> Cmd Topic (Maybe Nick, String)
    forall a. a -> Cmd Topic a
    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 Topic (Maybe Nick, String)
    forall a. a -> Cmd Topic a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Nick
    forall a. Maybe a
    Nothing, String
    args)

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

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

    installTopic :: TopicAction
    installTopic :: TopicAction
    installTopic Nick
    chan String
    topic = Nick -> (String -> Cmd Topic ()) -> Cmd Topic ()
    withTopic Nick
    chan ((String -> Cmd Topic ()) -> Cmd Topic ())
    -> (String -> Cmd Topic ()) -> Cmd Topic ()
    forall a b. (a -> b) -> a -> b
    $ \String
    _ -> do
        LB () -> Cmd Topic ()
    forall a. LB a -> Cmd Topic a
    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 Topic ()) -> Cmd Topic ()
    withTopic Nick
    chan ((String -> Cmd Topic ()) -> Cmd Topic ())
    -> (String -> Cmd Topic ()) -> Cmd Topic ()
    forall a b. (a -> b) -> a -> b
    $ \String
    topic -> do
        String -> Cmd Topic ()
    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 Topic ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "One channel at a time.  Jeepers!"
    reciteTopic Nick
    _ String
    _           = String -> Cmd Topic ()
    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 Topic ()) -> Cmd Topic ()
    withTopic Nick
    chan ((String -> Cmd Topic ()) -> Cmd Topic ())
    -> (String -> Cmd Topic ()) -> Cmd Topic ()
    forall a b. (a -> b) -> a -> b
    $ \String
    oldTopic -> do
        LB () -> Cmd Topic ()
    forall a. LB a -> Cmd Topic a
    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 Topic ()) -> Cmd Topic ()
    withTopic Nick
    chan String -> Cmd Topic ()
    f = do
        maybetopic <- LB (Maybe String) -> Cmd Topic (Maybe String)
    forall a. LB a -> Cmd Topic a
    forall (m :: * -> *) a. MonadLB m => LB a -> m a
    lb (Nick -> LB (Maybe String)
    lookupTopic Nick
    chan)
        case maybetopic of
            Just String
    t  -> String -> Cmd Topic ()
    f String
    t
            Maybe String
    Nothing -> String -> Cmd Topic ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "I don't know that channel."