-- | Command utilities
module Calamity.Commands.CommandUtils
    ( TypedCommandC
    , CommandForParsers
    , buildCommand
    , buildCommand'
    , buildParser
    , buildCallback
    , runCommand
    , invokeCommand
    , groupPath
    , commandPath
    , commandParams ) where

import           Calamity.Commands.Check
import           Calamity.Commands.Command
import           Calamity.Commands.Context
import           Calamity.Commands.Error
import           Calamity.Commands.Group
import           Calamity.Commands.Parser
import           Calamity.Internal.RunIntoIO
import           Calamity.Internal.Utils

import           Control.Lens                hiding ( (<.>), Context )
import           Control.Monad

import           Data.Foldable
import           Data.Kind
import           Data.List.NonEmpty          ( NonEmpty(..) )
import qualified Data.List.NonEmpty          as NE
import           Data.Maybe
import           Data.Text                   as S
import           Data.Text.Lazy              as L

import qualified Polysemy                    as P
import qualified Polysemy.Error              as P
import qualified Polysemy.Fail               as P

groupPath :: Group -> [S.Text]
groupPath :: Group -> [Text]
groupPath Group { NonEmpty Text
$sel:names:Group :: Group -> NonEmpty Text
names :: NonEmpty Text
names, Maybe Group
$sel:parent:Group :: Group -> Maybe Group
parent :: Maybe Group
parent } = [Text] -> (Group -> [Text]) -> Maybe Group -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Group -> [Text]
groupPath Maybe Group
parent [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names]

commandPath :: Command -> [S.Text]
commandPath :: Command -> [Text]
commandPath Command { NonEmpty Text
$sel:names:Command :: Command -> NonEmpty Text
names :: NonEmpty Text
names, Maybe Group
$sel:parent:Command :: Command -> Maybe Group
parent :: Maybe Group
parent } = [Text] -> (Group -> [Text]) -> Maybe Group -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Group -> [Text]
groupPath Maybe Group
parent [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names]

-- | Format a command's parameters
commandParams :: Command -> L.Text
commandParams :: Command -> Text
commandParams Command { [Text]
$sel:params:Command :: Command -> [Text]
params :: [Text]
params } = Text -> Text
L.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
S.intercalate Text
", " [Text]
params

-- | Given the properties of a 'Command' with the @parser@ and @callback@ in the
-- 'P.Sem' monad, build a command by transforming the Polysemy actions into IO
-- actions.
buildCommand' :: P.Member (P.Final IO) r
              => NonEmpty S.Text
              -- ^ The name (and aliases) of the command
              -> Maybe Group
              -- ^ The parent group of the command
              -> Bool
              -- ^ If the command is hidden
              -> [Check]
              -- ^ The checks for the command
              -> [S.Text]
              -- ^ The names of the command's parameters
              -> (Context -> L.Text)
              -- ^ The help generator for this command
              -> (Context -> P.Sem r (Either CommandError a))
              -- ^ The parser for this command
              -> ((Context, a) -> P.Sem (P.Fail ': r) ())
              -- ^ The callback for this command
              -> P.Sem r Command
buildCommand' :: NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> Sem r (Either CommandError a))
-> ((Context, a) -> Sem (Fail : r) ())
-> Sem r Command
buildCommand' names :: NonEmpty Text
names@(Text
name :| [Text]
_) Maybe Group
parent Bool
hidden [Check]
checks [Text]
params Context -> Text
help Context -> Sem r (Either CommandError a)
parser (Context, a) -> Sem (Fail : r) ()
cb = do
  (Context, a) -> IO (Maybe Text)
cb' <- ((Context, a) -> Sem (Fail : r) ())
-> Sem r ((Context, a) -> IO (Maybe Text))
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
((Context, a) -> Sem (Fail : r) ())
-> Sem r ((Context, a) -> IO (Maybe Text))
buildCallback (Context, a) -> Sem (Fail : r) ()
cb
  Context -> IO (Either CommandError a)
parser' <- Text
-> (Context -> Sem r (Either CommandError a))
-> Sem r (Context -> IO (Either CommandError a))
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
Text
-> (Context -> Sem r (Either CommandError a))
-> Sem r (Context -> IO (Either CommandError a))
buildParser Text
name Context -> Sem r (Either CommandError a)
parser
  Command -> Sem r Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command -> Sem r Command) -> Command -> Sem r Command
forall a b. (a -> b) -> a -> b
$ NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> IO (Either CommandError a))
-> ((Context, a) -> IO (Maybe Text))
-> Command
forall a.
NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> IO (Either CommandError a))
-> ((Context, a) -> IO (Maybe Text))
-> Command
Command NonEmpty Text
names Maybe Group
parent Bool
hidden [Check]
checks [Text]
params Context -> Text
help Context -> IO (Either CommandError a)
parser' (Context, a) -> IO (Maybe Text)
cb'

