diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for Calamity +## 0.1.14.9 + +* Support manually invoking commands. + ## 0.1.14.8 *2020-06-21* diff --git a/calamity.cabal b/calamity.cabal --- a/calamity.cabal +++ b/calamity.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: b703a1d32e704130629ed6fcd9b163debe4dc5f03cacb736036bf9e142bde656 +-- hash: f72f949bfceab606de1405fc387f5c350303bcb5a2b05af291acc246bbdb49ae name: calamity -version: 0.1.14.8 +version: 0.1.14.9 synopsis: A library for writing discord bots in haskell description: Please see the README on GitHub at category: Network, Web diff --git a/src/Calamity/Commands.hs b/src/Calamity/Commands.hs --- a/src/Calamity/Commands.hs +++ b/src/Calamity/Commands.hs @@ -40,7 +40,7 @@ -- -- ==== Custom Events -- --- the event handler registered by 'addCommands' will fire the following custom events: +-- The event handler registered by 'addCommands' will fire the following custom events: -- -- 1. @"command-error" ('Context', 'CommandError')@ -- @@ -53,6 +53,13 @@ -- 3. @"command-invoked" 'Context'@ -- -- Fired when a command is successfully invoked. +-- +-- 'addCommands' will also register event handlers for the following events: +-- +-- 1. @"invoke-command" ('Calamity.Types.Model.Channel.Message', 'Data.Text.Lazy.Text')@ +-- +-- Given a message and a command string, manually invoke a command +-- treating it as if it originated from the provided 'Message'. -- -- -- ==== Registered Metrics diff --git a/src/Calamity/Commands/Utils.hs b/src/Calamity/Commands/Utils.hs --- a/src/Calamity/Commands/Utils.hs +++ b/src/Calamity/Commands/Utils.hs @@ -3,7 +3,9 @@ module Calamity.Commands.Utils ( addCommands , buildCommands - , buildContext ) where + , buildContext + , handleCommands + , findCommand ) where import Calamity.Cache.Eff import Calamity.Metrics.Eff @@ -44,36 +46,70 @@ mapLeft _ (Right x) = Right x data FailReason - = NoPrefix - | NoCtx + = NoCtx | NF [L.Text] | ERR Context CommandError -- | Construct commands and groups from a command DSL, then registers an event -- handler on the bot that manages running those commands. -- +-- This registers the following event handler for: @"invoke-command" ('Message', +-- 'L.Text')@ that takes a message and the command string to invoke (without a +-- prefix) +-- -- Returns an action to remove the event handler, and the 'CommandHandler' that was constructed addCommands :: (BotC r, P.Member ParsePrefix r) => P.Sem (DSLState r) a -> P.Sem r (P.Sem r (), CommandHandler, a) addCommands m = do (handler, res) <- buildCommands m remove <- react @'MessageCreateEvt $ \msg -> do - err <- P.runError $ do - (prefix, rest) <- P.note NoPrefix =<< parsePrefix msg - (command, unparsedParams) <- P.fromEither $ mapLeft NF $ findCommand handler rest - ctx <- P.note NoCtx =<< buildContext msg prefix command unparsedParams - P.fromEither . mapLeft (ERR ctx) =<< invokeCommand ctx (ctx ^. #command) - pure ctx - case err of - Left (ERR ctx e) -> fire $ customEvt @"command-error" (ctx, e) - Left (NF path) -> fire $ customEvt @"command-not-found" path - Left _ -> pure () -- ignore if no prefix or if context couldn't be built - Right ctx -> do - cmdInvoke <- registerCounter "commands_invoked" [("name", S.unwords $ commandPath (ctx ^. #command))] - void $ addCounter 1 cmdInvoke - fire $ customEvt @"command-invoked" ctx - pure (remove, handler, res) + parsePrefix msg >>= \case + Just (prefix, cmd) -> + handleCommands handler msg prefix cmd + Nothing -> pure () + remove' <- react @('CustomEvt "invoke-command" (Message, L.Text)) $ \(msg, cmd) -> do + handleCommands handler msg "" cmd + pure (remove *> remove', handler, res) +-- | Manages parsing messages and handling commands for a CommandHandler. +-- +-- ==== Custom Events +-- +-- This will fire the following events: +-- +-- 1. @"command-error" ('Context', 'CommandError')@ +-- +-- Fired when a command returns an error. +-- +-- 2. @"command-not-found" ['Data.Text.Lazy.Text']@ +-- +-- Fired when a valid prefix is used, but the command is not found. +-- +-- 3. @"command-invoked" 'Context'@ +-- +-- Fired when a command is successfully invoked. +-- +handleCommands :: (BotC r, P.Member ParsePrefix r) + => CommandHandler + -> Message -- ^ The message that invoked the command + -> L.Text -- ^ The prefix used + -> L.Text -- ^ The command string, without a prefix + -> P.Sem r () +handleCommands handler msg prefix cmd = do + err <- P.runError $ do + (command, unparsedParams) <- P.fromEither $ mapLeft NF $ findCommand handler cmd + ctx <- P.note NoCtx =<< buildContext msg prefix command unparsedParams + P.fromEither . mapLeft (ERR ctx) =<< invokeCommand ctx (ctx ^. #command) + pure ctx + case err of + Left (ERR ctx e) -> fire $ customEvt @"command-error" (ctx, e) + Left (NF path) -> fire $ customEvt @"command-not-found" path + Left _ -> pure () -- ignore if no prefix or if context couldn't be built + Right ctx -> do + cmdInvoke <- registerCounter "commands_invoked" [("name", S.unwords $ commandPath (ctx ^. #command))] + void $ addCounter 1 cmdInvoke + fire $ customEvt @"command-invoked" ctx + -- | Run a command DSL, returning the constructed 'CommandHandler' buildCommands :: forall r a. P.Member (P.Final IO) r => P.Sem (DSLState r) a @@ -113,6 +149,17 @@ nextWord :: L.Text -> (L.Text, L.Text) nextWord = L.break isSpace . L.stripStart +-- | Attempt to find what command was used. +-- +-- On error: returns the path of existing groups that were found, so @"group0 +-- group1 group2 notacommand"@ will error with @Left ["group0", "group1", +-- "group2"]@ +-- +-- On success: returns the command that was invoked, and the remaining text +-- after it. +-- +-- This function isn't greedy, if you have a group and a command at the same +-- level, this will find the command first and ignore the group. findCommand :: CommandHandler -> L.Text -> Either [L.Text] (Command, L.Text) findCommand handler msg = goH $ nextWord msg where