calamity 0.1.14.3 → 0.1.14.4

raw patch · 12 files changed

+251/−82 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• calamity.cabal +3/−2
• src/Calamity/Commands/AliasType.hs +15/−0
• src/Calamity/Commands/Command.hs +6/−4
• src/Calamity/Commands/CommandUtils.hs +12/−9
• src/Calamity/Commands/Dsl.hs +104/−27
• src/Calamity/Commands/Group.hs +11/−8
• src/Calamity/Commands/Handler.hs +3/−2
• src/Calamity/Commands/Help.hs +57/−24
• src/Calamity/Commands/Utils.hs +8/−5
• src/Calamity/Gateway/Types.hs +2/−1
• src/Calamity/Types/Model/Presence/Activity.hs +19/−0

@@ -1,5 +1,16 @@ # Changelog for Calamity +## 0.1.14.4++*2020-06-11*++* Added `activity` to construct Activities++* Added aliases for commands and groups, with new functions to create them+  (`commandA`, `groupA`, ...).++* The built in help command now shows aliases and checks.+ ## 0.1.14.3  *2020-06-10*

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9dad5aee926a8bb786caf940edbfef86c22f29c508eefff636e965a4d10a01af+-- hash: f4c6fde3ae6f429b22eea33179e85d448bc6d821e6d0e78fdfa8bd664dc74dc5  name:           calamity-version:        0.1.14.3+version:        0.1.14.4 synopsis:       A library for writing discord bots description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -41,6 +41,7 @@       Calamity.Client.ShardManager       Calamity.Client.Types       Calamity.Commands+      Calamity.Commands.AliasType       Calamity.Commands.Check       Calamity.Commands.Command       Calamity.Commands.CommandUtils

@@ -0,0 +1,15 @@+-- | Named boolean for determining if something is an alias or not+module Calamity.Commands.AliasType+  ( AliasType (..),+  )+where++import GHC.Generics (Generic)+import TextShow (TextShow)+import qualified TextShow.Generic as TSG++data AliasType+  = Alias+  | Original+  deriving (Eq, Enum, Show, Generic)+  deriving (TextShow) via TSG.FromGeneric AliasType

