-- | A default help command implementation
module CalamityCommands.Help (
  helpCommand',
  helpCommand,
) where

import CalamityCommands.AliasType
import CalamityCommands.Check
import CalamityCommands.Command
import CalamityCommands.CommandUtils
import CalamityCommands.Context
import CalamityCommands.Dsl
import CalamityCommands.Group
import CalamityCommands.Handler
import CalamityCommands.ParameterInfo
import CalamityCommands.Internal.LocalWriter
import Control.Applicative
import Optics
import qualified Data.HashMap.Lazy as LH
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Polysemy as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Reader as P

data CommandOrGroup m c a
  = Command' (Command m c a)
  | Group' (Group m c a) [T.Text]

parameterTypeHelp :: [ParameterInfo] -> T.Text
parameterTypeHelp :: [ParameterInfo] -> Text
parameterTypeHelp [ParameterInfo]
pinfo =
  let dedup :: [(TypeRep, Text)]
dedup = HashMap TypeRep Text -> [(TypeRep, Text)]
forall k v. HashMap k v -> [(k, v)]
LH.toList (HashMap TypeRep Text -> [(TypeRep, Text)])
-> ([(TypeRep, Text)] -> HashMap TypeRep Text)
-> [(TypeRep, Text)]
-> [(TypeRep, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TypeRep, Text)] -> HashMap TypeRep Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList ([(TypeRep, Text)] -> [(TypeRep, Text)])
-> [(TypeRep, Text)] -> [(TypeRep, Text)]
forall a b. (a -> b) -> a -> b
$ (ParameterInfo -> (TypeRep, Text))
-> [ParameterInfo] -> [(TypeRep, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ParameterInfo Maybe Text
_ TypeRep
t Text
d) -> (TypeRep
t, Text
d)) [ParameterInfo]
pinfo
      typeDescs :: Text
typeDescs = [Text] -> Text
T.unlines [Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d | (TypeRep
t, Text
d) <- [(TypeRep, Text)]
dedup]
  in if [(TypeRep, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TypeRep, Text)]
dedup
      then Text
""
      else Text
"Types:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeDescs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

helpCommandHelp :: c -> T.Text
helpCommandHelp :: c -> Text
helpCommandHelp c
_ = Text
"Show help for a command or group."

helpForCommand :: CommandContext m c a => c -> Command m c a -> T.Text
helpForCommand :: c -> Command m c a -> Text
helpForCommand c
ctx cmd :: Command m c a
cmd@Command{NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names :: NonEmpty Text
names, [Check m c]
$sel:checks:Command :: forall (m :: * -> *) c a. Command m c a -> [Check m c]
checks :: [Check m c]
checks, c -> Text
$sel:help:Command :: forall (m :: * -> *) c a. Command m c a -> c -> Text
help :: c -> Text
help, [ParameterInfo]
$sel:params:Command :: forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params :: [ParameterInfo]
params} =
  Text
"Usage: " 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
<> [ParameterInfo] -> Text
parameterTypeHelp [ParameterInfo]
params
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> c -> Text
help c
ctx
 where
  prefix' :: Text
prefix' = c -> Text
forall (m :: * -> *) c a. CommandContext m c a => c -> Text
ctxPrefix c
ctx
  path' :: Text
path' = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command m c a -> [Text]
forall (m :: * -> *) c a. Command m c a -> [Text]
commandPath Command m c a
cmd
  params' :: Text
params' = Command m c a -> Text
forall (m :: * -> *) c a. Command m c a -> Text
commandParams Command m c a
cmd
  aliases :: [Text]
aliases = NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty Text
names
  checks' :: [Text]
