calamity 0.1.14.8 → 0.1.14.9

raw patch · 4 files changed

+79/−21 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• calamity.cabal +2/−2
• src/Calamity/Commands.hs +8/−1
• src/Calamity/Commands/Utils.hs +65/−18

@@ -1,5 +1,9 @@ # Changelog for Calamity +## 0.1.14.9++* Support manually invoking commands.+ ## 0.1.14.8  *2020-06-21*

@@ -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 <https://github.com/nitros12/calamity#readme> category:       Network, Web

@@ -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

@@ -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