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

import CalamityCommands.Check
import CalamityCommands.Command
import CalamityCommands.Context
import CalamityCommands.Error
import CalamityCommands.Group
import CalamityCommands.Internal.RunIntoM
import CalamityCommands.Internal.Utils
import CalamityCommands.ParameterInfo
import CalamityCommands.Parser
import Control.Monad
import Data.Foldable
import Data.Kind
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe
import Data.Text qualified as S
import Optics
import Polysemy qualified as P
import Polysemy.Error qualified as P
import Polysemy.Fail qualified as P

groupPath :: Group m c a -> [S.Text]
groupPath :: forall (m :: * -> *) c a. Group m c a -> [Text]
groupPath Group {NonEmpty Text
names :: NonEmpty Text
$sel:names:Group :: forall (m :: * -> *) c a. Group m c a -> NonEmpty Text
names, Maybe (Group m c a)
parent :: Maybe (Group m c a)
$sel:parent:Group :: forall (m :: * -> *) c a. Group m c a -> Maybe (Group m c a)
parent} = (Group m c a -> [Text]) -> Maybe (Group m c a) -> [Text]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Group m c a -> [Text]
forall (m :: * -> *) c a. Group m c a -> [Text]
groupPath Maybe (Group m c a)
parent [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names]

commandPath :: Command m c a -> [S.Text]
commandPath :: forall (m :: * -> *) c a. Command m c a -> [Text]
commandPath Command {NonEmpty Text
names :: NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names, Maybe (Group m c a)
parent :: Maybe (Group m c a)
$sel:parent:Command :: forall (m :: * -> *) c a. Command m c a -> Maybe (Group m c a)
parent} = (Group m c a -> [Text]) -> Maybe (Group m c a) -> [Text]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Group m c a -> [Text]
forall (m :: * -> *) c a. Group m c a -> [Text]
groupPath Maybe (Group m c a)
parent [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [NonEmpty Text -> Text
forall a. NonEmpty a -> a
NE.head NonEmpty Text
names]

-- | Format a command's parameters
commandParams :: Command m c a -> S.Text
commandParams :: forall (m :: * -> *) c a. Command m c a -> Text
commandParams Command {[ParameterInfo]
params :: [ParameterInfo]
$sel:params:Command :: forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params} =
  let formatted :: [Text]
formatted =
        (ParameterInfo -> Text) -> [ParameterInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \(ParameterInfo (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" -> Text
name) TypeRep
type_ Text
_) ->
              Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
S.pack (TypeRep -> String
forall a. Show a => a -> String
show TypeRep
type_) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
          )
          [ParameterInfo]
params
   in Text -> [Text] -> Text
S.intercalate Text
", " [Text]
formatted

{- | 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 @m@
 actions.
-}
buildCommand' ::
  forall c m a p r.
  (Monad m, P.Member (P.Final m) r) =>
  -- | The name (and aliases) of the command
  NonEmpty S.Text ->
  -- | The parent group of the command
  Maybe (Group m c a) ->
  -- | If the command is hidden
  Bool ->
  -- | The checks for the command
  [Check m c] ->
  -- | The command's parameter metadata
  [ParameterInfo] ->
  -- | The help generator for this command
  (c -> S.Text) ->
  -- | The parser for this command
  (c -> P.Sem r (Either CommandError p)) ->
  -- | The callback for this command
  ((c, p) -> P.Sem (P.Fail ': r) a) ->
  P.Sem r (Command m c a)
buildCommand' :: forall c (m :: * -> *) a p (r :: EffectRow).
(Monad m, Member (Final m) r) =>
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> [ParameterInfo]
-> (c -> Text)
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
buildCommand' names :: NonEmpty Text
names@(Text
name :| [Text]
_) Maybe (Group m c a)
parent Bool
hidden [Check m c]
checks [ParameterInfo]
params c -> Text
help c -> Sem r (Either CommandError p)
parser (c, p) -> Sem (Fail : r) a
cb = do
  (c, p) -> m (Either Text a)
cb' <- ((c, p) -> Sem (Fail : r) a) -> Sem r ((c, p) -> m (Either Text a))
forall (m :: * -> *) (r :: EffectRow) c p a.
(Monad m, Member (Final m) r) =>
((c, p) -> Sem (Fail : r) a) -> Sem r ((c, p) -> m (Either Text a))
buildCallback (c, p) -> Sem (Fail : r) a
cb
  c -> m (Either CommandError p)
parser' <- Text
-> (c -> Sem r (Either CommandError p))
-> Sem r (c -> m (Either CommandError p))
forall (m :: * -> *) (r :: EffectRow) c a.
(Monad m, Member (Final m) r) =>
Text
-> (c -> Sem r (Either CommandError a))
-> Sem r (c -> m (Either CommandError a))
buildParser Text
name c -> Sem r (Either CommandError p)
parser
  Command m c a -> Sem r (Command m c a)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Command m c a -> Sem r (Command m c a))
-> Command m c a -> Sem r (Command m c a)
forall a b. (a -> b) -> a -> b
$ NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> [ParameterInfo]
-> (c -> Text)
-> (c -> m (Either CommandError p))
-> ((c, p) -> m (Either Text a))
-> Command m c a
forall (m :: * -> *) c a p.
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> [ParameterInfo]
-> (c -> Text)
-> (c -> m (Either CommandError p))
-> ((c, p) -> m (Either Text a))
-> Command m c a
Command NonEmpty Text
names Maybe (Group m c a)
parent Bool
hidden [Check m c]
checks [ParameterInfo]
params c -> Text
help c -> m (Either CommandError p)
parser' (c, p) -> m (Either Text a)
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 adds two numbers.

 @
 'buildCommand' \@\'['CalamityCommands.Parser.Named' "a" 'Int', 'CalamityCommands.Parser.Named' "b" 'Int']
    "add" 'Nothing' [] ('const' "Add two integers") $ \\ctx a b ->
      'pure' '$' 'Right' (a '+' b)
 @
-}
buildCommand ::
  forall ps c m a r.
  (Monad m, P.Member (P.Final m) r, TypedCommandC ps c a r, CommandContext m c a) =>
  -- | The name (and aliases) of the command
  NonEmpty S.Text ->
  -- | The parent group of the command
  Maybe (Group m c a) ->
  -- | If the command is hidden
  Bool ->
  -- | The checks for the command
  [Check m c] ->
  -- | The help generator for this command
  (c -> S.Text) ->
  -- | The callback foor this command
  (c -> CommandForParsers ps r a) ->
  P.Sem r (Command m c a)
buildCommand :: forall (ps :: [*]) c (m :: * -> *) a (r :: EffectRow).
(Monad m, Member (Final m) r, TypedCommandC ps c a r,
 CommandContext m c a) =>
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> (c -> Text)
-> (c -> CommandForParsers ps r a)
-> Sem r (Command m c a)
buildCommand NonEmpty Text
names Maybe (Group m c a)
parent Bool
hidden [Check m c]
checks c -> Text
help c -> CommandForParsers ps r a
command =
  let (c -> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser, (c, ParserResult (ListToTup ps)) -> CommandSemType r a
cb) = forall (ps :: [*]) c (m :: * -> *) a p (r :: EffectRow).
(TypedCommandC ps c a r, p ~ ParserResult (ListToTup ps),
 CommandContext m c a) =>
(c -> CommandForParsers ps r a)
-> (c -> Sem r (Either CommandError p), (c, p) -> Sem (Fail : r) a)
buildTypedCommand @ps c -> CommandForParsers ps r a
command
   in NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> [ParameterInfo]
-> (c -> Text)
-> (c -> Sem r (Either CommandError (ParserResult (ListToTup ps))))
-> ((c, ParserResult (ListToTup ps)) -> CommandSemType r a)
-> Sem r (Command m c a)
forall c (m :: * -> *) a p (r :: EffectRow).
(Monad m, Member (Final m) r) =>
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> [ParameterInfo]
-> (c -> Text)
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
buildCommand' NonEmpty Text
names Maybe (Group m c a)
parent Bool
hidden [Check m c]
checks (forall (ps :: [*]) c (r :: EffectRow).
ParameterInfoForParsers ps c r =>
[ParameterInfo]
forall {k} {k} (ps :: [*]) (c :: k) (r :: k).
ParameterInfoForParsers ps c r =>
[ParameterInfo]
parameterInfos @ps @c @r) c -> Text
help c -> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser (c, ParserResult (ListToTup ps)) -> CommandSemType r a
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
 @m@ action.
-}
buildParser ::
  (Monad m, P.Member (P.Final m) r) =>
  S.Text ->
  (c -> P.Sem r (Either CommandError a)) ->
  P.Sem r (c -> m (Either CommandError a))
