{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE OverloadedStrings #-}
-- for CommandHandlerType
{-# LANGUAGE FlexibleInstances, FunctionalDependencies, UndecidableInstances #-}
-- for Command
{-# LANGUAGE NamedFieldPuns #-}
-- for runCommand
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module      : Command.Command
License     : BSD (see the LICENSE file)
Description : Everything commands :)

Amateur attempt at command abstraction and polyvariadic magic.

Inspired heavily by calamity-commands, which is provided by Ben Simms 2020
under the MIT license. 

Ideally, this module wouldn't need to be touched after its initial creation
(and hence quite the jump in complex GHC extensions compared to other modules),
however it is documented quite extensively anyway.

__As an OwenDev, you do not need to enable any GHC extensions, as the__
__extensions are used internally within this module only__.

==== __Notable extensions used (if you want to know)__

    * ScopedTypeVariables: For using the same type variables in @where@
    statements as function declarations.
    * FlexibleInstances: To allow complex type variables in instance declarations,
    like @CommandHandlerType m (a -> m ())@.
    [Read more]
    (https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/instances.html#extension-FlexibleInstances)
    * FunctionalDependencies: To write that @m@ can be determined from @h@ in
    @CommandHandlerType@. It makes logical sense to tell GHC this because @h@ 
    must be in the @m@ monad (otherwise, @h@ may be in another monad).
    [Read more]
    (https://en.wikibooks.org/wiki/Haskell/Advanced_type_classes)
    * MultiParamTypeClasses: For declaring CommandHandlerType that has 2 params.
    This comes with FunctionalDependencies automatically, and is not explicitly
    used.
    * UndecidableInstances: Risky, but I think I logically checked over it. Used
    in the @m (a -> b)@ instance declaration of 'CommandHandlerType', because
    @(a -> b)@ doesn't explicitly determine the required functional dependency
    (@h -> m@). The extension is risky because the type-checker can fail to
    terminate if the instance declarations recursively reference each other. In
    this module however, all instances strictly converges to the @m (m ())@
    instance so I say it is safe. [Read more]
    (https://www.reddit.com/r/haskell/comments/5zjwym/when_is_undecidableinstances_okay_to_use/)
    * NamedFieldPuns: Shorten pattern matching ADT field names.
    
==== __Implementation references__

    * [Varargs - Haskell Wiki]
    (https://wiki.haskell.org/Varargs)
    * [How to create a polyvariadic haskell function?]
    (https://stackoverflow.com/questions/3467279/how-to-create-a-polyvariadic-haskell-function)
    * [How to write a Haskell function that takes a variadic function as an argument]
    (https://stackoverflow.com/questions/8353845/how-to-write-a-haskell-function-that-takes-a-variadic-function-as-an-argument)
    * [calamity-commands](https://github.com/simmsb/calamity/tree/master/calamity-commands)
-}

module Command.Command
    ( -- * Troubleshooting
      -- | See the [Common Errors](#commonerrors) section.
  
      -- * The fundamentals
      -- | These offer the core functionality for Commands. The most imporatnt
      -- functions are 'command' and 'runCommand'.
      --
      --     * 'command' creates a 'Command'
      --     * 'runCommand' converts the 'Command' to a normal receiver.
      --
      -- If your command demands a special syntax that is impossible with the
      -- existing 'command' function, use 'parsecCommand' (Parsec) or 'regexCommand'
      -- (Regex).
      Command
    , command
    , runCommand
    , runCommands
    , runHelp
      -- ** Custom command parsing
      -- | Parsec and Regex options are available.
    , parsecCommand
    , regexCommand
      -- ** Compsable Functions
      -- | These can be composed onto 'command' to overwrite default functionality.
    , help
    , alias
    , onError
    , defaultErrorHandler
    , requires
      -- ** Errors
    , CommandError(..)
      -- ** Parsing arguments
      -- | The 'ParsableArgument' is the core dataclass for command arguments that
      -- can be parsed.
      --
      -- As an OwenDev, if you want to make your own datatype parsable, all you
      -- have to do is to add an instance declaration for it (and a parser) inside
      -- @Command/Parser.hs@. Parsec offers very very very useful functions that
      -- you can simply compose together to create parsers.
    , ParsableArgument
    , RemainingText(..)
      -- * Exported classes
      -- | Here are the monad dataclasses exported from this module.
    
      -- ** The MonadDiscord class
      -- | MonadDiscord is the underlying Monad class for all interactions to the
      -- Discord REST API. 
      --
      -- This is a common way to design abstraction so you can mock them. Same as
      -- Java interfaces, C++ virtual functions. Source that I based this design on:
      --
      --     * [Here is a link]
      -- (https://www.reddit.com/r/haskell/comments/5bnr6b/mocking_in_haskell/)
      --     * [Another link]
      -- (https://lexi-lambda.github.io/blog/2017/06/29/unit-testing-effectful-haskell-with-monad-mock/)
    , module Discord.Internal.Monad
      -- ** MonadIO
      -- | Exported solely for convenience purposes, since many modules that use
      -- Commands require the MonadIO constraint, but it can get confusing where
      -- to import it from (UnliftIO or Control.Monad.IO.Class). The one exported
      -- from this module is from "Control.Monad.IO.Class" which is in @base@.
    , MonadIO(..)
      -- * Common Errors
      -- | #commonerrors#
      -- $commonerrors
    ) where

import           Control.Applicative        ( Alternative(..)
                                            )
import           Control.Exception.Safe     ( catch
                                            , throwM
                                            , MonadCatch
                                            , MonadThrow
                                            , Exception
                                            , SomeException
                                            )
import           Control.Monad.IO.Class     ( MonadIO )
import           Control.Monad              ( void
                                            , guard
                                            , unless
                                            )
import           Data.Maybe                 ( catMaybes )
import qualified Data.Text as T
import           Text.Parsec.Combinator
import           Text.Parsec.Error          ( errorMessages
                                            , showErrorMessages
                                            )
import qualified Text.Parsec.Text as T
import           Text.Parsec                ( parse
                                            , eof
                                            , ParseError
                                            , space
                                            , anyChar
                                            , string
                                            , getInput
                                            )
import           Text.Regex.TDFA            ( (=~) )
import           UnliftIO                   ( liftIO )

import           Discord.Internal.Monad
import           Discord.Types
import           Discord

import           Command.Error              ( CommandError(..) )
import           Command.Parser             ( ParsableArgument(..)
                                            , RemainingText(..)
                                            , manyTill1
                                            , endOrSpaces
                                            )
import           Owoifier                   ( owoify )

{- | A @Command@ is a datatype containing the metadata for a user-registered
command. 

@Command m@ is a command that runs in the monad @m@, which when triggered
will run a polyvariadic handler function. The handler *must* run in the
@m@ monad, which is enforced by the type-checker (to see the details, look in
@CommandHandlerType@ in the source code).

The contents of this abstract datatype are not exported from this module for
encapsulation. Use 'command', 'parsecCommand', or 'regexCommand' to
instantiate one.
-}
data Command m = Command
    { Command m -> Text
commandName         :: T.Text
    -- ^ The name of the command.
    , Command m -> Text
commandPrefix       :: T.Text
    -- ^ The prefix for the command. 
    , Command m -> [Text]
commandAliases      :: [T.Text]
    -- ^ Any alias names for the command.
    , Command m -> Message -> Command m -> Maybe [Text]
commandInitialMatch :: Message -> Command m -> Maybe [T.Text]
    -- ^ A function that performs an initial match check before checking for
    -- requirements or applying arguments. Grabs the necessary parts to be passed
    -- into commandApplier. If not matching, this will be Nothing.
    -- TODO: Find a better type than [T.Text], that can express all of:
    -- 1. Regex capture results (list of captured T.Text)
    -- 2. Custom parsec result type (String)
    -- 3. Arguments after a normal command name (T.Text: fed into the parser)
    , Command m -> Message -> [Text] -> m ()
commandApplier      :: Message -> [T.Text] -> m ()
    -- ^ The function used to apply the arguments into a handler. It needs to
    -- take a 'Message' that triggered the command, the input text, and produce
    -- an action in the monad @m@.
    , Command m -> Message -> CommandError -> m ()
commandErrorHandler :: Message -> CommandError -> m ()
    -- ^ The function called when a 'CommandError' is raised during the handling
    -- of a command.
    , Command m -> Text
commandHelp         :: T.Text
    -- ^ The help for this command.
    , Command m -> [Message -> m (Maybe Text)]
commandRequires     :: [Message -> m (Maybe T.Text)]
    -- ^ A list of requirements that need to pass (Nothing) for the command to
    -- be processed. If any fails, the reason will be passed to
    -- commandErrorHandler.
    }


{- | @command name handler@ creates a 'Command' named @name@, which upon
receiving a message will run @handler@. The @name@ cannot contain any spaces,
as it breaks the parser. The @handler@ function can take an arbitrary amount
of arguments of arbitrary types (it is polyvariadic), as long as they are
instances of 'ParsableArgument'.

The Command that this function creates is polymorphic in the Monad it is run
in. This means you can call it from 'DiscordHandler' or any other
Monad that satisfies the constraints of 'MonadDiscord'.
 
==== __See some examples__

@pong@ below responds to a ping by a pong.

@
pong :: (MonadDiscord m) => Command m
pong = command "ping" $ \\msg -> respond msg "pong!"
@
 
@pong2@ shows that @runCommand@ can be composed to create a normal receiver.
That is, it takes a Message and returns a unit action in the desired monad.

@
pong2 :: (MonadDiscord m) => Message -> m ()
pong2 = runCommand $ command "ping" $ \\msg -> respond msg "pong!"
@

@weather@ below shows having arbitrary arguments in action. @location@ is
likely inferred to be 'T.Text'.

@
weather = command "weather" $ \\msg location -> do
    result <- liftIO $ getWeather location
    respond msg $ "Weather at " <> location <> " is " <> result <> "!"
@

@complex@ shows that you can parse any type! (as long as you create an
instance declaration of 'ParsableArgument' for it). You may want to put this in
@Command/Parser.hs@.

@
instance ParsableArgument Int where
    parserForArg = read \<$> many digit -- some Parsec that returns an Int

complex :: (MonadDiscord m) => Command m
complex = command "setLimit" $ \\m i -> do
    respond m $ show (i + 20 / 4 + 78^3) -- i is automatically inferred as Int!
    ...
@
-}
command
    :: (CommandHandlerType m h , MonadDiscord m)
    => T.Text
    -- ^ The name of the command.
    -> h
    -- ^ The handler for the command, that takes an arbitrary amount of
    -- 'ParsableArgument's and returns a @m ()@
    -> Command m
command :: Text -> h -> Command m
command Text
name h
commandHandler = Command :: forall (m :: * -> *).
Text
-> Text
-> [Text]
-> (Message -> Command m -> Maybe [Text])
-> (Message -> [Text] -> m ())
-> (Message -> CommandError -> m ())
-> Text
-> [Message -> m (Maybe Text)]
-> Command m
Command
    { commandName :: Text
commandName         = Text
name
    , commandPrefix :: Text
commandPrefix       = Text
":"
    , commandAliases :: [Text]
commandAliases      = []
    , commandInitialMatch :: Message -> Command m -> Maybe [Text]
commandInitialMatch = \Message
msg Command m
cmd ->
        case Parsec Text () Text -> SourceName -> Text -> Either ParseError Text
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse (Command m -> Parsec Text () Text
forall (m :: * -> *). Command m -> Parsec Text () Text
parseCommandName Command m
cmd) SourceName
"" (Message -> Text
messageText Message
msg) of
            Left ParseError
e -> Maybe [Text]
forall a. Maybe a
Nothing
            Right Text
args -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
args]
    , commandApplier :: Message -> [Text] -> m ()
commandApplier      = \Message
x [Text]
y -> h -> Message -> Text -> m ()
forall (m :: * -> *) h.
CommandHandlerType m h =>
h -> Message -> Text -> m ()
applyArgs h
commandHandler Message
x ([Text] -> Text
forall a. [a] -> a
head [Text]
y)
    , commandErrorHandler :: Message -> CommandError -> m ()
commandErrorHandler = Message -> CommandError -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Message -> CommandError -> m ()
defaultErrorHandler
    , commandHelp :: Text
commandHelp         = Text
"Help not available."
    , commandRequires :: [Message -> m (Maybe Text)]
commandRequires     = []
    }

{- | @onError@ overwrites the default error handler of a command with a custom
implementation. Usually the default 'defaultErrorHandler' suffices.

@
example
    = onError (\\msg e -> respond msg (T.pack $ show e))
    . command "example" $ do
        ...
@
-}
onError
    :: (Message -> CommandError -> m ())
    -- ^ Error handler that takes the original message that caused the error,
    -- and the error itself. It runs in the same monad as the command handlers.
    -> Command m
    -> Command m
onError :: (Message -> CommandError -> m ()) -> Command m -> Command m
onError Message -> CommandError -> m ()
errorHandler Command m
cmd = Command m
cmd
    { commandErrorHandler :: Message -> CommandError -> m ()
commandErrorHandler = Message -> CommandError -> m ()
errorHandler
    }

{- | @prefix@ overwrites the default command prefix ":" of a command with a
custom one. This is ignored if a regex parser is used, however it is still
applicable for 'parsecCommand'.

@
example
    = prefix "->"
    . command "idk" $ do
        ...
@
-}
prefix
    :: T.Text
    -> Command m
    -> Command m
prefix :: Text -> Command m -> Command m
prefix Text
newPrefix Command m
cmd = Command m
cmd
    { commandPrefix :: Text
commandPrefix = Text
newPrefix
    }

{- | @requires@ adds a requirement to the command. The requirement is a function
that takes a 'Message' and either returns @'Nothing'@ (no problem) or
@'Just' "explanation"@. The function is in the @m@ monad so it can access
any additional information from Discord as necessary.

Commands default to having no requirements.
-}
requires :: (Message -> m (Maybe T.Text)) -> Command m -> Command m
requires :: (Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> m (Maybe Text)
requirement Command m
cmd = Command m
cmd
    { commandRequires :: [Message -> m (Maybe Text)]
commandRequires = Message -> m (Maybe Text)
requirement (Message -> m (Maybe Text))
-> [Message -> m (Maybe Text)] -> [Message -> m (Maybe Text)]
forall a. a -> [a] -> [a]
: Command m -> [Message -> m (Maybe Text)]
forall (m :: * -> *). Command m -> [Message -> m (Maybe Text)]
commandRequires Command m
cmd
    }

{- | @help@ sets the help message for the command. The default is "Help not
available."
-}
help :: T.Text -> Command m -> Command m
help :: Text -> Command m -> Command m
help Text
newHelp Command m
cmd = Command m
cmd
    { commandHelp :: Text
commandHelp = Text
newHelp
    }

{- | @alias@ adds an alias for the command's name. This is ignored if a custom
parser like 'regexCommand' or 'parsecCommand' is used.

Functionally, this is equivalent to defining a new command with the same
handler, however the aliases may not appear on help pages.
-}
alias :: T.Text -> Command m -> Command m
alias :: Text -> Command m -> Command m
alias Text
newAlias Command m
cmd = Command m
cmd
    { commandAliases :: [Text]
commandAliases = Text
newAlias Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Command m -> [Text]
forall (m :: * -> *). Command m -> [Text]
commandAliases Command m
cmd
    }

{- | @parsecCommand@ defines a command that has no name, and has a custom
parser that begins from the start of a message. It can help things like
"::quotes" because they have special syntax that demands a special parser.

'alias', if used together, is ignored. Other compoasble functions like 'help',
'prefix', 'requires', and 'onError' are still valid.

The handler __must__ take a 'Message' and a 'String' as argument (nothing
more, nothing less), where the latter is the result of the parser.

@
example
    = requires moderatorPrivs
    . prefix "~~"
    . parsecCommand (string "abc" >> many1 anyChar) $ \\msg quoteName -> do
        ...
         this is triggered on "~~abc\<one or more chars>" where quoteName
         contains the section enclosed in \<>
@
-}
parsecCommand
    :: (MonadDiscord m)
    => T.Parser String
    -- ^ The custom parser for the command. It has to return a 'String'.
    -> (Message -> String -> m ())
    -- ^ The handler for the command.
    -> Command m
parsecCommand :: Parser SourceName -> (Message -> SourceName -> m ()) -> Command m
parsecCommand Parser SourceName
parserFunc Message -> SourceName -> m ()
commandHandler = Command :: forall (m :: * -> *).
Text
-> Text
-> [Text]
-> (Message -> Command m -> Maybe [Text])
-> (Message -> [Text] -> m ())
-> (Message -> CommandError -> m ())
-> Text
-> [Message -> m (Maybe Text)]
-> Command m
Command
    { commandName :: Text
commandName         = Text
"<custom parser>"
    , commandPrefix :: Text
commandPrefix       = Text
""
    , commandAliases :: [Text]
commandAliases      = []
    , commandInitialMatch :: Message -> Command m -> Maybe [Text]
commandInitialMatch = \Message
msg Command m
cmd ->
      let
        parser :: Parser SourceName
parser = SourceName -> Parser SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string (Text -> SourceName
T.unpack (Text -> SourceName) -> Text -> SourceName
forall a b. (a -> b) -> a -> b
$ Command m -> Text
forall (m :: * -> *). Command m -> Text
commandPrefix Command m
cmd) Parser SourceName -> Parser SourceName -> Parser SourceName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SourceName
parserFunc
      in
        case Parser SourceName
-> SourceName -> Text -> Either ParseError SourceName
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse Parser SourceName
parser SourceName
"" (Message -> Text
messageText Message
msg) of
            Left ParseError
e -> Maybe [Text]
forall a. Maybe a
Nothing
            Right SourceName
result -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [SourceName -> Text
T.pack SourceName
result]
            -- has to be packed and unpacked, which is not really good.
            -- TODO: find some datatype that can express the "meaningful part of
            -- a message text", which can be String, T.Text, and [T.Text]
            -- depending on parsec, normal command, or regex.
    , commandApplier :: Message -> [Text] -> m ()
commandApplier      = \Message
x [Text]
y -> Message -> SourceName -> m ()
commandHandler Message
x (Text -> SourceName
T.unpack (Text -> SourceName) -> Text -> SourceName
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
y)
    , commandErrorHandler :: Message -> CommandError -> m ()
commandErrorHandler = Message -> CommandError -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Message -> CommandError -> m ()
defaultErrorHandler
    , commandHelp :: Text
commandHelp         = Text
"Help not available."
    , commandRequires :: [Message -> m (Maybe Text)]
commandRequires     = []
    }

{- | @regexCommand@ defines a command that has no name, and has a custom
regular expression matcher, that __searches across any part of the message__.

'prefix' and 'alias', if used together, are ignored. Other compoasble
functions like 'help', 'requires', and 'onError' are still valid.

The handler __must__ take a 'Message' and a '[T.Text]' as argument, where
the latter are the list of captured values from the Regex (same as the past
@newCommand@).

@
thatcher = regexCommand "thatcher [Ii]s ([Dd]ead|[Aa]live)" $ \\msg caps -> do
    let verb = head caps
...
@
-}
regexCommand
    :: (MonadDiscord m)
    => T.Text
    -> (Message -> [T.Text] -> m ())
    -> Command m
regexCommand :: Text -> (Message -> [Text] -> m ()) -> Command m
regexCommand Text
regex Message -> [Text] -> m ()
commandHandler = Command :: forall (m :: * -> *).
Text
-> Text
-> [Text]
-> (Message -> Command m -> Maybe [Text])
-> (Message -> [Text] -> m ())
-> (Message -> CommandError -> m ())
-> Text
-> [Message -> m (Maybe Text)]
-> Command m
Command
    { commandName :: Text
commandName         = Text
"<regex>"
    , commandPrefix :: Text
commandPrefix       = Text
""
    , commandAliases :: [Text]
commandAliases      = []
    , commandInitialMatch :: Message -> Command m -> Maybe [Text]
commandInitialMatch = \Message
msg Command m
cmd ->
        case Message -> Text
messageText Message
msg Text -> Text -> [[Text]]
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text
regex :: [[T.Text]] of
            [] -> Maybe [Text]
forall a. Maybe a
Nothing
            [[Text]]
xs -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> [[Text]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Text] -> [Text]
forall a. [a] -> [a]
tail [[Text]]
xs
    , commandApplier :: Message -> [Text] -> m ()
commandApplier      = Message -> [Text] -> m ()
commandHandler
    , commandErrorHandler :: Message -> CommandError -> m ()
commandErrorHandler = Message -> CommandError -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Message -> CommandError -> m ()
defaultErrorHandler
    , commandHelp :: Text
commandHelp         = Text
"Help not available."
    , commandRequires :: [Message -> m (Maybe Text)]
commandRequires     = []
    }

{- | @runCommand command msg@ runs the specified 'Command' with the given
message. It first does the initial checks:

For commands registered with 'command', the check will check for the prefix
and the name.

For commands registered with 'regexCommand', the check will check against the
regex.

For commands registered with 'parsecCommand', the check will check for the 
prefix and the custom parser.

Any failures during this stage is silently ignored, as it may still be a valid
command elsewhere. After this, the requirements are checked (chance, priv, etc).
Finally, the @commandApplier@ is called. Any errors inside the handler is
caught and appropriately handled.

@
runCommand pong :: (MonadDiscord m) => Message -> m ()
@
-}
runCommand
    :: forall m.
    (MonadDiscord m)
    => Command m
    -- ^ The command to run against.
    -> Message
    -- ^ The message to run the command with.
    -> m ()
runCommand :: Command m -> Message -> m ()
runCommand cmd :: Command m
cmd@Command{ Message -> Command m -> Maybe [Text]
commandInitialMatch :: Message -> Command m -> Maybe [Text]
commandInitialMatch :: forall (m :: * -> *).
Command m -> Message -> Command m -> Maybe [Text]
commandInitialMatch, Message -> [Text] -> m ()
commandApplier :: Message -> [Text] -> m ()
commandApplier :: forall (m :: * -> *). Command m -> Message -> [Text] -> m ()
commandApplier, Message -> CommandError -> m ()
commandErrorHandler :: Message -> CommandError -> m ()
commandErrorHandler :: forall (m :: * -> *). Command m -> Message -> CommandError -> m ()
commandErrorHandler, [Message -> m (Maybe Text)]
commandRequires :: [Message -> m (Maybe Text)]
commandRequires :: forall (m :: * -> *). Command m -> [Message -> m (Maybe Text)]
commandRequires } Message
msg =
    case Message -> Command m -> Maybe [Text]
commandInitialMatch Message
msg Command m
cmd of
        Maybe [Text]
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just [Text]
results -> do
            -- Check for requirements. checks will be a list of Maybes
            [Maybe Text]
checks <- ((Message -> m (Maybe Text)) -> m (Maybe Text))
-> [Message -> m (Maybe Text)] -> m [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Message -> m (Maybe Text)) -> Message -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Message
msg) [Message -> m (Maybe Text)]
commandRequires
            -- only get the Justs
            let failedChecks :: [Text]
failedChecks = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
checks
            if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
failedChecks then
                -- Apply the arguments on the handler
                Message -> [Text] -> m ()
commandApplier Message
msg [Text]
results
                    -- Asynchrnous errors are not caught as the `catch`
                    -- comes from Control.Exception.Safe. This is good.
                    m () -> (CommandError -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` CommandError -> m ()
basicErrorCatcher
                    m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> m ()
allErrorCatcher
            else
                -- give the first requirement error to the error handler
                CommandError -> m ()
basicErrorCatcher (Text -> CommandError
RequirementError (Text -> CommandError) -> Text -> CommandError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
failedChecks)
  where
    -- | Catch CommandErrors and handle them with the handler
    basicErrorCatcher :: CommandError -> m ()
    basicErrorCatcher :: CommandError -> m ()
basicErrorCatcher = Message -> CommandError -> m ()
commandErrorHandler Message
msg

    -- | Catch any and all errors, including ones thrown in basicErrorCatcher.
    allErrorCatcher :: SomeException -> m ()
    allErrorCatcher :: SomeException -> m ()
allErrorCatcher = Message -> CommandError -> m ()
commandErrorHandler Message
msg (CommandError -> m ())
-> (SomeException -> CommandError) -> SomeException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> CommandError
HaskellError

{- | @runCommands@ calls runCommand for all the Commands, and folds them with
the Monadic bind ('>>').
-}
runCommands
    :: (MonadDiscord m, Alternative m)
    => [Command m]
    -> Message
    -> m ()
runCommands :: [Command m] -> Message -> m ()
runCommands = (Message -> [Command m] -> m ()) -> [Command m] -> Message -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Command m -> m ()) -> [Command m] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Command m -> m ()) -> [Command m] -> m ())
-> (Message -> Command m -> m ()) -> Message -> [Command m] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command m -> Message -> m ()) -> Message -> Command m -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Command m -> Message -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand)

{- | @runHelp@ creates a super duper simple help command that just lists
each command's names together with their help text.
-}
runHelp
    :: (MonadDiscord m)
    => T.Text
    -> [Command m]
    -> Message
    -> m ()
runHelp :: Text -> [Command m] -> Message -> m ()
runHelp Text
name [Command m]
cmds
    = Command m -> Message -> m ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand
    (Command m -> Message -> m ())
-> ((Message -> m ()) -> Command m)
-> (Message -> m ())
-> Message
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
name ((Message -> m ()) -> Message -> m ())
-> (Message -> m ()) -> Message -> m ()
forall a b. (a -> b) -> a -> b
$ \Message
msg -> do
        Channel
chan <- UserId -> m Channel
forall (m :: * -> *). MonadDiscord m => UserId -> m Channel
createDM (User -> UserId
userId (User -> UserId) -> User -> UserId
forall a b. (a -> b) -> a -> b
$ Message -> User
messageAuthor Message
msg)
        m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> Text -> m Message
forall (m :: * -> *). MonadDiscord m => UserId -> Text -> m Message
createMessage (Channel -> UserId
channelId Channel
chan) (Text -> m Message) -> Text -> m Message
forall a b. (a -> b) -> a -> b
$
            Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"\n" ((Command m -> Text) -> [Command m] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Command m -> Text
forall (m :: * -> *). Command m -> Text
createCommandHelp [Command m]
cmds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"```"
  where
    createCommandHelp :: Command m -> T.Text
    createCommandHelp :: Command m -> Text
createCommandHelp Command{ Text
commandPrefix :: Text
commandPrefix :: forall (m :: * -> *). Command m -> Text
commandPrefix, Text
commandName :: Text
commandName :: forall (m :: * -> *). Command m -> Text
commandName, Text
commandHelp :: Text
commandHelp :: forall (m :: * -> *). Command m -> Text
commandHelp } =
        Text
"# " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commandHelp



{- | @defaultErrorHandler m e@ is the default error handler unless you override
it manually. This is exported and documented for reference only.

[On argument error] It calls 'respond' with the errors. This isn't owoified
for legibility.
[On requirement error] It sends a DM to the invoking user with the errors.
[On a processing error] It calls 'respond' with the error.
[On a Discord request failure] It calls 'respond' with the error.
[On a Runtime/Haskell error] It calls 'respond' with the error, owoified.
-}
defaultErrorHandler
    :: (MonadDiscord m)
    => Message
    -> CommandError
    -> m ()
defaultErrorHandler :: Message -> CommandError -> m ()
defaultErrorHandler Message
m CommandError
e =
    case CommandError
e of
        ArgumentParseError Text
x ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
x
        RequirementError Text
x ->
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Channel
chan <- UserId -> m Channel
forall (m :: * -> *). MonadDiscord m => UserId -> m Channel
createDM (User -> UserId
userId (User -> UserId) -> User -> UserId
forall a b. (a -> b) -> a -> b
$ Message -> User
messageAuthor Message
m)
                m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> Text -> m Message
forall (m :: * -> *). MonadDiscord m => UserId -> Text -> m Message
createMessage (Channel -> UserId
channelId Channel
chan) Text
x
        ProcessingError Text
x ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
x
        DiscordError RestCallErrorCode
x ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack (SourceName -> Text) -> SourceName -> Text
forall a b. (a -> b) -> a -> b
$ SourceName
"Discord request failed with a " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> RestCallErrorCode -> SourceName
forall a. Show a => a -> SourceName
show RestCallErrorCode
x
        HaskellError SomeException
x ->
            Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack (SourceName -> Text) -> SourceName -> Text
forall a b. (a -> b) -> a -> b
$ SourceName
"Runtime error (contact OwenDev, this is a bug): " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> SomeException -> SourceName
forall a. Show a => a -> SourceName
show SomeException
x

{- | @parseCommandName@ returns a parser that tries to consume the prefix,
Command name, appropriate amount of spaces, and returns the arguments.
If there are no arguments, it will return the empty text, "".
-}
parseCommandName :: Command m -> T.Parser T.Text
parseCommandName :: Command m -> Parsec Text () Text
parseCommandName Command m
cmd = do
    -- consume prefix
    SourceName -> Parser SourceName
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string (Text -> SourceName
T.unpack (Text -> SourceName) -> Text -> SourceName
forall a b. (a -> b) -> a -> b
$ Command m -> Text
forall (m :: * -> *). Command m -> Text
commandPrefix Command m
cmd)
    -- consume at least 1 character until a space is encountered
    -- don't consume the space
    SourceName
cmdName <- ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> Parser SourceName
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space) ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
    -- check it's the proper command
    Bool -> ParsecT Text () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text () Identity ())
-> Bool -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack SourceName
cmdName Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Command m -> Text
forall (m :: * -> *). Command m -> Text
commandName Command m
cmd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Command m -> [Text]
forall (m :: * -> *). Command m -> [Text]
commandAliases Command m
cmd)
    -- parse either an end of input, or spaces followed by arguments
    (ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT Text () Identity ()
-> Parsec Text () Text -> Parsec Text () Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parsec Text () Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"") Parsec Text () Text -> Parsec Text () Text -> Parsec Text () Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
        -- consumes one or more isSpace characters
        ParsecT Text () Identity Char -> Parser SourceName
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
        -- consume everything until end of input
        SourceName
args <- ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> Parser SourceName
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        -- return the args
        Text -> Parsec Text () Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceName -> Text
T.pack SourceName
args)


-------------------------------------------------------------------------------
                      -- Polyvariadic argument applier --
-------------------------------------------------------------------------------

{- | @CommandHandlerType@ is a dataclass for all types of arguments that a
command handler may have. Its only function is @applyArgs@.
-}
class (MonadThrow m) => CommandHandlerType m h | h -> m where
    applyArgs
        :: h
        -- ^ The handler. It must be in the same monad as @m@.
        -> Message
        -- ^ The relevant message.
        -> T.Text
        -- ^ The arguments of the command, i.e. everything after the command
        -- name followed by one or more spaces. Is "" if empty.
        -> m ()
        -- ^ The monad to run the handler in, and to throw parse errors in.

{- | For the case when all arguments have been applied. Base case. -}
instance (MonadThrow m) => CommandHandlerType m (m ()) where
    applyArgs :: m () -> Message -> Text -> m ()
applyArgs m ()
handler Message
msg Text
input =
        case ParsecT Text () Identity ()
-> SourceName -> Text -> Either ParseError ()
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof SourceName
"" Text
input of
            Left ParseError
e -> CommandError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CommandError -> m ()) -> CommandError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> CommandError
ArgumentParseError (Text -> CommandError) -> Text -> CommandError
forall a b. (a -> b) -> a -> b
$
                Text
"Too many arguments! " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
showErrAsText ParseError
e
            Right ()
_ -> m ()
handler

{- | For the case where there are multiple arguments to apply. -}
instance (MonadThrow m, ParsableArgument a, CommandHandlerType m b) => CommandHandlerType m (a -> b) where
    applyArgs :: (a -> b) -> Message -> Text -> m ()
applyArgs a -> b
handler Message
msg Text
input = do
        let p :: ParsecT Text () Identity (a, Text)
p = (,) (a -> Text -> (a, Text))
-> ParsecT Text () Identity a
-> ParsecT Text () Identity (Text -> (a, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text () Identity a
forall a. ParsableArgument a => Parser a
parserForArg ParsecT Text () Identity a
-> ParsecT Text () Identity () -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
endOrSpaces) ParsecT Text () Identity (Text -> (a, Text))
-> Parsec Text () Text -> ParsecT Text () Identity (a, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Text () Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
        case ParsecT Text () Identity (a, Text)
-> SourceName -> Text -> Either ParseError (a, Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse ParsecT Text () Identity (a, Text)
p SourceName
"arguments" Text
input of
            Left ParseError
e -> CommandError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CommandError -> m ()) -> CommandError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> CommandError
ArgumentParseError (Text -> CommandError) -> Text -> CommandError
forall a b. (a -> b) -> a -> b
$
                Text
"Error while parsing argument. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
showErrAsText ParseError
e
            Right (a
x, Text
remaining) -> b -> Message -> Text -> m ()
forall (m :: * -> *) h.
CommandHandlerType m h =>
h -> Message -> Text -> m ()
applyArgs (a -> b
handler a
x) Message
msg Text
remaining

{- | For applying the message that invoked this command.
It overlaps @a -> b@, but it is more specific, so use OVERLAPPING to make GHC
prefer this one.
-}
instance {-# OVERLAPPING #-} (MonadThrow m, CommandHandlerType m b) => CommandHandlerType m (Message -> b) where
    applyArgs :: (Message -> b) -> Message -> Text -> m ()
applyArgs Message -> b
handler Message
msg Text
input = b -> Message -> Text -> m ()
forall (m :: * -> *) h.
CommandHandlerType m h =>
h -> Message -> Text -> m ()
applyArgs (Message -> b
handler Message
msg) Message
msg Text
input

{- | For the case where there is only one argument to apply.

@SomeType -> m ()@ would match both @m ()@ (since -> is a monad), and @a -> b@,
and neither are more specific, so introduce a more specific choice.
-}
instance {-# OVERLAPPING #-} (MonadThrow m, ParsableArgument a) => CommandHandlerType m (a -> m ()) where
    applyArgs :: (a -> m ()) -> Message -> Text -> m ()
applyArgs a -> m ()
handler Message
msg Text
input = do
        let p :: ParsecT Text () Identity (a, Text)
p = (,) (a -> Text -> (a, Text))
-> ParsecT Text () Identity a
-> ParsecT Text () Identity (Text -> (a, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text () Identity a
forall a. ParsableArgument a => Parser a
parserForArg ParsecT Text () Identity a
-> ParsecT Text () Identity () -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
endOrSpaces) ParsecT Text () Identity (Text -> (a, Text))
-> Parsec Text () Text -> ParsecT Text () Identity (a, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Text () Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
        case ParsecT Text () Identity (a, Text)
-> SourceName -> Text -> Either ParseError (a, Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse ParsecT Text () Identity (a, Text)
p SourceName
"arguments" Text
input of
            Left ParseError
e -> CommandError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CommandError -> m ()) -> CommandError -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> CommandError
ArgumentParseError (Text -> CommandError) -> Text -> CommandError
forall a b. (a -> b) -> a -> b
$
                Text
"Error while parsing argument. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParseError -> Text
showErrAsText ParseError
e
            Right (a
x, Text
remaining) -> m () -> Message -> Text -> m ()
forall (m :: * -> *) h.
CommandHandlerType m h =>
h -> Message -> Text -> m ()
applyArgs (a -> m ()
handler a
x) Message
msg Text
remaining

{- | And its corresponding Message-specific one. Otherwise Message -> m () would
match both @a -> m ()@ and @Message -> b@, neither are more specific.
-}
instance {-# OVERLAPPING #-} (MonadThrow m) => CommandHandlerType m (Message -> m ()) where
    applyArgs :: (Message -> m ()) -> Message -> Text -> m ()
applyArgs Message -> m ()
handler Message
msg Text
input = m () -> Message -> Text -> m ()
forall (m :: * -> *) h.
CommandHandlerType m h =>
h -> Message -> Text -> m ()
applyArgs (Message -> m ()
handler Message
msg) Message
msg Text
input

{- The default 'Show' instance for ParseError contains the error position,
which only adds clutter in a Discord message. This defines a much
simpler string representation.
-}
showErrAsText :: ParseError -> T.Text
showErrAsText :: ParseError -> Text
showErrAsText ParseError
err = Text -> Text
T.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
T.pack (SourceName -> Text) -> SourceName -> Text
forall a b. (a -> b) -> a -> b
$ SourceName
-> SourceName
-> SourceName
-> SourceName
-> SourceName
-> [Message]
-> SourceName
showErrorMessages SourceName
"or" SourceName
"unknown parse error"
    SourceName
"Expecting" SourceName
"Unexpected" SourceName
"end of message" (ParseError -> [Message]
errorMessages ParseError
err)

{- $commonerrors

| Here are some common errors that can occur when defining commands.
They may appear cryptic, but they are most of the time dealable.

@
Could not deduce (ParsableArgument p0) arising from the use of \'command'.
The type variable 'p0' is ambiguous.
@

    * The type for one of the arguments to your handler function cannot
    be inferred. Make sure you use the argument, otherwise, just remove it.

@
Could not deduce (ParsableArgument SomeType) arising from the use of
\'command'.
@

    * The type could be inferred as SomeType, but it's not an instance
    of ParsableArgument. Contribute your own parser in @Command/Parser.hs@.

@
Could not deduce (MonadIO m) arising from the use of \'liftIO'.
@

    * Your handler requires IO actions, but you haven't given the
    appropriate constraint. Add @(MonadIO m)@.
    * Rationale: This happens because some handlers are pure and don't need IO -
    it's better to explicitly signify which actions you're going to use
    in the constraints than to add a catch-all constraint into the
    definition of @MonadDiscord@.
 
If an error is super duper cryptic, it may be a bug in the Commands 
module itself, in which case we may need a rewrite.
-}