-- | A default help command implementation
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           Data.Maybe                     ( catMaybes )
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 Context
_ = Text
"Show help for a command or group."

helpForCommand :: Context -> Command -> L.Text
helpForCommand :: Context -> Command -> Text
helpForCommand 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 }) = Text
"```\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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
params' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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
<> Text
"\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 Text
"" else  Text
"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
<> Text
"\n"
        checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then Text
"" else Text
"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
<> Text
"\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 -> Text
forall a. Semigroup a => a -> a -> a
<> Command -> Text
commandParams Command
cmd

formatWithAliases :: NonEmpty S.Text -> L.Text
formatWithAliases :: NonEmpty Text -> Text
formatWithAliases (Text
name :| [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
      [] -> Text
""
      [Text]
aliases' -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
"|" ((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
<> Text
"]"

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 (a
_, AliasType
Alias) = Maybe a
forall a. Maybe a
Nothing
        inner (a
a, AliasType
Original) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

onlyVisibleC :: [Command] -> [Command]
onlyVisibleC :: [Command] -> [Command]
onlyVisibleC = [Maybe Command] -> [Command]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Command] -> [Command])
-> ([Command] -> [Maybe Command]) -> [Command] -> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> Maybe Command) -> [Command] -> [Maybe Command]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Maybe Command
notHiddenC

onlyVisibleG :: [Group] -> [Group]
onlyVisibleG :: [Group] -> [Group]
onlyVisibleG = [Maybe Group] -> [Group]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Group] -> [Group])
-> ([Group] -> [Maybe Group]) -> [Group] -> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Group -> Maybe Group) -> [Group] -> [Maybe Group]
forall a b. (a -> b) -> [a] -> [b]
map Group -> Maybe Group
notHiddenG

helpForGroup :: Context -> Group -> L.Text
helpForGroup :: Context -> Group -> Text
helpForGroup Context
ctx Group
grp = Text
"```\nGroup: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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
<> Text
"\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
<> Text
"\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] -> [Group]
onlyVisibleG ([Group] -> [Group])
-> (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(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] -> [Command]
onlyVisibleC ([Command] -> [Command])
-> (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(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 Text
"" else Text
"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 -> 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 Text
"" else Text
"\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 -> 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 Text
"" else  Text
"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
<> Text
"\n"
        checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then Text
"" else Text
"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
<> Text
"\n\n"

rootHelp :: CommandHandler -> L.Text
rootHelp :: CommandHandler -> Text
rootHelp CommandHandler
handler = Text
"```\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
<> Text
"\n```"
  where groups :: [Group]
groups =  [Group] -> [Group]
onlyVisibleG ([Group] -> [Group])
-> (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(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] -> [Command]
onlyVisibleC ([Command] -> [Command])
-> (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(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 Text
"" else Text
"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 -> 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 Text
"" else Text
"\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 -> 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 CommandHandler
handler Context
ctx [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
$ Text
"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
<> Text
"`: \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 } [Text]
remainingPath) ->
      let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
remainingPath
            then Text
""
            else Text
"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]
remainingPath) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` 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
<> Text
"`\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
<> Text
"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
<> Text
"`: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Group -> Text
helpForGroup Context
ctx Group
grp
    Maybe CommandOrGroup
Nothing -> let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
path
                     then Text
""
                     else Text
"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
<> Text
"` 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

-- | Given a 'CommandHandler', optionally a parent 'Group', and a list of 'Check's,
-- 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' :: CommandHandler -> Maybe Group -> [Check] -> Sem r Command
helpCommand' CommandHandler
handler Maybe Group
parent [Check]
checks = NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers '[[Text]] r)
-> Sem r Command
forall (ps :: [*]) (r :: [(* -> *) -> * -> *]).
(Member (Final IO) r, TypedCommandC ps r) =>
NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
buildCommand @'[[S.Text]] (Text
"help" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Group
parent Bool
False [Check]
checks Context -> Text
helpCommandHelp
  (CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
helpCommandCallback CommandHandler
handler)

-- | Create and register the default help command for all the commands
-- registered in the commands DSL this is used in.
--
-- The registered command will have the name \'help\', called with no parameters
-- it will print the top-level groups and commands, for example:
--
-- @
-- The following groups exist:
-- - reanimate
-- - prefix[prefixes]
-- - alias[aliases]
-- - remind[reminder|reminders]
--
-- The following commands exist:
-- - help :[Text]
-- @
--
-- Both commands and groups are listed in the form: @\<name\>[\<alias 0\>|\<alias 1\>]@,
-- commands also have their parameter list shown.
--
-- If a path to a group is passed, the help, aliases, and pre-invokation checks
-- will be listed, along with the subgroups and commands, For example:
--
-- @
-- Help for group remind:
-- Group: remind
-- Aliases: reminder reminders
-- Commands related to making reminders
--
-- The following child commands exist:
-- - list
-- - remove reminder_id:Text
-- - add :KleenePlusConcat Text
-- @
--
-- If a command path is passed, the usage, checks and help for the command are
-- shown, for example:
--
-- @
-- Help for command add:
-- Usage: c!prefix add prefix:Text
-- Checks: prefixLimit guildOnly
--
-- Add a new prefix
-- @
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 Text
"help" (Command
cmd, AliasType
Original)
  Command -> Sem (DSLState r) Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
cmd

notHiddenC :: Command -> Maybe Command
notHiddenC :: Command -> Maybe Command
notHiddenC c :: Command
c@(Command { Bool
$sel:hidden:Command :: Command -> Bool
hidden :: Bool
hidden }) = if Bool
hidden then Maybe Command
forall a. Maybe a
Nothing else Command -> Maybe Command
forall a. a -> Maybe a
Just Command
c

notHiddenG :: Group -> Maybe Group
notHiddenG :: Group -> Maybe Group
notHiddenG g :: Group
g@(Group { Bool
$sel:hidden:Group :: Group -> Bool
hidden :: Bool
hidden }) = if Bool
hidden then Maybe Group
forall a. Maybe a
Nothing else Group -> Maybe Group
forall a. a -> Maybe a
Just Group
g

findCommandOrGroup :: CommandHandler -> [S.Text] -> Maybe CommandOrGroup
findCommandOrGroup :: CommandHandler -> [Text] -> Maybe CommandOrGroup
findCommandOrGroup CommandHandler
handler [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 (HashMap Text (Command, AliasType)
commands, HashMap Text (Group, AliasType)
groups) (Text
x : [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 (Command -> Maybe Command
notHiddenC -> Just Command
cmd, AliasType
_) -> CommandOrGroup -> Maybe CommandOrGroup
forall a. a -> Maybe a
Just (Command -> CommandOrGroup
Command' Command
cmd)
            Maybe (Command, AliasType)
_                -> 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 -> Maybe Group
notHiddenG -> Just Group
group, AliasType
_) -> (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)
              Maybe (Group, AliasType)
_                                  -> Maybe CommandOrGroup
forall a. Maybe a
Nothing
        go (HashMap Text (Command, AliasType),
 HashMap Text (Group, AliasType))
_ [] = Maybe CommandOrGroup
forall a. Maybe a
Nothing