@@ -9,6 +9,7 @@  import           Control.Lens              hiding ( (<.>), Context ) +import           Data.List.NonEmpty        ( NonEmpty ) import           Data.Text                 as S import           Data.Text.Lazy            as L @@ -16,10 +17,11 @@  import           TextShow import qualified TextShow.Generic          as TSG+import qualified Data.List.NonEmpty as NE  -- | A command data Command = forall a. Command-  { name     :: S.Text+  { names    :: NonEmpty S.Text   , parent   :: Maybe Group   , checks   :: [Check] -- TODO check checks on default help     -- ^ A list of checks that must pass for this command to be invoked@@ -37,7 +39,7 @@   }  data CommandS = CommandS-  { name   :: S.Text+  { names  :: NonEmpty S.Text   , params :: [S.Text]   , parent :: Maybe S.Text   , checks :: [S.Text]@@ -46,9 +48,9 @@   deriving ( TextShow ) via TSG.FromGeneric CommandS  instance Show Command where-  showsPrec d Command { name, params, parent, checks } = showsPrec d $ CommandS name params (parent ^? _Just . #name)+  showsPrec d Command { names, params, parent, checks } = showsPrec d $ CommandS names params (NE.head <$> parent ^? _Just . #names)     (checks ^.. traverse . #name)  instance TextShow Command where-  showbPrec d Command { name, params, parent, checks } = showbPrec d $ CommandS name params (parent ^? _Just . #name)+  showbPrec d Command { names, params, parent, checks } = showbPrec d $ CommandS names params (NE.head <$> parent ^? _Just . #names)     (checks ^.. traverse . #name)

@@ -26,6 +26,8 @@  import           Data.Foldable import           Data.Kind+import           Data.List.NonEmpty          ( NonEmpty(..) )+import qualified Data.List.NonEmpty          as NE import           Data.Maybe import           Data.Text                   as S import           Data.Text.Lazy              as L@@ -35,10 +37,10 @@ import qualified Polysemy.Fail               as P  groupPath :: Group -> [S.Text]-groupPath grp = maybe [] groupPath (grp ^. #parent) ++ [grp ^. #name]+groupPath Group { names, parent } = maybe [] groupPath parent ++ [NE.head names]  commandPath :: Command -> [S.Text]-commandPath Command { name, parent } = maybe [] groupPath parent ++ [name]+commandPath Command { names, parent } = maybe [] groupPath parent ++ [NE.head names]  commandParams :: Command -> L.Text commandParams Command { params } = L.fromStrict $ S.unwords params@@ -47,7 +49,7 @@ -- 'P.Sem' monad, build a command by transforming the Polysemy actions into IO -- actions. buildCommand' :: P.Member (P.Final IO) r-              => S.Text+              => NonEmpty S.Text               -> Maybe Group               -> [Check]               -> [S.Text]@@ -55,10 +57,10 @@               -> (Context -> P.Sem r (Either CommandError a))               -> ((Context, a) -> P.Sem (P.Fail ': r) ())               -> P.Sem r Command-buildCommand' name parent checks params help parser cb = do+buildCommand' names@(name :| _) parent checks params help parser cb = do   cb' <- buildCallback cb   parser' <- buildParser name parser-  pure $ Command name parent checks params help parser' cb'+  pure $ Command names parent checks params help parser' cb'  -- | Given the properties of a 'Command', a callback, and a type level list of -- the parameters, build a command by constructing a parser and wiring it up to@@ -78,14 +80,15 @@ -- @ buildCommand :: forall ps r.              (P.Member (P.Final IO) r, TypedCommandC ps r)-             => S.Text+             => NonEmpty S.Text              -> Maybe Group              -> [Check]              -> (Context -> L.Text)              -> (Context -> CommandForParsers ps r)              -> P.Sem r Command-buildCommand name parent checks help command = let (parser, cb) = buildTypedCommand @ps command-                                               in buildCommand' name parent checks (paramNames @ps @r) help parser cb+buildCommand names parent checks help command =+  let (parser, cb) = buildTypedCommand @ps command+  in buildCommand' names parent checks (paramNames @ps @r) help parser cb  -- | Given the name of the command the parser is for and a parser function in -- the 'P.Sem' monad, build a parser by transforming the Polysemy action into an@@ -112,7 +115,7 @@  -- | Given an invokation 'Context', run a command. This does not perform the command's checks. runCommand :: P.Member (P.Embed IO) r => Context -> Command -> P.Sem r (Either CommandError ())-runCommand ctx Command { name, parser, callback } = P.embed (parser ctx) >>= \case+runCommand ctx Command { names = name :| _, parser, callback } = P.embed (parser ctx) >>= \case   Left e   -> pure $ Left e   Right p' -> P.embed (callback (ctx, p')) <&> justToEither . (InvokeError name <$>) 

@@ -2,17 +2,22 @@  -- | A DSL for generating commands and groups module Calamity.Commands.Dsl-    ( command'-    , command+    ( command+    , command'+    , commandA+    , commandA'     , help     , requires     , requires'     , requiresPure     , group     , group'+    , groupA+    , groupA'     , DSLState     , raiseDSL ) where +import           Calamity.Commands.AliasType import           Calamity.Commands.Check import           Calamity.Commands.Command     hiding ( help ) import           Calamity.Commands.CommandUtils@@ -31,15 +36,19 @@ import qualified Polysemy.Tagged               as P import qualified Polysemy.Fixpoint             as P import qualified Polysemy.Reader               as P+import Data.List.NonEmpty (NonEmpty(..)) -type DSLState r = (LocalWriter (LH.HashMap S.Text Command) ':-                       LocalWriter (LH.HashMap S.Text Group) ':-                       P.Reader (Maybe Group) ':-                       P.Reader (Context -> L.Text) ':-                       P.Tagged "original-help" (P.Reader (Context -> L.Text)) ':-                       P.Reader [Check] ':-                       P.Reader CommandHandler ':-                       P.Fixpoint ': r)+type DSLState r =+  ( LocalWriter (LH.HashMap S.Text (Command, AliasType))+      ': LocalWriter (LH.HashMap S.Text (Group, AliasType))+      ': P.Reader (Maybe Group)+      ': P.Reader (Context -> L.Text)+      ': P.Tagged "original-help" (P.Reader (Context -> L.Text))+      ': P.Reader [Check]+      ': P.Reader CommandHandler+      ': P.Fixpoint+      ': r+  )  raiseDSL :: P.Sem r a -> P.Sem (DSLState r) a raiseDSL = P.raise . P.raise . P.raise . P.raise . P.raise . P.raise . P.raise . P.raise@@ -56,12 +65,28 @@   -> (Context -> P.Sem r (Either CommandError a))   -> ((Context, a) -> P.Sem (P.Fail ': r) ())   -> P.Sem (DSLState r) Command-command' name params parser cb = do+command' name params parser cb = commandA' name [] params parser cb++-- | Given the command name, aliases, and parameter names, @parser@ and @callback@ for a+-- command in the 'P.Sem' monad, build a command by transforming the Polysemy+-- actions into IO actions. Then register the command.+--+-- The parent group, checks, and command help are drawn from the reader context.+commandA'+  :: P.Member (P.Final IO) r+  => S.Text -- ^ name+  -> [S.Text] -- ^ aliases+  -> [S.Text] -- ^ parameter names+  -> (Context -> P.Sem r (Either CommandError a))+  -> ((Context, a) -> P.Sem (P.Fail ': r) ())+  -> P.Sem (DSLState r) Command+commandA' name aliases params parser cb = do   parent <- P.ask @(Maybe Group)   checks <- P.ask @[Check]   help' <- P.ask @(Context -> L.Text)-  cmd <- raiseDSL $ buildCommand' name parent checks params help' parser cb-  ltell $ LH.singleton name cmd+  cmd <- raiseDSL $ buildCommand' (name :| aliases) parent checks params help' parser cb+  ltell $ LH.singleton name (cmd, Original)+  ltell $ LH.fromList [(name, (cmd, Alias)) | name <- aliases]   pure cmd  -- | Given the name of a command and a callback, and a type level list of@@ -86,12 +111,38 @@         => S.Text         -> (Context -> CommandForParsers ps r)         -> P.Sem (DSLState r) Command-command name cmd = do+command name cmd = commandA @ps name [] cmd++-- | Given the name and aliases of a command and a callback, and a type level list of+-- the parameters, build and register a command.+--+-- ==== Examples+--+-- Building a command that bans a user by id.+--+-- @+-- 'commandA' \@\'['Calamity.Commands.Parser.Named' "user" ('Calamity.Types.Snowflake' 'Calamity.Types.Model.User'),+--                'Calamity.Commands.Parser.Named' "reason" ('Calamity.Commands.Parser.KleeneStarConcat' 'S.Text')]+--    "ban" [] $ \ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of+--      'Just' guild -> do+--        'Control.Monad.void' . 'Calamity.HTTP.invoke' . 'Calamity.HTTP.reason' r $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid+--        'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r)+--      'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'L.Text' ctx "Can only ban users from guilds."+-- @+commandA :: forall ps r.+        ( P.Member (P.Final IO) r,+          TypedCommandC ps r)+        => S.Text -- ^ name+        -> [S.Text] -- ^ aliases+        -> (Context -> CommandForParsers ps r)+        -> P.Sem (DSLState r) Command+commandA name aliases cmd = do   parent <- P.ask @(Maybe Group)   checks <- P.ask @[Check]   help' <- P.ask @(Context -> L.Text)-  cmd' <- raiseDSL $ buildCommand @ps name parent checks help' cmd-  ltell $ LH.singleton name cmd'+  cmd' <- raiseDSL $ buildCommand @ps (name :| aliases) parent checks help' cmd+  ltell $ LH.singleton name (cmd', Original)+  ltell $ LH.fromList [(name, (cmd', Alias)) | name <- aliases]   pure cmd'  -- | Set the help for any groups or commands registered inside the given action.@@ -135,17 +186,30 @@          => S.Text          -> P.Sem (DSLState r) a          -> P.Sem (DSLState r) a-group name m = mdo+group name m = groupA name [] m++-- | Construct a group with aliases and place any commands registered in the given action+-- into the new group.+--+-- This also resets the @help@ function back to it's original value, use+-- 'group'' if you don't want that (i.e. your help function is context aware).+groupA :: P.Member (P.Final IO) r+         => S.Text -- ^ name+         -> [S.Text] -- ^ aliases+         -> P.Sem (DSLState r) a+         -> P.Sem (DSLState r) a+groupA name aliases m = mdo   parent <- P.ask @(Maybe Group)   checks <- P.ask @[Check]   help'  <- P.ask @(Context -> L.Text)   origHelp <- fetchOrigHelp-  let group' = Group name parent commands children help' checks-  (children, (commands, res)) <- llisten @(LH.HashMap S.Text Group) $-                                 llisten @(LH.HashMap S.Text Command) $+  let group' = Group (name :| aliases) parent commands children help' checks+  (children, (commands, res)) <- llisten @(LH.HashMap S.Text (Group, AliasType)) $+                                 llisten @(LH.HashMap S.Text (Command, AliasType)) $                                  P.local @(Maybe Group) (const $ Just group') $                                  P.local @(Context -> L.Text) (const origHelp) m-  ltell $ LH.singleton name group'+  ltell $ LH.singleton name (group', Original)+  ltell $ LH.fromList [(name, (group', Alias)) | name <- aliases]   pure res  fetchOrigHelp :: P.Member (P.Tagged "original-help" (P.Reader (Context -> L.Text))) r => P.Sem r (Context -> L.Text)@@ -157,16 +221,29 @@ -- Unlike 'help' this doesn't reset the @help@ function back to it's original -- value. group' :: P.Member (P.Final IO) r-         => S.Text+         => S.Text -- ^ name          -> P.Sem (DSLState r) a          -> P.Sem (DSLState r) a-group' name m = mdo+group' name m = groupA' name [] m++-- | Construct a group with aliases and place any commands registered in the given action+-- into the new group.+--+-- Unlike 'help' this doesn't reset the @help@ function back to it's original+-- value.+groupA' :: P.Member (P.Final IO) r+         => S.Text -- ^ name+         -> [S.Text] -- ^ aliases+         -> P.Sem (DSLState r) a+         -> P.Sem (DSLState r) a+groupA' name aliases m = mdo   parent <- P.ask @(Maybe Group)   checks <- P.ask @[Check]   help'  <- P.ask @(Context -> L.Text)-  let group' = Group name parent commands children help' checks-  (children, (commands, res)) <- llisten @(LH.HashMap S.Text Group) $-                                 llisten @(LH.HashMap S.Text Command) $+  let group' = Group (name :| aliases) parent commands children help' checks+  (children, (commands, res)) <- llisten @(LH.HashMap S.Text (Group, AliasType)) $+                                 llisten @(LH.HashMap S.Text (Command, AliasType)) $                                  P.local @(Maybe Group) (const $ Just group') m-  ltell $ LH.singleton name group'+  ltell $ LH.singleton name (group', Original)+  ltell $ LH.fromList [(name, (group', Alias)) | name <- aliases]   pure res

@@ -2,6 +2,7 @@ module Calamity.Commands.Group     ( Group(..) ) where +import           Calamity.Commands.AliasType import           Calamity.Commands.Check import {-# SOURCE #-} Calamity.Commands.Command import {-# SOURCE #-} Calamity.Commands.Context@@ -16,14 +17,16 @@  import           TextShow import qualified TextShow.Generic          as TSG+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE  -- | A group of commands data Group = Group-  { name     :: S.Text+  { names    :: NonEmpty S.Text   , parent   :: Maybe Group-  , commands :: LH.HashMap S.Text Command+  , commands :: LH.HashMap S.Text (Command, AliasType)     -- ^ Any child commands of this group-  , children :: LH.HashMap S.Text Group+  , children :: LH.HashMap S.Text (Group, AliasType)     -- ^ Any child groups of this group   , help     :: Context -> L.Text     -- ^ A function producing the \'help' for the group@@ -33,16 +36,16 @@   deriving ( Generic )  data GroupS = GroupS-  { name     :: S.Text+  { names    :: NonEmpty S.Text   , parent   :: Maybe S.Text-  , commands :: LH.HashMap S.Text Command-  , children :: LH.HashMap S.Text Group+  , commands :: LH.HashMap S.Text (Command, AliasType)+  , children :: LH.HashMap S.Text (Group, AliasType)   }   deriving ( Generic, Show )   deriving ( TextShow ) via TSG.FromGeneric GroupS  instance Show Group where-  showsPrec d Group { name, parent, commands, children } = showsPrec d $ GroupS name (parent ^? _Just . #name) commands children+  showsPrec d Group { names, parent, commands, children } = showsPrec d $ GroupS names (NE.head <$> parent ^? _Just . #names) commands children  instance TextShow Group where-  showbPrec d Group { name, parent, commands, children } = showbPrec d $ GroupS name (parent ^? _Just . #name) commands children+  showbPrec d Group { names, parent, commands, children } = showbPrec d $ GroupS names (NE.head <$> parent ^? _Just . #names) commands children

@@ -2,6 +2,7 @@ module Calamity.Commands.Handler     ( CommandHandler(..) ) where +import           Calamity.Commands.AliasType import           Calamity.Commands.Command import           Calamity.Commands.Group @@ -14,9 +15,9 @@ import qualified TextShow.Generic          as TSG  data CommandHandler = CommandHandler-  { groups   :: LH.HashMap S.Text Group+  { groups   :: LH.HashMap S.Text (Group, AliasType)     -- ^ Top level groups-  , commands :: LH.HashMap S.Text Command+  , commands :: LH.HashMap S.Text (Command, AliasType)     -- ^ Top level commands   }   deriving ( Show, Generic )

@@ -4,6 +4,7 @@     , helpCommand ) where  import           Calamity.Client.Types+import           Calamity.Commands.AliasType import           Calamity.Commands.Check import           Calamity.Commands.Command import           Calamity.Commands.CommandUtils@@ -19,12 +20,15 @@ import           Control.Monad  import qualified Data.HashMap.Lazy              as LH+import           Data.List.NonEmpty             ( NonEmpty(..) )+import qualified Data.List.NonEmpty             as NE import qualified Data.Text                      as S import qualified Data.Text.Lazy                 as L  import qualified Polysemy                       as P import qualified Polysemy.Fail                  as P import qualified Polysemy.Reader                as P+import Data.Maybe (mapMaybe)  data CommandOrGroup   = Command' Command@@ -34,41 +38,68 @@ helpCommandHelp _ = "Show help for a command or group."  helpForCommand :: Context -> Command -> L.Text-helpForCommand ctx (cmd@Command { help }) = "```\nUsage: " <> prefix' <> path' <> " " <> params' <> "\n\n" <> help ctx <> "\n```"+helpForCommand ctx (cmd@Command { names, checks, help }) = "```\nUsage: " <> prefix' <> path' <> " " <> params' <> "\n" <>+                                                           aliasesFmt <>+                                                           checksFmt <>+                                                           help ctx <> "\n```"   where prefix' = ctx ^. #prefix-        path'   = L.fromStrict . S.unwords $ commandPath cmd+        path'   = L.unwords . map L.fromStrict $ commandPath cmd         params' = commandParams cmd+        aliases = map L.fromStrict $ NE.tail names+        checks' = map L.fromStrict . map (^. #name) $ checks+        aliasesFmt = if null aliases then "" else  "Aliases: " <> L.unwords aliases <> "\n"+        checksFmt = if null checks' then "" else "Checks: " <> L.unwords checks' <> "\n\n"  fmtCommandWithParams :: Command -> L.Text-fmtCommandWithParams cmd@Command { name } = L.fromStrict name <> " " <> commandParams cmd+fmtCommandWithParams cmd@Command { names } = formatWithAliases names <> " " <> commandParams cmd +formatWithAliases :: NonEmpty S.Text -> L.Text+formatWithAliases (name :| aliases) = L.fromStrict name <> aliasesFmt+  where+    aliasesFmt = case aliases of+      [] -> ""+      aliases' -> "[" <> L.intercalate "|" (map L.fromStrict aliases') <> "]"++onlyOriginals :: [(a, AliasType)] -> [a]+onlyOriginals = mapMaybe inner+  where inner (_, Alias) = Nothing+        inner (a, Original) = Just a+ helpForGroup :: Context -> Group -> L.Text-helpForGroup ctx grp = "```\nGroup: " <> path' <> "\n\n" <> (grp ^. #help) ctx <> "\n" <> groupsMsg <> commandsMsg <> "\n```"+helpForGroup ctx grp = "```\nGroup: " <> path' <> "\n" <>+                       aliasesFmt <>+                       checksFmt <>+                       (grp ^. #help) ctx <> "\n" <>+                       groupsMsg <> commandsMsg <> "\n```"   where path' = L.fromStrict . S.unwords $ groupPath grp-        groups = LH.keys $ grp ^. #children-        commands = LH.elems $ grp ^. #commands-        groupsMsg = if null groups then "" else "The following child groups exist:\n" <> L.fromStrict (S.unlines . map ("- " <>) $ groups)+        groups =  onlyOriginals . LH.elems $ grp ^. #children+        commands = onlyOriginals . LH.elems $ grp ^. #commands+        groupsFmt = map formatWithAliases (groups ^.. traverse . #names)+        groupsMsg = if null groups then "" else "The following child groups exist:\n" <> (L.unlines . map ("- " <>) $ groupsFmt)         commandsMsg = if null commands then "" else "\nThe following child commands exist:\n" <> (L.unlines . map ("- " <>) . map fmtCommandWithParams $ commands)+        aliases = map L.fromStrict . NE.tail $ grp ^. #names+        checks' = map L.fromStrict . map (^. #name) $ grp ^. #checks+        aliasesFmt = if null aliases then "" else  "Aliases: " <> L.unwords aliases <> "\n"+        checksFmt = if null checks' then "" else "Checks: " <> L.unwords checks' <> "\n\n"  rootHelp :: CommandHandler -> L.Text rootHelp handler = "```\n" <> groupsMsg <> commandsMsg <> "\n```"-  where groups = LH.keys $ handler ^. #groups-        commands = LH.elems $ handler ^. #commands-        groupsMsg = if null groups then "" else "The following groups exist:\n" <> L.fromStrict (S.unlines . map ("- " <>) $ groups)+  where groups =  onlyOriginals . LH.elems $ handler ^. #groups+        commands = onlyOriginals . LH.elems $ handler ^. #commands+        groupsFmt = map formatWithAliases (groups ^.. traverse . #names)+        groupsMsg = if null groups then "" else "The following groups exist:\n" <> (L.unlines . map ("- " <>) $ groupsFmt)         commandsMsg = if null commands then "" else "\nThe following commands exist:\n" <> (L.unlines . map ("- " <>) . map fmtCommandWithParams $ commands) --- TODO: process checks- helpCommandCallback :: BotC r => CommandHandler -> Context -> [S.Text] -> P.Sem (P.Fail ': r) () helpCommandCallback handler ctx path = do   case findCommandOrGroup handler path of-    Just (Command' cmd@Command { name }) ->-      void $ tell @L.Text ctx $ "Help for command `" <> L.fromStrict name <> "`: \n" <> helpForCommand ctx cmd-    Just (Group' grp@Group { name } remainingPath) ->+    Just (Command' cmd@Command { names }) ->+      void $ tell @L.Text ctx $ "Help for command `" <> L.fromStrict (NE.head names) <> "`: \n" <> helpForCommand ctx cmd+    Just (Group' grp@Group { names } remainingPath) ->       let failedMsg = if null remainingPath             then ""-            else "No command or group with the path: `" <> L.fromStrict (S.unwords path) <> "` exists for the group: `" <> L.fromStrict name <> "`\n"-      in void $ tell @L.Text ctx $ failedMsg <> "Help for group `" <> L.fromStrict name <> "`: \n" <> helpForGroup ctx grp+            else "No command or group with the path: `" <> L.fromStrict (S.unwords path) <> "` exists for the group: `" <> L.fromStrict (NE.head names) <> "`\n"+      in void $ tell @L.Text ctx $ failedMsg <> "Help for group `" <> L.fromStrict (NE.head names) <> "`: \n" <> helpForGroup ctx grp     Nothing -> let failedMsg = if null path                      then ""                      else "No command or group with the path: `" <> L.fromStrict (S.unwords path) <> "` was found.\n"@@ -78,7 +109,7 @@ -- construct a help command that will provide help for all the commands and -- groups in the passed 'CommandHandler'. helpCommand' :: BotC r => CommandHandler -> Maybe Group -> [Check] -> P.Sem r Command-helpCommand' handler parent checks = buildCommand @'[[S.Text]] "help" parent checks helpCommandHelp+helpCommand' handler parent checks = buildCommand @'[[S.Text]] ("help" :| []) parent checks helpCommandHelp   (helpCommandCallback handler)  -- | Create and register the default help command for all the commands@@ -89,16 +120,18 @@   parent <- P.ask @(Maybe Group)   checks <- P.ask @[Check]   cmd <- raiseDSL $ helpCommand' handler parent checks-  ltell $ LH.singleton "help" cmd+  ltell $ LH.singleton "help" (cmd, Original)   pure cmd  findCommandOrGroup :: CommandHandler -> [S.Text] -> Maybe CommandOrGroup findCommandOrGroup handler path = go (handler ^. #commands, handler ^. #groups) path-  where go :: (LH.HashMap S.Text Command, LH.HashMap S.Text Group) -> [S.Text] -> Maybe CommandOrGroup+  where go :: (LH.HashMap S.Text (Command, AliasType), LH.HashMap S.Text (Group, AliasType))+           -> [S.Text]+           -> Maybe CommandOrGroup         go (commands, groups) (x : xs) =           case LH.lookup x commands of-            Just cmd -> Just (Command' cmd)-            Nothing  -> case LH.lookup x groups of-              Just group -> go (group ^. #commands, group ^. #children) xs <|> Just (Group' group xs)-              Nothing    -> Nothing+            Just (cmd, _) -> Just (Command' cmd)+            Nothing       -> case LH.lookup x groups of+              Just (group, _) -> go (group ^. #commands, group ^. #children) xs <|> Just (Group' group xs)+              Nothing         -> Nothing         go _ [] = Nothing

@@ -9,6 +9,7 @@ import           Calamity.Metrics.Eff import           Calamity.Client.Client import           Calamity.Client.Types+import           Calamity.Commands.AliasType import           Calamity.Commands.Command import           Calamity.Commands.CommandUtils import           Calamity.Commands.Context@@ -82,15 +83,17 @@   let handler = CommandHandler groups cmds   pure (handler, a) -  where inner :: CommandHandler -> P.Sem (DSLState r) a -> P.Sem (P.Fixpoint ': r) (LH.HashMap S.Text Group, (LH.HashMap S.Text Command, a))+  where inner :: CommandHandler -> P.Sem (DSLState r) a+              -> P.Sem (P.Fixpoint ': r) (LH.HashMap S.Text (Group, AliasType),+                                          (LH.HashMap S.Text (Command, AliasType), a))         inner h =           P.runReader h .           P.runReader [] .           P.runReader defaultHelp . P.untag @"original-help" .           P.runReader defaultHelp .           P.runReader Nothing .-          runLocalWriter @(LH.HashMap S.Text Group) .-          runLocalWriter @(LH.HashMap S.Text Command)+          runLocalWriter @(LH.HashMap S.Text (Group, AliasType)) .+          runLocalWriter @(LH.HashMap S.Text (Command, AliasType))         defaultHelp = (const "This command or group has no help.")  @@ -125,8 +128,8 @@       (((, xs) <$> attachInitial (LH.lookup (L.toStrict x) (g ^. #commands)))        <> (attachInitial (LH.lookup (L.toStrict x) (g ^. #children)) >>= goG (nextWord xs))) -    attachInitial :: Maybe a -> Either [L.Text] a-    attachInitial (Just a) = Right a+    attachInitial :: Maybe (a, b) -> Either [L.Text] a+    attachInitial (Just (a, _)) = Right a     attachInitial Nothing = Left []      attachSoFar :: L.Text -> Either [L.Text] a -> Either [L.Text] a

@@ -22,6 +22,7 @@ import           Calamity.Types.LogEff import           Calamity.Types.Model.Guild.Guild import           Calamity.Types.Model.Voice+import           Calamity.Types.Model.Presence.Activity import           Calamity.Types.Snowflake  import           Control.Concurrent.Async@@ -211,7 +212,7 @@  data StatusUpdateData = StatusUpdateData   { since  :: Maybe Integer-  , game   :: Maybe Value+  , game   :: Maybe Activity   , status :: Text   , afk    :: Bool   }

@@ -1,6 +1,7 @@ -- | User activities module Calamity.Types.Model.Presence.Activity     ( Activity(..)+    , activity     , ActivityType(..)     , ActivityTimestamps(..)     , ActivityParty(..)@@ -54,6 +55,24 @@   deriving ( Eq, Show, Generic )   deriving ( TextShow ) via TSG.FromGeneric Activity   deriving ( ToJSON, FromJSON ) via CalamityJSON Activity++-- | Make an 'Activity' with all optional fields set to Nothing+activity :: Text -> ActivityType -> Activity+activity name type_ =+  Activity+    { name = name,+      type_ = type_,+      url = Nothing,+      timestamps = Nothing,+      applicationID = Nothing,+      details = Nothing,+      state = Nothing,+      party = Nothing,+      assets = Nothing,+      secrets = Nothing,+      instance_ = Nothing,+      flags = Nothing+    }  data ActivityTimestamps = ActivityTimestamps   { start :: Maybe UnixTimestamp