-- | Given the properties of a 'Command', a callback, and a type level list of
-- the parameters, build a command by constructing a parser and wiring it up to
-- the callback.
--
-- ==== Examples
--
-- Building a command that bans a user by id.
--
-- @
-- 'buildCommand' @\'['Named' "user" ('Snowflake' 'User'), 'Named' "reason" ('KleeneStarConcat' 'S.Text')]
--    "ban" 'Nothing' [] ('const' "Ban a user") $ \\ctx uid r -> case (ctx 'Control.Lens.^.' #guild) of
--      'Just' guild -> do
--        'Control.Monad.void' . 'Calamity.HTTP.invoke' $ 'Calamity.HTTP.Guild.CreateGuildBan' guild uid ('Calamity.HTTP.Guild.CreateGuildBanData' 'Nothing' $ 'Just' r)
--        'Control.Monad.void' $ 'Calamity.Types.Tellable.tell' ctx ("Banned user `" '<>' 'TextShow.showt' uid '<>' "` with reason: " '<>' r)
--      'Nothing' -> 'void' $ 'Calamity.Types.Tellable.tell' @'L.Text' ctx "Can only ban users from guilds."
-- @
buildCommand :: forall ps r.
             (P.Member (P.Final IO) r, TypedCommandC ps r)
             => NonEmpty S.Text
             -- ^ The name (and aliases) of the command
             -> Maybe Group
             -- ^ The parent group of the command
             -> Bool
             -- ^ If the command is hidden
             -> [Check]
             -- ^ The checks for the command
             -> (Context -> L.Text)
             -- ^ The help generator for this command
             -> (Context -> CommandForParsers ps r)
             -- ^ The callback foor this command
             -> P.Sem r Command
buildCommand :: NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
buildCommand NonEmpty Text
names Maybe Group
parent Bool
hidden [Check]
checks Context -> Text
help Context -> CommandForParsers ps r
command =
  let (Context
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser, (Context, ParserResult (ListToTup ps)) -> Sem (Fail : r) ()
cb) = (Context -> CommandForParsers ps r)
-> (Context
    -> Sem r (Either CommandError (ParserResult (ListToTup ps))),
    (Context, ParserResult (ListToTup ps)) -> Sem (Fail : r) ())
forall (ps :: [*]) a (r :: [(* -> *) -> * -> *]).
(TypedCommandC ps r, a ~ ParserResult (ListToTup ps)) =>
(Context -> CommandForParsers ps r)
-> (Context -> Sem r (Either CommandError a),
    (Context, a) -> Sem (Fail : r) ())
buildTypedCommand @ps Context -> CommandForParsers ps r
command
  in NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context
    -> Sem r (Either CommandError (ParserResult (ListToTup ps))))
-> ((Context, ParserResult (ListToTup ps)) -> Sem (Fail : r) ())
-> Sem r Command
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
NonEmpty Text
-> Maybe Group
-> Bool
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> Sem r (Either CommandError a))
-> ((Context, a) -> Sem (Fail : r) ())
-> Sem r Command
buildCommand' NonEmpty Text
names Maybe Group
parent Bool
hidden [Check]
checks (ParamNamesForParsers ps r => [Text]
forall k (ps :: [*]) (r :: k). ParamNamesForParsers ps r => [Text]
paramNames @ps @r) Context -> Text
help Context
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser (Context, ParserResult (ListToTup ps)) -> Sem (Fail : r) ()
cb

-- | Given the name of the command the parser is for and a parser function in
-- the 'P.Sem' monad, build a parser by transforming the Polysemy action into an
-- IO action.
buildParser :: P.Member (P.Final IO) r
            => S.Text
            -> (Context -> P.Sem r (Either CommandError a))
            -> P.Sem r (Context -> IO (Either CommandError a))