checks' = (Check m c -> Text) -> [Check m c] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check m c -> Optic' A_Lens NoIx (Check m c) Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "name" (Optic' A_Lens NoIx (Check m c) Text)
Optic' A_Lens NoIx (Check m c) Text
#name) [Check m c]
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
T.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
T.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"

fmtCommandWithParams :: Command m c a -> T.Text
fmtCommandWithParams :: Command m c a -> Text
fmtCommandWithParams cmd :: Command m c a
cmd@Command{NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> 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 m c a -> Text
forall (m :: * -> *) c a. Command m c a -> Text
commandParams Command m c a
cmd

formatWithAliases :: NonEmpty T.Text -> T.Text
formatWithAliases :: NonEmpty Text -> Text
formatWithAliases (Text
name :| [Text]
aliases) = 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
T.intercalate Text
"|" [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 m c a] -> [Command m c a]
onlyVisibleC :: [Command m c a] -> [Command m c a]
onlyVisibleC = (Command m c a -> Maybe (Command m c a))
-> [Command m c a] -> [Command m c a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Command m c a -> Maybe (Command m c a)
forall (m :: * -> *) c a. Command m c a -> Maybe (Command m c a)
notHiddenC

onlyVisibleG :: [Group m c a] -> [Group m c a]
onlyVisibleG :: [Group m c a] -> [Group m c a]
onlyVisibleG = (Group m c a -> Maybe (Group m c a))
-> [Group m c a] -> [Group m c a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Group m c a -> Maybe (Group m c a)
forall (m :: * -> *) c a. Group m c a -> Maybe (Group m c a)
notHiddenG

helpForGroup :: CommandContext m c a => c -> Group m c a -> T.Text
helpForGroup :: c -> Group m c a -> Text
helpForGroup c
ctx Group m c a
grp =
  Text
"Group: " 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 m c a
grp Group m c a
-> Optic' A_Lens NoIx (Group m c a) (c -> Text) -> c -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "help" (Optic' A_Lens NoIx (Group m c a) (c -> Text))
Optic' A_Lens NoIx (Group m c a) (c -> Text)
#help) c
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
 where
  path' :: Text
path' = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Group m c a -> [Text]
forall (m :: * -> *) c a. Group m c a -> [Text]
groupPath Group m c a
grp
  groups :: [Group m c a]
groups = [Group m c a] -> [Group m c a]
forall (m :: * -> *) c a. [Group m c a] -> [Group m c a]
onlyVisibleG ([Group m c a] -> [Group m c a])
-> (HashMap Text (Group m c a, AliasType) -> [Group m c a])
-> HashMap Text (Group m c a, AliasType)
-> [Group m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Group m c a, AliasType)] -> [Group m c a]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group m c a, AliasType)] -> [Group m c a])
-> (HashMap Text (Group m c a, AliasType)
    -> [(Group m c a, AliasType)])
-> HashMap Text (Group m c a, AliasType)
-> [Group m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group m c a, AliasType) -> [(Group m c a, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group m c a, AliasType) -> [Group m c a])
-> HashMap Text (Group m c a, AliasType) -> [Group m c a]
forall a b. (a -> b) -> a -> b
$ Group m c a
grp Group m c a
-> Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "children"
  (Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType)))
Optic'
  A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType))
#children
  commands :: [Command m c a]
commands = [Command m c a] -> [Command m c a]
forall (m :: * -> *) c a. [Command m c a] -> [Command m c a]
onlyVisibleC ([Command m c a] -> [Command m c a])
-> (HashMap Text (Command m c a, AliasType) -> [Command m c a])
-> HashMap Text (Command m c a, AliasType)
-> [Command m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Command m c a, AliasType)] -> [Command m c a]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command m c a, AliasType)] -> [Command m c a])
-> (HashMap Text (Command m c a, AliasType)
    -> [(Command m c a, AliasType)])
-> HashMap Text (Command m c a, AliasType)
-> [Command m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command m c a, AliasType)
-> [(Command m c a, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command m c a, AliasType) -> [Command m c a])
-> HashMap Text (Command m c a, AliasType) -> [Command m c a]
forall a b. (a -> b) -> a -> b
$ Group m c a
grp Group m c a
-> Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "commands"
  (Optic'
     A_Lens
     NoIx
     (Group m c a)
     (HashMap Text (Command m c a, AliasType)))
