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

import           Calamity.Client.Types
import           Calamity.Commands.AliasType
import           Calamity.Commands.Check
import           Calamity.Commands.Command
import           Calamity.Commands.CommandUtils
import           Calamity.Commands.Context
import           Calamity.Commands.Dsl
import           Calamity.Commands.Group
import           Calamity.Commands.Handler
import           Calamity.Internal.LocalWriter
import           Calamity.Types.Tellable

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

import qualified Data.HashMap.Lazy              as LH
import           Data.List.NonEmpty             ( NonEmpty(..) )
import qualified Data.List.NonEmpty             as NE
import qualified Data.Text                      as S
import qualified Data.Text.Lazy                 as L

import qualified Polysemy                       as P
import qualified Polysemy.Fail                  as P
import qualified Polysemy.Reader                as P
import Data.Maybe (mapMaybe)

data CommandOrGroup
  = Command' Command
  | Group' Group [S.Text]

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

helpForCommand :: Context -> Command -> L.Text
helpForCommand :: Context -> Command -> Text
helpForCommand ctx :: Context
ctx (cmd :: Command
cmd@Command { NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names :: NonEmpty Text
names, [Check]
$sel:checks:Command :: Command -> [Check]
checks :: [Check]
checks, Context -> Text
$sel:help:Command :: Command -> Context -> Text
help :: Context -> Text
help }) = "```\nUsage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
params' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                                           Text
aliasesFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                                           Text
checksFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                                           Context -> Text
help Context
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
  where prefix' :: Text
prefix' = Context
ctx Context -> Getting Text Context Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "prefix" (Getting Text Context Text)
Getting Text Context Text
#prefix
        path' :: Text
path'   = [Text] -> Text
L.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
commandPath Command
cmd
        params' :: Text
params' = Command -> Text
commandParams Command
cmd
        aliases :: [Text]
aliases = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty Text
names
        checks' :: [Text]
checks' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> ([Check] -> [Text]) -> [Check] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check -> Text) -> [Check] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check -> Getting Text Check Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Check Text)
Getting Text Check Text
#name) ([Check] -> [Text]) -> [Check] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Check]
checks
        aliasesFmt :: Text
aliasesFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
aliases then "" else  "Aliases: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
aliases Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
        checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then "" else "Checks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"

fmtCommandWithParams :: Command -> L.Text
fmtCommandWithParams :: Command -> Text
fmtCommandWithParams cmd :: Command
cmd@Command { NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names } = NonEmpty Text -> Text
formatWithAliases NonEmpty Text
names Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Command -> Text
commandParams Command
cmd

formatWithAliases :: NonEmpty S.Text -> L.Text
formatWithAliases :: NonEmpty Text -> Text
formatWithAliases (name :: Text
name :| aliases :: [Text]
aliases) = Text -> Text
L.fromStrict Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aliasesFmt
  where
    aliasesFmt :: Text
aliasesFmt = case [Text]
aliases of
      [] -> ""
      aliases' :: [Text]
aliases' -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate "|" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict [Text]
aliases') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"

onlyOriginals :: [(a, AliasType)] -> [a]
onlyOriginals :: [(a, AliasType)] -> [a]
onlyOriginals = ((a, AliasType) -> Maybe a) -> [(a, AliasType)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (a, AliasType) -> Maybe a
forall a. (a, AliasType) -> Maybe a
inner
  where inner :: (a, AliasType) -> Maybe a
inner (_, Alias) = Maybe a
forall a. Maybe a
Nothing
        inner (a :: a
a, Original) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

helpForGroup :: Context -> Group -> L.Text
helpForGroup :: Context -> Group -> Text
helpForGroup ctx :: Context
ctx grp :: Group
grp = "```\nGroup: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Text
aliasesFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Text
checksFmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       (Group
grp Group
-> Getting (Context -> Text) Group (Context -> Text)
-> Context
-> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "help" (Getting (Context -> Text) Group (Context -> Text))
Getting (Context -> Text) Group (Context -> Text)
#help) Context
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Text
groupsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
  where path' :: Text
path' = Text -> Text
L.fromStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
S.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Group -> [Text]
groupPath Group
grp
        groups :: [Group]
groups =  [(Group, AliasType)] -> [Group]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group, AliasType)] -> [Group])
-> (HashMap Text (Group, AliasType) -> [(Group, AliasType)])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group, AliasType) -> [(Group, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType) -> [Group]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting
     (HashMap Text (Group, AliasType))
     Group
     (HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "children"
  (Getting
     (HashMap Text (Group, AliasType))
     Group
     (HashMap Text (Group, AliasType)))
Getting
  (HashMap Text (Group, AliasType))
  Group
  (HashMap Text (Group, AliasType))
#children
        commands :: [Command]
commands = [(Command, AliasType)] -> [Command]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command, AliasType)] -> [Command])
-> (HashMap Text (Command, AliasType) -> [(Command, AliasType)])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command, AliasType) -> [(Command, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType) -> [Command]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting
     (HashMap Text (Command, AliasType))
     Group
     (HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command, AliasType))
     Group
     (HashMap Text (Command, AliasType)))
