module Calamity.Commands.Help
( helpCommand'
, helpCommand ) where
import Calamity.Client.Types
import Calamity.Commands.AliasType
import Calamity.Commands.Check
import Calamity.Commands.Command
import Calamity.Commands.CommandUtils
import Calamity.Commands.Context
import Calamity.Commands.Dsl
import Calamity.Commands.Group
import Calamity.Commands.Handler
import Calamity.Internal.LocalWriter
import Calamity.Types.Tellable
import Control.Applicative
import Control.Lens hiding ( Context(..) )
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
| Group' Group [S.Text]
helpCommandHelp :: Context -> L.Text
helpCommandHelp :: Context -> Text
helpCommandHelp _ = "Show help for a command or group."
helpForCommand :: Context -> Command -> L.Text
helpForCommand :: Context -> Command -> Text
helpForCommand ctx :: Context
ctx (cmd :: Command
cmd@Command { NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names :: NonEmpty Text
names, [Check]
$sel:checks:Command :: Command -> [Check]
checks :: [Check]
checks, Context -> Text
$sel:help:Command :: Command -> Context -> Text
help :: Context -> Text
help }) = "```\nUsage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
params' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
aliasesFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
checksFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Context -> Text
help Context
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
where prefix' :: Text
prefix' = Context
ctx Context -> Getting Text Context Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "prefix" (Getting Text Context Text)
Getting Text Context Text
#prefix
path' :: Text
path' = [Text] -> Text
L.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
commandPath Command
cmd
params' :: Text
params' = Command -> Text
commandParams Command
cmd
aliases :: [Text]
aliases = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty Text
names
checks' :: [Text]
checks' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> ([Check] -> [Text]) -> [Check] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check -> Text) -> [Check] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check -> Getting Text Check Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Check Text)
Getting Text Check Text
#name) ([Check] -> [Text]) -> [Check] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Check]
checks
aliasesFmt :: Text
aliasesFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
aliases then "" else "Aliases: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
aliases Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then "" else "Checks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"
fmtCommandWithParams :: Command -> L.Text
fmtCommandWithParams :: Command -> Text
fmtCommandWithParams cmd :: Command
cmd@Command { NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names } = NonEmpty Text -> Text
formatWithAliases NonEmpty Text
names Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Command -> Text
commandParams Command
cmd
formatWithAliases :: NonEmpty S.Text -> L.Text
formatWithAliases :: NonEmpty Text -> Text
formatWithAliases (name :: Text
name :| aliases :: [Text]
aliases) = Text -> Text
L.fromStrict Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aliasesFmt
where
aliasesFmt :: Text
aliasesFmt = case [Text]
aliases of
[] -> ""
aliases' :: [Text]
aliases' -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate "|" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict [Text]
aliases') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
onlyOriginals :: [(a, AliasType)] -> [a]
onlyOriginals :: [(a, AliasType)] -> [a]
onlyOriginals = ((a, AliasType) -> Maybe a) -> [(a, AliasType)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (a, AliasType) -> Maybe a
forall a. (a, AliasType) -> Maybe a
inner
where inner :: (a, AliasType) -> Maybe a
inner (_, Alias) = Maybe a
forall a. Maybe a
Nothing
inner (a :: a
a, Original) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
helpForGroup :: Context -> Group -> L.Text
helpForGroup :: Context -> Group -> Text
helpForGroup ctx :: Context
ctx grp :: Group
grp = "```\nGroup: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
aliasesFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
checksFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(Group
grp Group
-> Getting (Context -> Text) Group (Context -> Text)
-> Context
-> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "help" (Getting (Context -> Text) Group (Context -> Text))
Getting (Context -> Text) Group (Context -> Text)
#help) Context
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
groupsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
where path' :: Text
path' = Text -> Text
L.fromStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
S.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Group -> [Text]
groupPath Group
grp
groups :: [Group]
groups = [(Group, AliasType)] -> [Group]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group, AliasType)] -> [Group])
-> (HashMap Text (Group, AliasType) -> [(Group, AliasType)])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group, AliasType) -> [(Group, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType) -> [Group]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"children"
(Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
#children
commands :: [Command]
commands = [(Command, AliasType)] -> [Command]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command, AliasType)] -> [Command])
-> (HashMap Text (Command, AliasType) -> [(Command, AliasType)])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command, AliasType) -> [(Command, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType) -> [Command]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
#commands
groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group]
groups [Group]
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group)
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
"names"
((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group)
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group
#names)
groupsMsg :: Text
groupsMsg = if [Group] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group]
groups then "" else "The following child groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
groupsFmt)
commandsMsg :: Text
commandsMsg = if [Command] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command]
commands then "" else "\nThe following child commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Command] -> [Text]) -> [Command] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> ([Command] -> [Text]) -> [Command] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> Text) -> [Command] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Text
fmtCommandWithParams ([Command] -> Text) -> [Command] -> Text
forall a b. (a -> b) -> a -> b
$ [Command]
commands)
aliases :: [Text]
aliases = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text])
-> (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting (NonEmpty Text) Group (NonEmpty Text) -> NonEmpty Text
forall s a. s -> Getting a s a -> a
^. IsLabel "names" (Getting (NonEmpty Text) Group (NonEmpty Text))
Getting (NonEmpty Text) Group (NonEmpty Text)
#names
checks' :: [Text]
checks' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> ([Check] -> [Text]) -> [Check] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check -> Text) -> [Check] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check -> Getting Text Check Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Check Text)
Getting Text Check Text
#name) ([Check] -> [Text]) -> [Check] -> [Text]
forall a b. (a -> b) -> a -> b
$ Group
grp Group -> Getting [Check] Group [Check] -> [Check]
forall s a. s -> Getting a s a -> a
^. IsLabel "checks" (Getting [Check] Group [Check])
Getting [Check] Group [Check]
#checks
aliasesFmt :: Text
aliasesFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
aliases then "" else "Aliases: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
aliases Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then "" else "Checks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"
rootHelp :: CommandHandler -> L.Text
rootHelp :: CommandHandler -> Text
rootHelp handler :: CommandHandler
handler = "```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
groupsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
where groups :: [Group]
groups = [(Group, AliasType)] -> [Group]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group, AliasType)] -> [Group])
-> (HashMap Text (Group, AliasType) -> [(Group, AliasType)])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group, AliasType) -> [(Group, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType) -> [Group]
forall a b. (a -> b) -> a -> b
$ CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"groups"
(Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
#groups
commands :: [Command]
commands = [(Command, AliasType)] -> [Command]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command, AliasType)] -> [Command])
-> (HashMap Text (Command, AliasType) -> [(Command, AliasType)])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command, AliasType) -> [(Command, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType) -> [Command]
forall a b. (a -> b) -> a -> b
$ CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
#commands
groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group]
groups [Group]
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group)
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
"names"
((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group)
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group
#names)
groupsMsg :: Text
groupsMsg = if [Group] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group]
groups then "" else "The following groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
groupsFmt)
commandsMsg :: Text
commandsMsg = if [Command] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command]
commands then "" else "\nThe following commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Command] -> [Text]) -> [Command] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> ([Command] -> [Text]) -> [Command] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> Text) -> [Command] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Text
fmtCommandWithParams ([Command] -> Text) -> [Command] -> Text
forall a b. (a -> b) -> a -> b
$ [Command]
commands)
helpCommandCallback :: BotC r => CommandHandler -> Context -> [S.Text] -> P.Sem (P.Fail ': r) ()
helpCommandCallback :: CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
helpCommandCallback handler :: CommandHandler
handler ctx :: Context
ctx path :: [Text]
path = do
case CommandHandler -> [Text] -> Maybe CommandOrGroup
findCommandOrGroup CommandHandler
handler [Text]
path of
Just (Command' cmd :: Command
cmd@Command { NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names }) ->
Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ "Help for command `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Command -> Text
helpForCommand Context
ctx Command
cmd
Just (Group' grp :: Group
grp@Group { NonEmpty Text
$sel:names:Group :: Group -> NonEmpty Text
names :: NonEmpty Text
names } remainingPath :: [Text]
remainingPath) ->
let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
remainingPath
then ""
else "No command or group with the path: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict ([Text] -> Text
S.unwords [Text]
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "` exists for the group: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`\n"
in Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ Text
failedMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Help for group `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Group -> Text
helpForGroup Context
ctx Group
grp
Nothing -> let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
path
then ""
else "No command or group with the path: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict ([Text] -> Text
S.unwords [Text]
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "` was found.\n"
in Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ Text
failedMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandHandler -> Text
rootHelp CommandHandler
handler
helpCommand' :: BotC r => CommandHandler -> Maybe Group -> [Check] -> P.Sem r Command
helpCommand' :: CommandHandler -> Maybe Group -> [Check] -> Sem r Command
helpCommand' handler :: CommandHandler
handler parent :: Maybe Group
parent checks :: [Check]
checks = NonEmpty Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers '[[Text]] r)
-> Sem r Command
forall (ps :: [*]) (r :: [(* -> *) -> * -> *]).
(Member (Final IO) r, TypedCommandC ps r) =>
NonEmpty Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
buildCommand @'[[S.Text]] ("help" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Group
parent [Check]
checks Context -> Text
helpCommandHelp
(CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
helpCommandCallback CommandHandler
handler)
helpCommand :: BotC r => P.Sem (DSLState r) Command
helpCommand :: Sem (DSLState r) Command
helpCommand = do
CommandHandler
handler <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader CommandHandler) r =>
Sem r CommandHandler
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @CommandHandler
Maybe Group
parent <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(Maybe Group)
[Check]
checks <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @[Check]
Command
cmd <- Sem r Command -> Sem (DSLState r) Command
forall (r :: [(* -> *) -> * -> *]) a. Sem r a -> Sem (DSLState r) a
raiseDSL (Sem r Command -> Sem (DSLState r) Command)
-> Sem r Command -> Sem (DSLState r) Command
forall a b. (a -> b) -> a -> b
$ CommandHandler -> Maybe Group -> [Check] -> Sem r Command
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CommandHandler -> Maybe Group -> [Check] -> Sem r Command
helpCommand' CommandHandler
handler Maybe Group
parent [Check]
checks
HashMap Text (Command, AliasType) -> Sem (DSLState r) ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command, AliasType) -> Sem (DSLState r) ())
-> HashMap Text (Command, AliasType) -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> (Command, AliasType) -> HashMap Text (Command, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton "help" (Command
cmd, AliasType
Original)
Command -> Sem (DSLState r) Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
cmd
findCommandOrGroup :: CommandHandler -> [S.Text] -> Maybe CommandOrGroup
findCommandOrGroup :: CommandHandler -> [Text] -> Maybe CommandOrGroup
findCommandOrGroup handler :: CommandHandler
handler path :: [Text]
path = (HashMap Text (Command, AliasType),
HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
#commands, CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"groups"
(Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
#groups) [Text]
path
where go :: (LH.HashMap S.Text (Command, AliasType), LH.HashMap S.Text (Group, AliasType))
-> [S.Text]
-> Maybe CommandOrGroup
go :: (HashMap Text (Command, AliasType),
HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (commands :: HashMap Text (Command, AliasType)
commands, groups :: HashMap Text (Group, AliasType)
groups) (x :: Text
x : xs :: [Text]
xs) =
case Text
-> HashMap Text (Command, AliasType) -> Maybe (Command, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Command, AliasType)
commands of
Just (cmd :: Command
cmd, _) -> CommandOrGroup -> Maybe CommandOrGroup
forall a. a -> Maybe a
Just (Command -> CommandOrGroup
Command' Command
cmd)
Nothing -> case Text -> HashMap Text (Group, AliasType) -> Maybe (Group, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Group, AliasType)
groups of
Just (group :: Group
group, _) -> (HashMap Text (Command, AliasType),
HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (Group
group Group
-> Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
#commands, Group
group Group
-> Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"children"
(Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
#children) [Text]
xs Maybe CommandOrGroup
-> Maybe CommandOrGroup -> Maybe CommandOrGroup
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommandOrGroup -> Maybe CommandOrGroup
forall a. a -> Maybe a
Just (Group -> [Text] -> CommandOrGroup
Group' Group
group [Text]
xs)
Nothing -> Maybe CommandOrGroup
forall a. Maybe a
Nothing
go _ [] = Maybe CommandOrGroup
forall a. Maybe a
Nothing