Optic'
  A_Lens NoIx (Group m c a) (HashMap Text (Command m c a, AliasType))
#commands
  groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group m c a]
groups [Group m c a]
-> Optic' A_Traversal NoIx [Group m c a] (NonEmpty Text)
-> [NonEmpty Text]
forall k s (is :: IxList) a.
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Group m c a] [Group m c a] (Group m c a) (Group m c a)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Group m c a] [Group m c a] (Group m c a) (Group m c a)
-> Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text)
-> Optic' A_Traversal NoIx [Group m c a] (NonEmpty Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "names"
  (Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text))
Optic
  A_Lens
  NoIx
  (Group m c a)
  (Group m c a)
  (NonEmpty Text)
  (NonEmpty Text)
#names)
  groupsMsg :: Text
groupsMsg =
    if [Group m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group m c a]
groups
      then Text
""
      else Text
"The following child groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
T.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 m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command m c a]
commands
      then Text
""
      else Text
"\nThe following child commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
T.unlines ([Text] -> Text)
-> ([Command m c a] -> [Text]) -> [Command m c a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command m c a -> Text) -> [Command m c a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Command m c a -> Text) -> Command m c a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command m c a -> Text
forall (m :: * -> *) c a. Command m c a -> Text
fmtCommandWithParams) ([Command m c a] -> Text) -> [Command m c a] -> Text
forall a b. (a -> b) -> a -> b
$ [Command m c a]
commands)
  aliases :: [Text]
aliases = NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Group m c a
grp Group m c a
-> Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text)
-> NonEmpty Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "names"
  (Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text))
Optic
  A_Lens
  NoIx
  (Group m c a)
  (Group m c a)
  (NonEmpty Text)
  (NonEmpty Text)
#names
  checks' :: [Text]
checks' = (Check m c -> Text) -> [Check m c] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check m c -> Optic' A_Lens NoIx (Check m c) Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "name" (Optic' A_Lens NoIx (Check m c) Text)
Optic' A_Lens NoIx (Check m c) Text
#name) ([Check m c] -> [Text]) -> [Check m c] -> [Text]
forall a b. (a -> b) -> a -> b
$ Group m c a
grp Group m c a
-> Optic' A_Lens NoIx (Group m c a) [Check m c] -> [Check m c]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "checks" (Optic' A_Lens NoIx (Group m c a) [Check m c])
Optic' A_Lens NoIx (Group m c a) [Check m c]
#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
T.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
T.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"

rootHelp :: CommandHandler m c a -> T.Text
rootHelp :: CommandHandler m c a -> Text
rootHelp CommandHandler m c a
handler = Text
groupsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsMsg
 where
  groups :: [Group m c a]
groups = [Group m c a] -> [Group m c a]
forall (m :: * -> *) c a. [Group m c a] -> [Group m c a]
onlyVisibleG ([Group m c a] -> [Group m c a])
-> (HashMap Text (Group m c a, AliasType) -> [Group m c a])
-> HashMap Text (Group m c a, AliasType)
-> [Group m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Group m c a, AliasType)] -> [Group m c a]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group m c a, AliasType)] -> [Group m c a])
-> (HashMap Text (Group m c a, AliasType)
    -> [(Group m c a, AliasType)])
-> HashMap Text (Group m c a, AliasType)
-> [Group m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group m c a, AliasType) -> [(Group m c a, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group m c a, AliasType) -> [Group m c a])
-> HashMap Text (Group m c a, AliasType) -> [Group m c a]
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a
handler CommandHandler m c a
-> Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "groups"
  (Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType)))
Optic'
  A_Lens
  NoIx
  (CommandHandler m c a)
  (HashMap Text (Group m c a, AliasType))