Getting
  (HashMap Text (Command, AliasType))
  Group
  (HashMap Text (Command, AliasType))
#commands
        groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group]
groups [Group]
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group -> Const (Endo [NonEmpty Text]) Group)
 -> [Group] -> Const (Endo [NonEmpty Text]) [Group])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
    -> Group -> Const (Endo [NonEmpty Text]) Group)
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "names"
  ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
   -> Group -> Const (Endo [NonEmpty Text]) Group)
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group
#names)
        groupsMsg :: Text
groupsMsg = if [Group] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group]
groups then "" else "The following child groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
groupsFmt)
        commandsMsg :: Text
commandsMsg = if [Command] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command]
commands then "" else "\nThe following child commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Command] -> [Text]) -> [Command] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> ([Command] -> [Text]) -> [Command] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> Text) -> [Command] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Text
fmtCommandWithParams ([Command] -> Text) -> [Command] -> Text
forall a b. (a -> b) -> a -> b
$ [Command]
commands)
        aliases :: [Text]
aliases = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text])
-> (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.tail (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Group
grp Group
-> Getting (NonEmpty Text) Group (NonEmpty Text) -> NonEmpty Text
forall s a. s -> Getting a s a -> a
^. IsLabel "names" (Getting (NonEmpty Text) Group (NonEmpty Text))
Getting (NonEmpty Text) Group (NonEmpty Text)
#names
        checks' :: [Text]
checks' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
L.fromStrict ([Text] -> [Text]) -> ([Check] -> [Text]) -> [Check] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Check -> Text) -> [Check] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Check -> Getting Text Check Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Check Text)
Getting Text Check Text
#name) ([Check] -> [Text]) -> [Check] -> [Text]
forall a b. (a -> b) -> a -> b
$ Group
grp Group -> Getting [Check] Group [Check] -> [Check]
forall s a. s -> Getting a s a -> a
^. IsLabel "checks" (Getting [Check] Group [Check])
Getting [Check] Group [Check]
#checks
        aliasesFmt :: Text
aliasesFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
aliases then "" else  "Aliases: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
aliases Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
        checksFmt :: Text
checksFmt = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
checks' then "" else "Checks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
L.unwords [Text]
checks' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"

