-- | Provide help for plugins
module Lambdabot.Plugin.Core.Help (helpPlugin) where

import Lambdabot.Command
import Lambdabot.Message (Message)
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Plugin
import Lambdabot.Util

import Control.Monad.Reader

helpPlugin :: Module ()
helpPlugin :: Module ()
helpPlugin = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"help")
            { help :: Cmd (ModuleT () LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"help <command>. Ask for help for <command>. Try 'list' for all commands"
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
args -> forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a b. (a -> b) -> a -> b
$ \a
msg -> do
                Nick
tgt <- forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
                forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (forall t. Message t => t -> Nick -> String -> LB [String]
doHelp a
msg Nick
tgt String
args) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say
            }
        ]
    }

moduleHelp :: (Monad m, Message a) =>
              Command m -> a -> Nick -> String -> m [String]
moduleHelp :: forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> String -> m [String]
moduleHelp Command m
theCmd a
msg Nick
tgt String
cmd =
    forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> String -> m [String]
execCmd (forall (m :: * -> *). Command m -> Cmd m ()
help Command m
theCmd) a
msg Nick
tgt String
cmd

--
-- If a target is a command, find the associated help, otherwise if it's
-- a module, return a list of commands that module implements.
--
doHelp :: Message t => t -> Nick -> [Char] -> LB [[Char]]
doHelp :: forall t. Message t => t -> Nick -> String -> LB [String]
doHelp t
msg Nick
tgt [] = forall t. Message t => t -> Nick -> String -> LB [String]
doHelp t
msg Nick
tgt String
"help"
doHelp t
msg Nick
tgt String
rest =
    forall a.
String
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand String
arg                  -- see if it is a command
        (forall a. String -> LB a -> (forall st. ModuleT st LB a) -> LB a
inModuleNamed String
arg           -- else maybe it's a module name
            (forall t. Message t => t -> Nick -> String -> LB [String]
doHelp t
msg Nick
tgt String
"help")             -- else give up
            (do -- its a module
                [Command (ModuleT st LB)]
cmds <- forall st. Module st -> ModuleT st LB [Command (ModuleT st LB)]
moduleCmds forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> Module st
theModule
                let ss :: [String]
ss = [Command (ModuleT st LB)]
cmds forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Command m -> [String]
cmdNames
                let s :: String
s | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss   = String
arg forall a. [a] -> [a] -> [a]
++ String
" is a module."
                      | Bool
otherwise = String
arg forall a. [a] -> [a] -> [a]
++ String
" provides: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
showClean [String]
ss
                forall (m :: * -> *) a. Monad m => a -> m a
return [String
s]))

        -- so it's a valid command, try to find its help
        (\Command (ModuleT st LB)
theCmd -> forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> String -> m [String]
moduleHelp Command (ModuleT st LB)
theCmd t
msg Nick
tgt String
arg)

    where (String
arg:[String]
_) = String -> [String]
words String
rest