#groups
  commands :: [Command m c a]
commands = [Command m c a] -> [Command m c a]
forall (m :: * -> *) c a. [Command m c a] -> [Command m c a]
onlyVisibleC ([Command m c a] -> [Command m c a])
-> (HashMap Text (Command m c a, AliasType) -> [Command m c a])
-> HashMap Text (Command m c a, AliasType)
-> [Command m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Command m c a, AliasType)] -> [Command m c a]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command m c a, AliasType)] -> [Command m c a])
-> (HashMap Text (Command m c a, AliasType)
    -> [(Command m c a, AliasType)])
-> HashMap Text (Command m c a, AliasType)
-> [Command m c a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command m c a, AliasType)
-> [(Command m c a, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command m c a, AliasType) -> [Command m c a])
-> HashMap Text (Command m c a, AliasType) -> [Command m c a]
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a
handler CommandHandler m c a
-> Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "commands"
  (Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType)))
Optic'
  A_Lens
  NoIx
  (CommandHandler m c a)
  (HashMap Text (Command m c a, AliasType))
#commands
  groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group m c a]
groups [Group m c a]
-> Optic' A_Traversal NoIx [Group m c a] (NonEmpty Text)
-> [NonEmpty Text]
forall k s (is :: IxList) a.
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Group m c a] [Group m c a] (Group m c a) (Group m c a)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Group m c a] [Group m c a] (Group m c a) (Group m c a)
-> Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text)
-> Optic' A_Traversal NoIx [Group m c a] (NonEmpty Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "names"
  (Optic
     A_Lens
     NoIx
     (Group m c a)
     (Group m c a)
     (NonEmpty Text)
     (NonEmpty Text))
Optic
  A_Lens
  NoIx
  (Group m c a)
  (Group m c a)
  (NonEmpty Text)
  (NonEmpty Text)
#names)
  groupsMsg :: Text
groupsMsg =
    if [Group m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group m c a]
groups
      then Text
""
      else Text
"The following groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
T.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 m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command m c a]
commands
      then Text
""
      else Text
"\nThe following commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
T.unlines ([Text] -> Text)
-> ([Command m c a] -> [Text]) -> [Command m c a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command m c a -> Text) -> [Command m c a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Command m c a -> Text) -> Command m c a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command m c a -> Text
forall (m :: * -> *) c a. Command m c a -> Text
fmtCommandWithParams) ([Command m c a] -> Text) -> [Command m c a] -> Text
forall a b. (a -> b) -> a -> b
$ [Command m c a]
commands)

renderHelp :: CommandContext m c a => CommandHandler m c a -> c -> [T.Text] -> T.Text
renderHelp :: CommandHandler m c a -> c -> [Text] -> Text
renderHelp CommandHandler m c a
handler c
ctx [Text]
path =
  case CommandHandler m c a -> [Text] -> Maybe (CommandOrGroup m c a)