rootHelp :: CommandHandler -> L.Text
rootHelp :: CommandHandler -> Text
rootHelp handler :: CommandHandler
handler = "```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
groupsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandsMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n```"
  where groups :: [Group]
groups =  [(Group, AliasType)] -> [Group]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Group, AliasType)] -> [Group])
-> (HashMap Text (Group, AliasType) -> [(Group, AliasType)])
-> HashMap Text (Group, AliasType)
-> [Group]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Group, AliasType) -> [(Group, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Group, AliasType) -> [Group])
-> HashMap Text (Group, AliasType) -> [Group]
forall a b. (a -> b) -> a -> b
$ CommandHandler
handler CommandHandler
-> Getting
     (HashMap Text (Group, AliasType))
     CommandHandler
     (HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting
     (HashMap Text (Group, AliasType))
     CommandHandler
     (HashMap Text (Group, AliasType)))
Getting
  (HashMap Text (Group, AliasType))
  CommandHandler
  (HashMap Text (Group, AliasType))
#groups
        commands :: [Command]
commands = [(Command, AliasType)] -> [Command]
forall a. [(a, AliasType)] -> [a]
onlyOriginals ([(Command, AliasType)] -> [Command])
-> (HashMap Text (Command, AliasType) -> [(Command, AliasType)])
-> HashMap Text (Command, AliasType)
-> [Command]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text (Command, AliasType) -> [(Command, AliasType)]
forall k v. HashMap k v -> [v]
LH.elems (HashMap Text (Command, AliasType) -> [Command])
-> HashMap Text (Command, AliasType) -> [Command]
forall a b. (a -> b) -> a -> b
$ CommandHandler
handler CommandHandler
-> Getting
     (HashMap Text (Command, AliasType))
     CommandHandler
     (HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command, AliasType))
     CommandHandler
     (HashMap Text (Command, AliasType)))
Getting
  (HashMap Text (Command, AliasType))
  CommandHandler
  (HashMap Text (Command, AliasType))
#commands
        groupsFmt :: [Text]
groupsFmt = (NonEmpty Text -> Text) -> [NonEmpty Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Text -> Text
formatWithAliases ([Group]
groups [Group]
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
-> [NonEmpty Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Group -> Const (Endo [NonEmpty Text]) Group)
-> [Group] -> Const (Endo [NonEmpty Text]) [Group]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Group -> Const (Endo [NonEmpty Text]) Group)
 -> [Group] -> Const (Endo [NonEmpty Text]) [Group])
-> ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
    -> Group -> Const (Endo [NonEmpty Text]) Group)
-> Getting (Endo [NonEmpty Text]) [Group] (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "names"
  ((NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
   -> Group -> Const (Endo [NonEmpty Text]) Group)
(NonEmpty Text -> Const (Endo [NonEmpty Text]) (NonEmpty Text))
-> Group -> Const (Endo [NonEmpty Text]) Group
#names)
        groupsMsg :: Text
groupsMsg = if [Group] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Group]
groups then "" else "The following groups exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
groupsFmt)
        commandsMsg :: Text
commandsMsg = if [Command] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command]
commands then "" else "\nThe following commands exist:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
L.unlines ([Text] -> Text) -> ([Command] -> [Text]) -> [Command] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> ([Command] -> [Text]) -> [Command] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> Text) -> [Command] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Text
fmtCommandWithParams ([Command] -> Text) -> [Command] -> Text
forall a b. (a -> b) -> a -> b
$ [Command]
commands)

helpCommandCallback :: BotC r => CommandHandler -> Context -> [S.Text] -> P.Sem (P.Fail ': r) ()
helpCommandCallback :: CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
helpCommandCallback handler :: CommandHandler
handler ctx :: Context
ctx path :: [Text]
path = do
  case CommandHandler -> [Text] -> Maybe CommandOrGroup
findCommandOrGroup CommandHandler
handler [Text]
path of
    Just (Command' cmd :: Command
cmd@Command { NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names }) ->
      Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ "Help for command `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Command -> Text
helpForCommand Context
ctx Command
cmd
    Just (Group' grp :: Group
grp@Group { NonEmpty Text
$sel:names:Group :: Group -> NonEmpty Text
names :: NonEmpty Text
names } remainingPath :: [Text]
remainingPath) ->
      let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
remainingPath
            then ""
            else "No command or group with the path: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict ([Text] -> Text
S.unwords [Text]
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "` exists for the group: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`\n"
      in Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ Text
failedMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Help for group `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "`: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Group -> Text
helpForGroup Context
ctx Group
grp
    Nothing -> let failedMsg :: Text
failedMsg = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
path
                     then ""
                     else "No command or group with the path: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
L.fromStrict ([Text] -> Text
S.unwords [Text]
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "` was found.\n"
               in Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ())
-> Sem (Fail : r) (Either RestError Message) -> Sem (Fail : r) ()
forall a b. (a -> b) -> a -> b
$ Context -> Text -> Sem (Fail : r) (Either RestError Message)
forall msg (r :: [(* -> *) -> * -> *]) t.
(BotC r, ToMessage msg, Tellable t) =>
t -> msg -> Sem r (Either RestError Message)
tell @L.Text Context
ctx (Text -> Sem (Fail : r) (Either RestError Message))
-> Text -> Sem (Fail : r) (Either RestError Message)
forall a b. (a -> b) -> a -> b
$ Text
failedMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandHandler -> Text
rootHelp CommandHandler
handler

-- | Given a 'CommandHandler', optionally a parent 'Group', and a list of 'Check's,
-- construct a help command that will provide help for all the commands and
-- groups in the passed 'CommandHandler'.
helpCommand' :: BotC r => CommandHandler -> Maybe Group -> [Check] -> P.Sem r Command
helpCommand' :: CommandHandler -> Maybe Group -> [Check] -> Sem r Command
helpCommand' handler :: CommandHandler
handler parent :: Maybe Group
parent checks :: [Check]
checks = NonEmpty Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers '[[Text]] r)
-> Sem r Command
forall (ps :: [*]) (r :: [(* -> *) -> * -> *]).
(Member (Final IO) r, TypedCommandC ps r) =>
NonEmpty Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
buildCommand @'[[S.Text]] ("help" Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Group
parent [Check]
checks Context -> Text
helpCommandHelp
  (CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CommandHandler -> Context -> [Text] -> Sem (Fail : r) ()
helpCommandCallback CommandHandler
handler)

