-- | 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.Internal.LocalWriter

import Control.Applicative
import Control.Lens hiding (Context (..))

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

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

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

helpForCommand :: CommandContext m c a => c -> Command m c a -> L.Text
helpForCommand :: c -> Command m c a -> Text
helpForCommand ctx :: 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} =
  "```\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
<> c -> Text
help c
ctx
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
 where
  prefix' :: Text
prefix' = c -> Text
forall (m :: * -> *) c a. CommandContext m c a => c -> Text
ctxPrefix c
ctx
  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 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 = (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' = (Check m c -> Text) -> [Check m c] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
L.fromStrict (Text -> Text) -> (Check m c -> Text) -> Check m c -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check m c -> Getting Text (Check m c) Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text (Check m c) Text)
Getting Text (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 ""
      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 m c a -> L.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
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 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

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 -> L.Text
helpForGroup :: c -> Group m c a -> Text
helpForGroup ctx :: c
ctx grp :: Group m c a
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 m c a
grp Group m c a
-> Getting (c -> Text) (Group m c a) (c -> Text) -> c -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "help" (Getting (c -> Text) (Group m c a) (c -> Text))
Getting (c -> Text) (Group m c a) (c -> Text)
#help) c
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 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
-> Getting
     (HashMap Text (Group m c a, AliasType))
     (Group m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "children"
  (Getting
     (HashMap Text (Group m c a, AliasType))
     (Group m c a)
     (HashMap Text (Group m c a, AliasType)))
Getting
  (HashMap Text (Group m c a, AliasType))
  (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
-> Getting
     (HashMap Text (Command m c a, AliasType))
     (Group m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command m c a, AliasType))
     (Group m c a)
     (HashMap Text (Command m c a, AliasType)))
Getting
  (HashMap Text (Command m c a, AliasType))
  (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]
-> Getting (Endo [NonEmpty Text]) [Group m c a] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
-> [Group m c a] -> Const (Endo [NonEmpty Text]) [Group m c a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
 -> [Group m c a] -> Const (Endo [NonEmpty Text]) [Group m c a])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
    -> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
-> Getting (Endo [NonEmpty Text]) [Group m c a] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "names"
  ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
   -> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a)
#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 ""
      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 m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command m c a]
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 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
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 = (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 m c a
grp Group m c a
-> Getting (NonEmpty Text) (Group m c a) (NonEmpty Text)
-> NonEmpty Text
forall s a. s -> Getting a s a -> a
^. IsLabel
  "names" (Getting (NonEmpty Text) (Group m c a) (NonEmpty Text))
Getting (NonEmpty Text) (Group m c a) (NonEmpty Text)
#names
  checks' :: [Text]
checks' = (Check m c -> Text) -> [Check m c] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
L.fromStrict (Text -> Text) -> (Check m c -> Text) -> Check m c -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check m c -> Getting Text (Check m c) Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text (Check m c) Text)
Getting Text (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
-> Getting [Check m c] (Group m c a) [Check m c] -> [Check m c]
forall s a. s -> Getting a s a -> a
^. IsLabel "checks" (Getting [Check m c] (Group m c a) [Check m c])
Getting [Check m c] (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 ""
      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 m c a -> L.Text
rootHelp :: CommandHandler m c a -> Text
rootHelp handler :: CommandHandler m c a
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 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
-> Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType)))
Getting
  (HashMap Text (Group m c a, AliasType))
  (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
-> Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType)))
Getting
  (HashMap Text (Command m c a, AliasType))
  (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]
-> Getting (Endo [NonEmpty Text]) [Group m c a] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
-> [Group m c a] -> Const (Endo [NonEmpty Text]) [Group m c a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
 -> [Group m c a] -> Const (Endo [NonEmpty Text]) [Group m c a])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
    -> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
-> Getting (Endo [NonEmpty Text]) [Group m c a] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "names"
  ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
   -> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a))
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group m c a -> Const (Endo [NonEmpty Text]) (Group m c a)
#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 ""
      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 m c a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command m c a]
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 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
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 -> [S.Text] -> L.Text
renderHelp :: CommandHandler m c a -> c -> [Text] -> Text
renderHelp handler :: CommandHandler m c a
handler ctx :: c
ctx path :: [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}) ->
      "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