buildParser :: forall (m :: * -> *) (r :: EffectRow) c a.
(Monad m, Member (Final m) r) =>
Text
-> (c -> Sem r (Either CommandError a))
-> Sem r (c -> m (Either CommandError a))
buildParser Text
name c -> Sem r (Either CommandError a)
cb = do
  c -> m (Maybe (Either CommandError a))
cb' <- (c -> Sem r (Either CommandError a))
-> Sem r (c -> m (Maybe (Either CommandError a)))
forall (m :: * -> *) (r :: EffectRow) p a.
(Monad m, Member (Final m) r) =>
(p -> Sem r a) -> Sem r (p -> m (Maybe a))
bindSemToM c -> Sem r (Either CommandError a)
cb
  let cb'' :: c -> m (Either CommandError a)
cb'' c
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)
-> m (Maybe (Either CommandError a)) -> m (Either CommandError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> m (Maybe (Either CommandError a))
cb' c
ctx
  (c -> m (Either CommandError a))
-> Sem r (c -> m (Either CommandError a))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c -> m (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 @m@ action.
-}
buildCallback ::
  (Monad m, P.Member (P.Final m) r) => ((c, p) -> P.Sem (P.Fail ': r) a) -> P.Sem r ((c, p) -> m (Either S.Text a))
buildCallback :: forall (m :: * -> *) (r :: EffectRow) c p a.
(Monad m, Member (Final m) r) =>
((c, p) -> Sem (Fail : r) a) -> Sem r ((c, p) -> m (Either Text a))
buildCallback (c, p) -> Sem (Fail : r) a
cb = do
  (c, p) -> m (Maybe (Either Text a))
cb' <- ((c, p) -> Sem r (Either Text a))
-> Sem r ((c, p) -> m (Maybe (Either Text a)))
forall (m :: * -> *) (r :: EffectRow) p a.
(Monad m, Member (Final m) r) =>
(p -> Sem r a) -> Sem r (p -> m (Maybe a))
bindSemToM (\(c, p)
x -> Sem (Fail : r) a -> Sem r (Either String a)
forall (r :: EffectRow) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail ((c, p) -> Sem (Fail : r) a
cb (c, p)
x) Sem r (Either String a)
-> (Either String a -> Either Text a) -> Sem r (Either Text a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> Text) -> Either String a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
S.pack)
  let cb'' :: (c, p) -> m (Either Text a)
cb'' = Either Text a -> Maybe (Either Text a) -> Either Text a
forall a. a -> Maybe a -> a
fromMaybe (Text -> Either Text a
forall a b. a -> Either a b
Left Text
"failed internally") (Maybe (Either Text a) -> Either Text a)
-> ((c, p) -> m (Maybe (Either Text a)))
-> (c, p)
-> m (Either Text a)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<.> (c, p) -> m (Maybe (Either Text a))
cb'
  ((c, p) -> m (Either Text a))
-> Sem r ((c, p) -> m (Either Text a))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c, p) -> m (Either Text a)
cb''

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

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

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

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

buildTypedCommand ::
  forall (ps :: [Type]) c m a p r.
  (TypedCommandC ps c a r, p ~ ParserResult (ListToTup ps), CommandContext m c a) =>
  (c -> CommandForParsers ps r a) ->
  ( c -> P.Sem r (Either CommandError p)
  , (c, p) -> P.Sem (P.Fail ': r) a
  )
buildTypedCommand :: forall (ps :: [*]) c (m :: * -> *) a p (r :: EffectRow).
(TypedCommandC ps c a r, p ~ ParserResult (ListToTup ps),
 CommandContext m c a) =>
(c -> CommandForParsers ps r a)
-> (c -> Sem r (Either CommandError p), (c, p) -> Sem (Fail : r) a)
buildTypedCommand c -> CommandForParsers ps r a
cmd =
  let parser :: c -> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser c
ctx = forall (ps :: [*]) c (r :: EffectRow).
ParameterParser (ListToTup ps) c r =>
c
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser @ps c
ctx (forall (m :: * -> *) c a. CommandContext m c a => c -> Text
ctxUnparsedParams @m c
ctx)
      consumer :: (c, p) -> Sem (Fail : r) a
consumer (c
ctx, p
r) = ApplyTupRes p (Sem (Fail : r) a) -> p -> Sem (Fail : r) a
forall a b. ApplyTup a b => ApplyTupRes a b -> a -> b
applyTup (c -> CommandForParsers ps r a
cmd c
ctx) p
r
   in (c -> Sem r (Either CommandError p)
c -> Sem r (Either CommandError (ParserResult (ListToTup ps)))
parser, (c, p) -> Sem (Fail : r) a
consumer)

class ParameterInfoForParsers (ps :: [Type]) c r where
  parameterInfos :: [ParameterInfo]

instance ParameterInfoForParsers '[] c r where
  parameterInfos :: [ParameterInfo]
parameterInfos = []

instance (ParameterParser x c r, ParameterInfoForParsers xs c r) => ParameterInfoForParsers (x : xs) c r where
  parameterInfos :: [ParameterInfo]
parameterInfos = forall a c (r :: EffectRow). ParameterParser a c r => ParameterInfo
parameterInfo @x @c @r ParameterInfo -> [ParameterInfo] -> [ParameterInfo]
forall a. a -> [a] -> [a]
: forall (ps :: [*]) c (r :: EffectRow).
ParameterInfoForParsers ps c r =>
[ParameterInfo]
forall {k} {k} (ps :: [*]) (c :: k) (r :: k).
ParameterInfoForParsers ps c r =>
[ParameterInfo]
parameterInfos @xs @c @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]) c r.
  (ParameterParser (ListToTup ps) c r) =>
  c ->
  S.Text ->
  P.Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser :: forall (ps :: [*]) c (r :: EffectRow).
ParameterParser (ListToTup ps) c r =>
c
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser c
ctx Text
t =
  c
-> Text
-> Sem (ParserEffs c r) (ParserResult (ListToTup ps))
-> Sem r (Either (Text, Text) (ParserResult (ListToTup ps)))
forall c (r :: EffectRow) a.
c
-> Text -> Sem (ParserEffs c r) a -> Sem r (Either (Text, Text) a)
runCommandParser c
ctx Text
t (forall a c (r :: EffectRow).
ParameterParser a c r =>
Sem (ParserEffs c r) (ParserResult a)
parse @(ListToTup ps) @c @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 'ParameterParser' typeclass into
 the type a command callback matching those parameters should be.

 As an example:

 @
 'CommandForParsers' [ 'S.Text', 'Int', 'CalamityCommands.Parser.Named' "something" 'S.Text' ] r a ~
   ('S.Text' -> 'Int' -> 'S.Text' -> 'P.Sem' r ('P.Fail' ': r) a)
 @
-}
type family CommandForParsers (ps :: [Type]) r a where
  CommandForParsers '[] r a = P.Sem (P.Fail ': r) a
  CommandForParsers (x ': xs) r a = ParserResult x -> CommandForParsers xs r a