-- | Create and register the default help command for all the commands
-- registered in the commands DSL this is used in.
helpCommand :: BotC r => P.Sem (DSLState r) Command
helpCommand :: Sem (DSLState r) Command
helpCommand = do
  CommandHandler
handler <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader CommandHandler) r =>
Sem r CommandHandler
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @CommandHandler
  Maybe Group
parent <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(Maybe Group)
  [Check]
checks <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @[Check]
  Command
cmd <- Sem r Command -> Sem (DSLState r) Command
forall (r :: [(* -> *) -> * -> *]) a. Sem r a -> Sem (DSLState r) a
raiseDSL (Sem r Command -> Sem (DSLState r) Command)
-> Sem r Command -> Sem (DSLState r) Command
forall a b. (a -> b) -> a -> b
$ CommandHandler -> Maybe Group -> [Check] -> Sem r Command
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CommandHandler -> Maybe Group -> [Check] -> Sem r Command
helpCommand' CommandHandler
handler Maybe Group
parent [Check]
checks
  HashMap Text (Command, AliasType) -> Sem (DSLState r) ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command, AliasType) -> Sem (DSLState r) ())
-> HashMap Text (Command, AliasType) -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> (Command, AliasType) -> HashMap Text (Command, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton "help" (Command
cmd, AliasType
Original)
  Command -> Sem (DSLState r) Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
cmd

findCommandOrGroup :: CommandHandler -> [S.Text] -> Maybe CommandOrGroup
findCommandOrGroup :: CommandHandler -> [Text] -> Maybe CommandOrGroup
findCommandOrGroup handler :: CommandHandler
handler path :: [Text]
path = (HashMap Text (Command, AliasType),
 HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (CommandHandler
handler CommandHandler
-> Getting
     (HashMap Text (Command, AliasType))
     CommandHandler
     (HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command, AliasType))
     CommandHandler
     (HashMap Text (Command, AliasType)))
Getting
  (HashMap Text (Command, AliasType))
  CommandHandler
  (HashMap Text (Command, AliasType))
#commands, CommandHandler
handler CommandHandler
-> Getting
     (HashMap Text (Group, AliasType))
     CommandHandler
     (HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "groups"
  (Getting
     (HashMap Text (Group, AliasType))
     CommandHandler
     (HashMap Text (Group, AliasType)))
Getting
  (HashMap Text (Group, AliasType))
  CommandHandler
  (HashMap Text (Group, AliasType))
#groups) [Text]
path
  where go :: (LH.HashMap S.Text (Command, AliasType), LH.HashMap S.Text (Group, AliasType))
           -> [S.Text]
           -> Maybe CommandOrGroup
        go :: (HashMap Text (Command, AliasType),
 HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (commands :: HashMap Text (Command, AliasType)
commands, groups :: HashMap Text (Group, AliasType)
groups) (x :: Text
x : xs :: [Text]
xs) =
          case Text
-> HashMap Text (Command, AliasType) -> Maybe (Command, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Command, AliasType)
commands of
            Just (cmd :: Command
cmd, _) -> CommandOrGroup -> Maybe CommandOrGroup
forall a. a -> Maybe a
Just (Command -> CommandOrGroup
Command' Command
cmd)
            Nothing       -> case Text -> HashMap Text (Group, AliasType) -> Maybe (Group, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup Text
x HashMap Text (Group, AliasType)
groups of
              Just (group :: Group
group, _) -> (HashMap Text (Command, AliasType),
 HashMap Text (Group, AliasType))
-> [Text] -> Maybe CommandOrGroup
go (Group
group Group
-> Getting
     (HashMap Text (Command, AliasType))
     Group
     (HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "commands"
  (Getting
     (HashMap Text (Command, AliasType))
     Group
     (HashMap Text (Command, AliasType)))
Getting
  (HashMap Text (Command, AliasType))
  Group
  (HashMap Text (Command, AliasType))
#commands, Group
group Group
-> Getting
     (HashMap Text (Group, AliasType))
     Group
     (HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "children"
  (Getting
     (HashMap Text (Group, AliasType))
     Group
     (HashMap Text (Group, AliasType)))
Getting
  (HashMap Text (Group, AliasType))
  Group
  (HashMap Text (Group, AliasType))
#children) [Text]
xs Maybe CommandOrGroup
-> Maybe CommandOrGroup -> Maybe CommandOrGroup
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommandOrGroup -> Maybe CommandOrGroup
forall a. a -> Maybe a
Just (Group -> [Text] -> CommandOrGroup
Group' Group
group [Text]
xs)
              Nothing         -> Maybe CommandOrGroup
forall a. Maybe a
Nothing
        go _ [] = Maybe CommandOrGroup
forall a. Maybe a
Nothing