buildParser :: Text
-> (Context -> Sem r (Either CommandError a))
-> Sem r (Context -> IO (Either CommandError a))
buildParser Text
name Context -> Sem r (Either CommandError a)
cb = do
  Context -> IO (Maybe (Either CommandError a))
cb' <- (Context -> Sem r (Either CommandError a))
-> Sem r (Context -> IO (Maybe (Either CommandError a)))
forall (r :: [(* -> *) -> * -> *]) p a.
Member (Final IO) r =>
(p -> Sem r a) -> Sem r (p -> IO (Maybe a))
bindSemToIO Context -> Sem r (Either CommandError a)
cb
  let cb'' :: Context -> IO (Either CommandError a)
cb'' Context
ctx = Either CommandError a
-> Maybe (Either CommandError a) -> Either CommandError a
forall a. a -> Maybe a -> a
fromMaybe (CommandError -> Either CommandError a
forall a b. a -> Either a b
Left (CommandError -> Either CommandError a)
-> CommandError -> Either CommandError a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CommandError
ParseError (Text
"Parser for command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) Text
"failed internally") (Maybe (Either CommandError a) -> Either CommandError a)
-> IO (Maybe (Either CommandError a)) -> IO (Either CommandError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> IO (Maybe (Either CommandError a))
cb' Context
ctx
  (Context -> IO (Either CommandError a))
-> Sem r (Context -> IO (Either CommandError a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context -> IO (Either CommandError a)
cb''

-- | Given a callback for a command in the 'P.Sem' monad, build a command callback by
-- transforming the Polysemy action into an IO action.
buildCallback
  :: P.Member (P.Final IO) r => ((Context, a) -> P.Sem (P.Fail ': r) ()) -> P.Sem r ((Context, a) -> IO (Maybe L.Text))
buildCallback :: ((Context, a) -> Sem (Fail : r) ())
-> Sem r ((Context, a) -> IO (Maybe Text))
buildCallback (Context, a) -> Sem (Fail : r) ()
cb = do
  (Context, a) -> IO (Maybe (Maybe Text))
cb' <- ((Context, a) -> Sem r (Maybe Text))
-> Sem r ((Context, a) -> IO (Maybe (Maybe Text)))
forall (r :: [(* -> *) -> * -> *]) p a.
Member (Final IO) r =>
(p -> Sem r a) -> Sem r (p -> IO (Maybe a))
bindSemToIO (\(Context, a)
x -> Sem (Fail : r) () -> Sem r (Either String ())
forall (r :: [(* -> *) -> * -> *]) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail ((Context, a) -> Sem (Fail : r) ()
cb (Context, a)
x) Sem r (Either String ())
-> (Either String () -> Maybe Text) -> Sem r (Maybe Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                        Left String
e  -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
L.pack String
e
                        Right ()
_ -> Maybe Text
forall a. Maybe a
Nothing)
  let cb'' :: (Context, a) -> IO (Maybe Text)
cb'' = Maybe Text -> Maybe (Maybe Text) -> Maybe Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"failed internally") (Maybe (Maybe Text) -> Maybe Text)
-> ((Context, a) -> IO (Maybe (Maybe Text)))
-> (Context, a)
-> IO (Maybe Text)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<.> (Context, a) -> IO (Maybe (Maybe Text))
cb'
  ((Context, a) -> IO (Maybe Text))
-> Sem r ((Context, a) -> IO (Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context, a) -> IO (Maybe Text)
cb''

-- | Given an invokation 'Context', run a command. This does not perform the command's checks.
runCommand :: P.Member (P.Embed IO) r => Context -> Command -> P.Sem r (Either CommandError ())
runCommand :: Context -> Command -> Sem r (Either CommandError ())
runCommand Context
ctx Command { $sel:names:Command :: Command -> NonEmpty Text
names = Text
name :| [Text]
_, Context -> IO (Either CommandError a)
$sel:parser:Command :: ()
parser :: Context -> IO (Either CommandError a)
parser, (Context, a) -> IO (Maybe Text)
$sel:callback:Command :: ()
callback :: (Context, a) -> IO (Maybe Text)
callback } = IO (Either CommandError a) -> Sem r (Either CommandError a)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (Context -> IO (Either CommandError a)
parser Context
ctx) Sem r (Either CommandError a)
-> (Either CommandError a -> Sem r (Either CommandError ()))
-> Sem r (Either CommandError ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left CommandError
e   -> Either CommandError () -> Sem r (Either CommandError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CommandError () -> Sem r (Either CommandError ()))
-> Either CommandError () -> Sem r (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ CommandError -> Either CommandError ()
forall a b. a -> Either a b
Left CommandError
e
  Right a
p' -> IO (Maybe Text) -> Sem r (Maybe Text)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed ((Context, a) -> IO (Maybe Text)
callback (Context
ctx, a
p')) Sem r (Maybe Text)
-> (Maybe Text -> Either CommandError ())
-> Sem r (Either CommandError ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe CommandError -> Either CommandError ()
forall e. Maybe e -> Either e ()
justToEither (Maybe CommandError -> Either CommandError ())
-> (Maybe Text -> Maybe CommandError)
-> Maybe Text
-> Either CommandError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> CommandError
InvokeError Text
name (Text -> CommandError) -> Maybe Text -> Maybe CommandError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Given an invokation 'Context', first run all of the command's checks, then
-- run the command if they all pass.
invokeCommand :: P.Member (P.Embed IO) r => Context -> Command -> P.Sem r (Either CommandError ())
invokeCommand :: Context -> Command -> Sem r (Either CommandError ())
invokeCommand Context
ctx cmd :: Command
cmd@Command { [Check]
$sel:checks:Command :: Command -> [Check]
checks :: [Check]
checks } = Sem (Error CommandError : r) () -> Sem r (Either CommandError ())
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error CommandError : r) () -> Sem r (Either CommandError ()))
-> Sem (Error CommandError : r) ()
-> Sem r (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ do
  [Check]
-> (Check -> Sem (Error CommandError : r) ())
-> Sem (Error CommandError : r) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Check]
checks (Either CommandError () -> Sem (Error CommandError : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either CommandError () -> Sem (Error CommandError : r) ())
-> (Check -> Sem (Error CommandError : r) (Either CommandError ()))
-> Check
-> Sem (Error CommandError : r) ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Context
-> Check -> Sem (Error CommandError : r) (Either CommandError ())
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Context -> Check -> Sem r (Either CommandError ())
runCheck Context
ctx)
  Either CommandError () -> Sem (Error CommandError : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either CommandError () -> Sem (Error CommandError : r) ())
-> Sem (Error CommandError : r) (Either CommandError ())
-> Sem (Error CommandError : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
-> Command -> Sem (Error CommandError : r) (Either CommandError ())
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Context -> Command -> Sem r (Either CommandError ())
runCommand Context
ctx Command
cmd

type CommandSemType r = P.Sem (P.Fail ': r) ()

-- | Some constraints used for making parameter typed commands work
type TypedCommandC ps r =
  ( ApplyTupRes (ParserResult (ListToTup ps)) (CommandSemType r) ~ CommandForParsers ps r
  , Parser (ListToTup ps) r
  , ApplyTup (ParserResult (ListToTup ps)) (CommandSemType r)
  , ParamNamesForParsers ps r
  )

buildTypedCommand
  :: forall (ps :: [Type]) a r.
  (TypedCommandC ps r, a ~ ParserResult (ListToTup ps))
  => (Context -> CommandForParsers ps r)
  -> ( Context
         -> P.Sem r (Either CommandError a)
     , (Context, a)
         -> P.Sem (P.Fail ': r) ())
buildTypedCommand :: (Context -> CommandForParsers ps r)
-> (Context -> Sem r (Either CommandError a),
    (Context, a) -> Sem (Fail : r) ())
buildTypedCommand Context -> CommandForParsers ps r
cmd = let parser :: Context
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser Context
ctx = Context
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
forall (ps :: [*]) (r :: [(* -> *) -> * -> *]).
Parser (ListToTup ps) r =>
Context
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser @ps Context
ctx (Context
ctx Context -> Getting Text Context Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "unparsedParams" (Getting Text Context Text)
Getting Text Context Text
#unparsedParams)
                            consumer :: (Context, a) -> Sem (Fail : r) ()
consumer (Context
ctx, a
r) = ApplyTupRes a (Sem (Fail : r) ()) -> a -> Sem (Fail : r) ()
forall a b. ApplyTup a b => ApplyTupRes a b -> a -> b
applyTup (Context -> CommandForParsers ps r
cmd Context
ctx) a
r
                        in (Context -> Sem r (Either CommandError a)
Context
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser, (Context, a) -> Sem (Fail : r) ()
consumer)

class ParamNamesForParsers (ps :: [Type]) r where
  paramNames :: [S.Text]

instance ParamNamesForParsers '[] r where
  paramNames :: [Text]
paramNames = []

instance (Parser x r, ParamNamesForParsers xs r) => ParamNamesForParsers (x : xs) r where
  paramNames :: [Text]
paramNames = (Parser x r => Text
forall a (r :: [(* -> *) -> * -> *]). Parser a r => Text
parserName @x @r Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ParamNamesForParsers xs r => [Text]
forall k (ps :: [*]) (r :: k). ParamNamesForParsers ps r => [Text]
paramNames @xs @r)

class ApplyTup a b where
  type ApplyTupRes a b

  applyTup :: ApplyTupRes a b -> a -> b

instance ApplyTup as b => ApplyTup (a, as) b where
  type ApplyTupRes (a, as) b = a -> ApplyTupRes as b

  applyTup :: ApplyTupRes (a, as) b -> (a, as) -> b
applyTup ApplyTupRes (a, as) b
f (a
a, as
as) = ApplyTupRes as b -> as -> b
forall a b. ApplyTup a b => ApplyTupRes a b -> a -> b
applyTup (ApplyTupRes (a, as) b
a -> ApplyTupRes as b
f a
a) as
as

instance ApplyTup () b where
  type ApplyTupRes () b = b

  applyTup :: ApplyTupRes () b -> () -> b
applyTup ApplyTupRes () b
r () = b
ApplyTupRes () b
r

buildTypedCommandParser :: forall (ps :: [Type]) r. Parser (ListToTup ps) r => Context -> L.Text -> P.Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser :: Context
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser Context
ctx Text
t = (Context
-> Text
-> Sem (ParserEffs r) (ParserResult (ListToTup ps))
-> Sem r (Either (Text, Text) (ParserResult (ListToTup ps)))
forall (r :: [(* -> *) -> * -> *]) a.
Context
-> Text -> Sem (ParserEffs r) a -> Sem r (Either (Text, Text) a)
runCommandParser Context
ctx Text
t (Sem (ParserEffs r) (ParserResult (ListToTup ps))
 -> Sem r (Either (Text, Text) (ParserResult (ListToTup ps))))
-> Sem (ParserEffs r) (ParserResult (ListToTup ps))
-> Sem r (Either (Text, Text) (ParserResult (ListToTup ps)))
forall a b. (a -> b) -> a -> b
$ Parser (ListToTup ps) r =>
Sem (ParserEffs r) (ParserResult (ListToTup ps))
forall a (r :: [(* -> *) -> * -> *]).
Parser a r =>
Sem (ParserEffs r) (ParserResult a)
parse @(ListToTup ps) @r) Sem r (Either (Text, Text) (ParserResult (ListToTup ps)))
-> (Either (Text, Text) (ParserResult (ListToTup ps))
    -> Either CommandError (ParserResult (ListToTup ps)))
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  Right ParserResult (ListToTup ps)
r -> ParserResult (ListToTup ps)
-> Either CommandError (ParserResult (ListToTup ps))
forall a b. b -> Either a b
Right ParserResult (ListToTup ps)
r
  Left (Text
n, Text
e)  -> CommandError -> Either CommandError (ParserResult (ListToTup ps))
forall a b. a -> Either a b
Left (CommandError -> Either CommandError (ParserResult (ListToTup ps)))
-> CommandError
-> Either CommandError (ParserResult (ListToTup ps))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> CommandError
ParseError Text
n Text
e

type family ListToTup (ps :: [Type]) where
  ListToTup '[] = ()
  ListToTup (x ': xs) = (x, ListToTup xs)

-- | Transform a type level list of types implementing the 'Parser' typeclass into
-- the type a command callback matching those parameters should be.
--
-- As an example:
--
-- @
-- 'CommandForParsers' [ 'L.Text', 'Calamity.Types.Snowflake' 'Calamity.Types.User', 'Calamity.Commands.Parser.Named' "something" 'L.Text' ] r ~
--   ('L.Text' -> 'Calamity.Types.Snowflake' 'Calamity.Types.User' -> 'L.Text' -> 'P.Sem' r ('P.Fail' ': r) ())
-- @
type family CommandForParsers (ps :: [Type]) r where
  CommandForParsers '[] r = P.Sem (P.Fail ': r) ()
  CommandForParsers (x ': xs) r = ParserResult x -> CommandForParsers xs r