-- | 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.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 qualified Data.Text as S
import qualified Data.Text.Lazy as L

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

groupPath :: Group m c a -> [S.Text]
groupPath :: Group m c a -> [Text]
groupPath Group{NonEmpty Text
$sel:names:Group :: forall (m :: * -> *) c a. Group m c a -> NonEmpty Text
names :: NonEmpty Text
names, Maybe (Group m c a)
$sel:parent:Group :: forall (m :: * -> *) c a. Group m c a -> Maybe (Group m c a)
parent :: Maybe (Group m c a)
parent} = (Group m c a -> [Text]) -> Maybe (Group m c a) -> [Text]
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 :: Command m c a -> [Text]
commandPath Command{NonEmpty Text
$sel:names:Command :: forall (m :: * -> *) c a. Command m c a -> NonEmpty Text
names :: NonEmpty Text
names, Maybe (Group m c a)
$sel:parent:Command :: forall (m :: * -> *) c a. Command m c a -> Maybe (Group m c a)
parent :: Maybe (Group m c a)
parent} = (Group m c a -> [Text]) -> Maybe (Group m c a) -> [Text]
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 -> L.Text
commandParams :: Command m c a -> Text
commandParams Command{[ParameterInfo]
$sel:params:Command :: forall (m :: * -> *) c a. Command m c a -> [ParameterInfo]
params :: [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
L.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ 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 -> L.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' :: 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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 (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 -> L.Text) ->
  -- | The callback foor this command
  (c -> CommandForParsers ps r a) ->
  P.Sem r (Command m c a)
buildCommand :: 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)) -> Sem (Fail : r) a
cb) = (c -> CommandForParsers ps r a)
-> (c -> Sem r (Either CommandError (ParserResult (ListToTup ps))),
    (c, ParserResult (ListToTup ps)) -> Sem (Fail : r) a)
forall (ps :: [*]) c (m :: * -> *) a p (r :: [(* -> *) -> * -> *]).
(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)) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
forall c (m :: * -> *) a p (r :: [(* -> *) -> * -> *]).
(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 (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)) -> Sem (Fail : 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 :: 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 :: [(* -> *) -> * -> *]) 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 (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 L.Text a))
buildCallback :: ((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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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
L.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 (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 :: 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)
$sel:parser:Command :: ()
parser :: c -> m (Either CommandError p)
parser, (c, p) -> m (Either Text a)
$sel:callback:Command :: ()
callback :: (c, p) -> m (Either Text a)
callback} =
  m (Either CommandError p) -> Sem r (Either CommandError p)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) 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 (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 (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 :: [(* -> *) -> * -> *]) 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 :: c -> Command m c a -> Sem r (Either CommandError a)
invokeCommand c
ctx cmd :: Command m c a
cmd@Command{[Check m c]
$sel:checks:Command :: forall (m :: * -> *) c a. Command m c a -> [Check m c]
checks :: [Check m c]
checks} = Sem (Error CommandError : r) a -> Sem r (Either CommandError a)
forall e (r :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 :: [(* -> *) -> * -> *]) 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 :: (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 = c
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
forall (ps :: [*]) c (r :: [(* -> *) -> * -> *]).
ParameterParser (ListToTup ps) c r =>
c
-> Text
-> Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser @ps c
ctx (c -> Text
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 = ParameterParser x c r => ParameterInfo
forall a c (r :: [(* -> *) -> * -> *]).
ParameterParser a c r =>
ParameterInfo
parameterInfo @x @c @r ParameterInfo -> [ParameterInfo] -> [ParameterInfo]
forall a. a -> [a] -> [a]
: ParameterInfoForParsers xs 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 ->
  L.Text ->
  P.Sem r (Either CommandError (ParserResult (ListToTup ps)))
buildTypedCommandParser :: 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 :: [(* -> *) -> * -> *]) a.
c
-> Text -> Sem (ParserEffs c r) a -> Sem r (Either (Text, Text) a)
runCommandParser c
ctx Text
t (ParameterParser (ListToTup ps) c r =>
Sem (ParserEffs c r) (ParserResult (ListToTup ps))
forall a c (r :: [(* -> *) -> * -> *]).
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' [ 'L.Text', 'Int', 'CalamityCommands.Parser.Named' "something" 'L.Text' ] r a ~
   ('L.Text' -> 'Int' -> 'L.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