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 ["set-topic"]
"Set the topic of the channel, without using all that listy stuff"
(TopicAction
installTopic)
, [String] -> String -> TopicAction -> TopicCommand
TopicCommand ["get-topic"]
"Recite the topic of the channel"
(TopicAction
reciteTopic)
, [String] -> String -> TopicAction -> TopicCommand
TopicCommand ["unshift-topic", "queue-topic"]
"Add a new topic item to the front of the topic list"
((String -> [String] -> [String]) -> TopicAction
alterListTopic (:))
, [String] -> String -> TopicAction -> TopicCommand
TopicCommand ["shift-topic"]
"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 ["push-topic"]
"Add a new topic item to the end of the topic stack"
((String -> [String] -> [String]) -> TopicAction
alterListTopic (\arg :: String
arg -> ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
arg])))
, [String] -> String -> TopicAction -> TopicCommand
TopicCommand ["pop-topic", "dequeue-topic"]
"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 ["clear-topic"]
"Empty the topic stack"
((String -> [String] -> [String]) -> TopicAction
alterListTopic (\_ _ -> []))
]
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 = \args :: String
args -> do
Nick
tgt <- Cmd (ModuleT () LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
(chan :: Maybe Nick
chan, rest :: String
rest) <- case String -> (String, String)
splitFirstWord String
args of
(c :: String
c@('#':_), r :: 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)
_ -> case Nick -> String
nName Nick
tgt of
('#':_) -> (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)
_ -> (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 chan' :: Nick
chan' -> TopicAction
invoke Nick
chan' String
rest
Nothing -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "What channel?"
}
| TopicCommand (name :: String
name:aliases' :: [String]
aliases') helpStr :: String
helpStr invoke :: TopicAction
invoke <- [TopicCommand]
commands
]
}
installTopic :: TopicAction
installTopic :: TopicAction
installTopic chan :: Nick
chan topic :: 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
$ \_ -> 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 chan :: Nick
chan "" = 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
$ \topic :: 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
forall a. [a] -> [a] -> [a]
++ String
topic)
reciteTopic _ ('#':_) = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "One channel at a time. Jeepers!"
reciteTopic _ _ = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "I don't know what all that extra stuff is about."
alterTopic :: (String -> String -> String) -> TopicAction
alterTopic :: (String -> String -> String) -> TopicAction
alterTopic f :: String -> String -> String
f chan :: Nick
chan args :: 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
$ \oldTopic :: 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 f :: String -> [String] -> [String]
f = (String -> String -> String) -> TopicAction
alterTopic ((String -> String -> String) -> TopicAction)
-> (String -> String -> String) -> TopicAction
forall a b. (a -> b) -> a -> b
$ \args :: String
args topic :: 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
[(xs :: [String]
xs, "")] -> String -> [String] -> [String]
f String
args [String]
xs
_ -> String -> [String] -> [String]
f String
args [String
topic]
lookupTopic :: Nick -> LB (Maybe String)
lookupTopic :: Nick -> LB (Maybe String)
lookupTopic chan :: Nick
chan = (IRCRWState -> Maybe String) -> LB (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\s :: 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 :: Nick -> (String -> Cmd Topic ()) -> Cmd Topic ()
withTopic :: Nick
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
withTopic chan :: Nick
chan f :: 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 t :: String
t -> String -> Cmd (ModuleT () LB) ()
f String
t
Nothing -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "I don't know that channel."