<> 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} 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]
remainingPath) 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 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
<> 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
    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 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] ->
  (L.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]
-> (Text -> Sem (Fail : r) a)
-> Sem r (Command m c a)
helpCommand' handler :: CommandHandler m c a
handler parent :: Maybe (Group m c a)
parent checks :: [Check m c]
checks render :: Text -> Sem (Fail : r) a
render =
  NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> (c -> Text)
-> (c -> CommandForParsers '[[Text]] r a)
-> Sem r (Command m c a)
forall (ps :: [*]) c (m :: * -> *) a (r :: [(* -> *) -> * -> *]).
(Monad m, Member (Final m) r, TypedCommandC ps 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 @'[[S.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
    (\ctx :: c
ctx path :: [Text]
path -> Text -> Sem (Fail : r) a
render (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) =>
  (L.Text -> P.Sem (P.Fail ': r) a) ->
  P.Sem (DSLState m c a r) (Command m c a)
helpCommand :: (Text -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
helpCommand render :: Text -> Sem (Fail : r) a
render = do
  CommandHandler m c a
handler <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (CommandHandler m c a)) r =>
Sem r (CommandHandler m c a)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(CommandHandler m c a)
  Maybe (Group m c a)
parent <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(Maybe (Group m c a))
  [Check m c]
checks <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (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 :: [(* -> *) -> * -> *]) 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]
-> (Text -> Sem (Fail : r) a)
-> Sem r (Command m c a)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) c a.
(Monad m, Member (Final m) r, CommandContext m c a) =>
CommandHandler m c a
-> Maybe (Group m c a)
-> [Check m 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 Text -> Sem (Fail : r) a
render
  HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (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 "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 -> [S.Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup :: CommandHandler m c a -> [Text] -> Maybe (CommandOrGroup m c a)
findCommandOrGroup handler :: CommandHandler m c a
handler path :: [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
-> Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Command m c a, AliasType)))
Getting
  (HashMap Text (Command m c a, AliasType))
  (CommandHandler m c a)
  (HashMap Text (Command m c a, AliasType))
#commands, CommandHandler m c a
handler CommandHandler m c a
-> Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting
     (HashMap Text (Group m c a, AliasType))
     (CommandHandler m c a)
     (HashMap Text (Group m c a, AliasType)))
Getting
  (HashMap Text (Group m c a, AliasType))
  (CommandHandler m c a)
  (HashMap Text (Group m c a, AliasType))
#groups) [Text]
path
 where
  go ::
    (LH.HashMap S.Text (Command m c a, AliasType), LH.HashMap S.Text (Group m c a, AliasType)) ->
    [S.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 (commands :: HashMap Text (Command m c a, AliasType)
commands, groups :: HashMap Text (Group m c a, AliasType)
groups) (x :: Text
x : xs :: [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 cmd :: Command m c a
cmd, _) -> 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)
      _ -> 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 :: Group m c a
group, _) -> (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
-> Getting
     (HashMap Text (Command m c a, AliasType))
     (Group m c a)
     (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command m c a, AliasType))
     (Group m c a)
     (HashMap Text (Command m c a, AliasType)))
Getting
  (HashMap Text (Command m c a, AliasType))
  (Group m c a)
  (HashMap Text (Command m c a, AliasType))
#commands, Group m c a
group Group m c a
-> Getting
     (HashMap Text (Group m c a, AliasType))
     (Group m c a)
     (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "children"
  (Getting
     (HashMap Text (Group m c a, AliasType))
     (Group m c a)
     (HashMap Text (Group m c a, AliasType)))
Getting
  (HashMap Text (Group m c a, AliasType))
  (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 (CommandOrGroup m c a)
forall a. Maybe a
Nothing
  go _ [] = Maybe (CommandOrGroup m c a)
forall a. Maybe a
Nothing