forall (m :: * -> *) c a.
CommandHandler m c a -> [Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup CommandHandler m c a
handler [Text]
path of
    Just (Command' cmd :: Command m c a
cmd@Command{NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names}) ->
      Text
"Help for command `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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
<> c -> Command m c a -> Text
forall (m :: * -> *) c a.
CommandContext m c a =>
c -> Command m c a -> Text
helpForCommand c
ctx Command m c a
cmd
    Just (Group' grp :: Group m c a
grp@Group{NonEmpty Text
$sel:names:Group :: forall (m :: * -> *) c a. Group m c a -> 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
T.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
<> 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 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
<> 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
<> c -> Group m c a -> Text
forall (m :: * -> *) c a.
CommandContext m c a =>
c -> Group m c a -> Text
helpForGroup c
ctx Group m c a
grp
    Maybe (CommandOrGroup m c a)
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
T.unwords [Text]
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` was found.\n"
       in Text
failedMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandHandler m c a -> Text
forall (m :: * -> *) c a. CommandHandler m c a -> Text
rootHelp CommandHandler m c a
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' ::
  (Monad m, P.Member (P.Final m) r, CommandContext m c a) =>
  CommandHandler m c a ->
  Maybe (Group m c a) ->
  [Check m c] ->
  (c -> T.Text -> P.Sem (P.Fail ': r) a) ->
  P.Sem r (Command m c a)
helpCommand' :: CommandHandler m c a
-> Maybe (Group m c a)
-> [Check m c]
-> (c -> Text -> Sem (Fail : r) a)
-> Sem r (Command m c a)
helpCommand' CommandHandler m c a
handler Maybe (Group m c a)
parent [Check m c]
checks c -> Text -> Sem (Fail : r) a
render =
  NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> (c -> Text)
-> (c -> CommandForParsers ([Text] : NoIx) r a)
-> Sem r (Command m c a)
forall (ps :: IxList) c (m :: * -> *) a (r :: EffectRow).
(Monad m, Member (Final m) r, TypedCommandC ps c a r,
 CommandContext m c a) =>
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> (c -> Text)
-> (c -> CommandForParsers ps r a)
-> Sem r (Command m c a)
buildCommand @'[[T.Text]]
    (Text
"help" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [])
    Maybe (Group m c a)
parent
    Bool
False
    [Check m c]
checks
    c -> Text
forall c. c -> Text
helpCommandHelp
    (\c
ctx [Text]
path -> c -> Text -> Sem (Fail : r) a
render c
ctx (Text -> Sem (Fail : r) a) -> Text -> Sem (Fail : r) a
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a -> c -> [Text] -> Text
forall (m :: * -> *) c a.
CommandContext m c a =>
CommandHandler m c a -> c -> [Text] -> Text
renderHelp CommandHandler m c a
handler c
ctx [Text]
path)

{- | Create and register the default help command for all the commands registered
 in the commands DSL this is used in. The @render@ parameter is used so you can
 determine how the help should be rendered, for example it could be
 @'putStrLn'@, or a pure function such as @'pure' . 'Left'@

 The registered command will have the name \'help\', called with no parameters
 it will render help for 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 ::
  forall c m a r.
  (Monad m, P.Member (P.Final m) r, CommandContext m c a) =>
  (c -> T.Text -> P.Sem (P.Fail ': r) a) ->
  P.Sem (DSLState m c a r) (Command m c a)
helpCommand :: (c -> Text -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
helpCommand c -> Text -> Sem (Fail : r) a
render = do
  CommandHandler m c a
handler <- forall (r :: EffectRow).
Member (Reader (CommandHandler m c a)) r =>
Sem r (CommandHandler m c a)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(CommandHandler m c a)
  Maybe (Group m c a)
parent <- forall (r :: EffectRow).
Member (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
  [Check m c]
checks <- forall (r :: EffectRow).
Member (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
  Command m c a
cmd <- Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a)
forall (r :: EffectRow) x (m :: * -> *) c a.
Sem r x -> Sem (DSLState m c a r) x
raiseDSL (Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a))
-> Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a)
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a
-> Maybe (Group m c a)
-> [Check m c]
-> (c -> Text -> Sem (Fail : r) a)
-> Sem r (Command m c a)
forall (m :: * -> *) (r :: EffectRow) c a.
(Monad m, Member (Final m) r, CommandContext m c a) =>
CommandHandler m c a
-> Maybe (Group m c a)
-> [Check m c]
-> (c -> Text -> Sem (Fail : r) a)
-> Sem r (Command m c a)
helpCommand' CommandHandler m c a
handler Maybe (Group m c a)
parent [Check m c]
checks c -> Text -> Sem (Fail : r) a
render
  HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Command m c a, AliasType)
-> HashMap Text (Command m c a, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
"help" (Command m c a
cmd, AliasType
Original)
  Command m c a -> Sem (DSLState m c a r) (Command m c a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command m c a
cmd

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

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

findCommandOrGroup :: CommandHandler m c a -> [T.Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup :: CommandHandler m c a -> [Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup CommandHandler m c a
handler [Text]
path = (HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
-> [Text] -> Maybe (CommandOrGroup m c a)
forall (m :: * -> *) c a.
(HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
-> [Text] -> Maybe (CommandOrGroup m c a)
go (CommandHandler m c a
handler CommandHandler m c a
-> Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "commands"
  (Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType)))
Optic'
  A_Lens
  NoIx
  (CommandHandler m c a)
  (HashMap Text (Command m c a, AliasType))
#commands, CommandHandler m c a
handler CommandHandler m c a
-> Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "groups"
  (Optic'
     A_Lens
     NoIx
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType)))
Optic'
  A_Lens
  NoIx
  (CommandHandler m c a)
  (HashMap Text (Group m c a, AliasType))
#groups) [Text]
path
 where
  go ::
    (LH.HashMap T.Text (Command m c a, AliasType), LH.HashMap T.Text (Group m c a, AliasType)) ->
    [T.Text] ->
    Maybe (CommandOrGroup m c a)
  go :: (HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
-> [Text] -> Maybe (CommandOrGroup m c a)
go (HashMap Text (Command m c a, AliasType)
commands, HashMap Text (Group m c a, AliasType)
groups) (Text
x : [Text]
xs) =
    case Text
-> HashMap Text (Command m c a, AliasType)
-> Maybe (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Command m c a, AliasType)
commands of
      Just (Command m c a -> Maybe (Command m c a)
forall (m :: * -> *) c a. Command m c a -> Maybe (Command m c a)
notHiddenC -> Just Command m c a
cmd, AliasType
_) -> CommandOrGroup m c a -> Maybe (CommandOrGroup m c a)
forall a. a -> Maybe a
Just (Command m c a -> CommandOrGroup m c a
forall (m :: * -> *) c a. Command m c a -> CommandOrGroup m c a
Command' Command m c a
cmd)
      Maybe (Command m c a, AliasType)
_ -> case Text
-> HashMap Text (Group m c a, AliasType)
-> Maybe (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Group m c a, AliasType)
groups of
        Just (Group m c a -> Maybe (Group m c a)
forall (m :: * -> *) c a. Group m c a -> Maybe (Group m c a)
notHiddenG -> Just Group m c a
group, AliasType
_) -> (HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
-> [Text] -> Maybe (CommandOrGroup m c a)
forall (m :: * -> *) c a.
(HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
-> [Text] -> Maybe (CommandOrGroup m c a)
go (Group m c a
group Group m c a
-> Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "commands"
  (Optic'
     A_Lens
     NoIx
     (Group m c a)
     (HashMap Text (Command m c a, AliasType)))
Optic'
  A_Lens NoIx (Group m c a) (HashMap Text (Command m c a, AliasType))
#commands, Group m c a
group Group m c a
-> Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "children"
  (Optic'
     A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType)))
Optic'
  A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType))
#children) [Text]
xs Maybe (CommandOrGroup m c a)
-> Maybe (CommandOrGroup m c a) -> Maybe (CommandOrGroup m c a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommandOrGroup m c a -> Maybe (CommandOrGroup m c a)
forall a. a -> Maybe a
Just (Group m c a -> [Text] -> CommandOrGroup m c a
forall (m :: * -> *) c a.
Group m c a -> [Text] -> CommandOrGroup m c a
Group' Group m c a
group [Text]
xs)
        Maybe (Group m c a, AliasType)
_ -> Maybe (CommandOrGroup m c a)
forall a. Maybe a
Nothing
  go (HashMap Text (Command m c a, AliasType),
 HashMap Text (Group m c a, AliasType))
_ [] = Maybe (CommandOrGroup m c a)
forall a. Maybe a
Nothing