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