{-# LANGUAGE RecursiveDo #-}

-- | A DSL for generating commands and groups
module CalamityCommands.Dsl (
    -- * Commands DSL
    -- $dslTutorial
    command,
    command',
    commandA,
    commandA',
    hide,
    help,
    requires,
    requires',
    requiresPure,
    group,
    group',
    groupA,
    groupA',
    DSLState,
    raiseDSL,
    fetchHandler,
) where

import CalamityCommands.AliasType
import CalamityCommands.Check
import CalamityCommands.Command hiding (help)
import CalamityCommands.CommandUtils
import CalamityCommands.Context
import CalamityCommands.Error
import CalamityCommands.Group hiding (help)
import CalamityCommands.Handler
import CalamityCommands.ParameterInfo
import CalamityCommands.Internal.LocalWriter

import qualified Data.HashMap.Lazy as LH
import qualified Data.Text as T

import Data.List.NonEmpty (NonEmpty (..))
import qualified Polysemy as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Fixpoint as P
import qualified Polysemy.Reader as P
import qualified Polysemy.Tagged as P

{- $dslTutorial

 This module provides a way of constructing bot commands in a declarative way.

 The main component of this is the 'command' function, which takes a
 type-level list of command parameters, the name, and the callback and
 produces a command. There are also the alternatives 'command'', 'commandA'
 and 'commandA'', for when you want to handle parsing of the input yourself,
 and/or want aliases of the command.

 The functions: 'hide', 'help', 'requires', and 'group' can be used to change
 attributes of any commands declared inside the monadic action passed to them,
 for example:

 @
 'hide' '$' do
   'command' \@\'[] "test" \\ctx -> 'pure' ()
 @

 In the above block, any command declared inside 'hide' will have its
 \'hidden\' flag set and will not be shown by the default help command:
 'CalamityCommands.Help.helpCommand'

 The 'CalamityCommands.Help.helpCommand' function can be used to create a
 help command for the commands DSL action it is used in, read its doc page
 for more information on how it functions.

 The 'CalamityCommands.Utils.buildCommands' function is used to
 construct a 'CommandHandler' which can then be used with
 'CalamityCommands.Utils.processCommands' or
 'CalamityCommands.Utils.handleCommands' to process a command.
-}

type DSLState m c a r =
    ( LocalWriter (LH.HashMap T.Text (Command m c a, AliasType))
        ': LocalWriter (LH.HashMap T.Text (Group m c a, AliasType))
            ': P.Reader (Maybe (Group m c a))
                ': P.Tagged "hidden" (P.Reader Bool)
                    ': P.Reader (c -> T.Text)
                        ': P.Tagged "original-help" (P.Reader (c -> T.Text))
                            ': P.Reader [Check m c]
                                ': P.Reader (CommandHandler m c a)
                                    ': P.Fixpoint
                                        ': r
    )

raiseDSL :: P.Sem r x -> P.Sem (DSLState m c a r) x
raiseDSL :: Sem r x -> Sem (DSLState m c a r) x
raiseDSL = Sem
  (LocalWriter (HashMap Text (Group m c a, AliasType))
     : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
     : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
     : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
     : r)
  x
-> Sem (DSLState m c a r) x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (LocalWriter (HashMap Text (Group m c a, AliasType))
      : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
      : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   x
 -> Sem (DSLState m c a r) x)
-> (Sem r x
    -> Sem
         (LocalWriter (HashMap Text (Group m c a, AliasType))
            : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
            : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         x)
-> Sem r x
-> Sem (DSLState m c a r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Reader (Maybe (Group m c a))
     : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
     : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
     : Reader (CommandHandler m c a) : Fixpoint : r)
  x
-> Sem
     (LocalWriter (HashMap Text (Group m c a, AliasType))
        : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (Reader (Maybe (Group m c a))
      : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
      : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
      : Reader (CommandHandler m c a) : Fixpoint : r)
   x
 -> Sem
      (LocalWriter (HashMap Text (Group m c a, AliasType))
         : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
         : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      x)
-> (Sem r x
    -> Sem
         (Reader (Maybe (Group m c a))
            : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
            : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
            : Reader (CommandHandler m c a) : Fixpoint : r)
         x)
-> Sem r x
-> Sem
     (LocalWriter (HashMap Text (Group m c a, AliasType))
        : Reader (Maybe (Group m c a)) : Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Tagged "hidden" (Reader Bool)
     : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
     : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
     : r)
  x
-> Sem
     (Reader (Maybe (Group m c a))
        : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (Tagged "hidden" (Reader Bool)
      : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   x
 -> Sem
      (Reader (Maybe (Group m c a))
         : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
         : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
         : Reader (CommandHandler m c a) : Fixpoint : r)
      x)
-> (Sem r x
    -> Sem
         (Tagged "hidden" (Reader Bool)
            : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         x)
-> Sem r x
-> Sem
     (Reader (Maybe (Group m c a))
        : Tagged "hidden" (Reader Bool) : Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Reader (c -> Text)
     : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
     : Reader (CommandHandler m c a) : Fixpoint : r)
  x
-> Sem
     (Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (Reader (c -> Text)
      : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
      : Reader (CommandHandler m c a) : Fixpoint : r)
   x
 -> Sem
      (Tagged "hidden" (Reader Bool)
         : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      x)
-> (Sem r x
    -> Sem
         (Reader (c -> Text)
            : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
            : Reader (CommandHandler m c a) : Fixpoint : r)
         x)
-> Sem r x
-> Sem
     (Tagged "hidden" (Reader Bool)
        : Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Tagged "original-help" (Reader (c -> Text))
     : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
     : r)
  x
-> Sem
     (Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (Tagged "original-help" (Reader (c -> Text))
      : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
      : r)
   x
 -> Sem
      (Reader (c -> Text)
         : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
         : Reader (CommandHandler m c a) : Fixpoint : r)
      x)
-> (Sem r x
    -> Sem
         (Tagged "original-help" (Reader (c -> Text))
            : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
            : r)
         x)
-> Sem r x
-> Sem
     (Reader (c -> Text)
        : Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
        : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
  (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
  x
-> Sem
     (Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
   (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
   x
 -> Sem
      (Tagged "original-help" (Reader (c -> Text))
         : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
         : r)
      x)
-> (Sem r x
    -> Sem
         (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
         x)
-> Sem r x
-> Sem
     (Tagged "original-help" (Reader (c -> Text))
        : Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
        : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Reader (CommandHandler m c a) : Fixpoint : r) x
-> Sem
     (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem (Reader (CommandHandler m c a) : Fixpoint : r) x
 -> Sem
      (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
      x)
-> (Sem r x
    -> Sem (Reader (CommandHandler m c a) : Fixpoint : r) x)
-> Sem r x
-> Sem
     (Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fixpoint : r) x
-> Sem (Reader (CommandHandler m c a) : Fixpoint : r) x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem (Fixpoint : r) x
 -> Sem (Reader (CommandHandler m c a) : Fixpoint : r) x)
-> (Sem r x -> Sem (Fixpoint : r) x)
-> Sem r x
-> Sem (Reader (CommandHandler m c a) : Fixpoint : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r x -> Sem (Fixpoint : r) x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise

{- | Given the command name and parameter names, @parser@ and @callback@ for a
 command in the 'P.Sem' monad, build a command by transforming the Polysemy
 actions into @m@ actions. Then register the command.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.
-}
command' ::
    (Monad m, P.Member (P.Final m) r) =>
    -- | The name of the command
    T.Text ->
    -- | The command's parameter metadata
    [ParameterInfo] ->
    -- | 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 (DSLState m c a r) (Command m c a)
command' :: Text
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
command' Text
name [ParameterInfo]
params c -> Sem r (Either CommandError p)
parser (c, p) -> Sem (Fail : r) a
cb = Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
forall p c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r) =>
Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
commandA' Text
name [] [ParameterInfo]
params c -> Sem r (Either CommandError p)
parser (c, p) -> Sem (Fail : r) a
cb

{- | Given the command name, aliases, and parameter names, @parser@ and @callback@
 for a command in the 'P.Sem' monad, build a command by transforming the
 Polysemy actions into @m@ actions. Then register the command.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.
-}
commandA' ::
    forall p c a m r.
    (Monad m, P.Member (P.Final m) r) =>
    -- | The name of the command
    T.Text ->
    -- | The aliases for the command
    [T.Text] ->
    -- | The command's parameter metadata
    [ParameterInfo] ->
    -- | 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 (DSLState m c a r) (Command m c a)
commandA' :: Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem (DSLState m c a r) (Command m c a)
commandA' Text
name [Text]
aliases [ParameterInfo]
params c -> Sem r (Either CommandError p)
parser (c, p) -> Sem (Fail : r) a
cb = do
    Maybe (Group m c a)
parent <- forall (r :: EffectRow).
Member (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
    Bool
hidden <- Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : DSLState m c a r) Bool
 -> Sem (DSLState m c a r) Bool)
-> Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow). Member (Reader Bool) r => Sem r Bool
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
    [Check m c]
checks <- forall (r :: EffectRow).
Member (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
    c -> Text
help' <- forall (r :: EffectRow).
Member (Reader (c -> Text)) r =>
Sem r (c -> Text)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
    Command m c a
cmd <- Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a)
forall (r :: EffectRow) x (m :: * -> *) c a.
Sem r x -> Sem (DSLState m c a r) x
raiseDSL (Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a))
-> Sem r (Command m c a) -> Sem (DSLState m c a 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 -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : 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' (Text
name Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
aliases) 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
    HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Command m c a, AliasType)
-> HashMap Text (Command m c a, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name (Command m c a
cmd, AliasType
Original)
    HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ [(Text, (Command m c a, AliasType))]
-> HashMap Text (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList [(Text
name, (Command m c a
cmd, AliasType
Alias)) | Text
name <- [Text]
aliases]
    Command m c a -> Sem (DSLState m c a r) (Command m c a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command m c a
cmd

{- | Given the name of a command and a callback, and a type level list of
 the parameters, build and register a command.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.

 Command parameters are parsed by first invoking
 'CalamityCommands.Parser.parse' for the first
 'CalamityCommands.Parser.Parser', then running the next parser on the
 remaining input, and so on.

 ==== Examples

 Building a command that adds two numbers.

 @
 'command' \@\'['CalamityCommands.Parser.Named' "a" 'Int', 'CalamityCommands.Parser.Named' "b" 'Int']
   "add" $ \\ctx a b -> 'pure' '$' 'Right' (a '+' b)
 @
-}
command ::
    forall ps c a m r.
    ( Monad m
    , P.Member (P.Final m) r
    , TypedCommandC ps c a r
    , CommandContext m c a
    ) =>
    -- | The name of the command
    T.Text ->
    -- | The callback for this command
    (c -> CommandForParsers ps r a) ->
    P.Sem (DSLState m c a r) (Command m c a)
command :: Text
-> (c -> CommandForParsers ps r a)
-> Sem (DSLState m c a r) (Command m c a)
command Text
name c -> CommandForParsers ps r a
cmd = Text
-> [Text]
-> (c -> CommandForParsers ps r a)
-> Sem (DSLState m c a r) (Command m c a)
forall (ps :: [*]) c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, TypedCommandC ps c a r,
 CommandContext m c a) =>
Text
-> [Text]
-> (c -> CommandForParsers ps r a)
-> Sem (DSLState m c a r) (Command m c a)
commandA @ps Text
name [] c -> CommandForParsers ps r a
cmd

{- | Given the name and aliases of a command and a callback, and a type level list of
 the parameters, build and register a command.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.

 ==== Examples


 Building a command that adds two numbers.

 @
 'commandA' \@\'['CalamityCommands.Parser.Named' "a" 'Int', 'CalamityCommands.Parser.Named' "b" 'Int']
   "add" [] $ \\ctx a b -> 'pure' '$' 'Right' (a '+' b)
 @
-}
commandA ::
    forall ps c a m r.
    ( Monad m
    , P.Member (P.Final m) r
    , TypedCommandC ps c a r
    , CommandContext m c a
    ) =>
    -- | The name of the command
    T.Text ->
    -- | The aliases for the command
    [T.Text] ->
    -- | The callback for this command
    (c -> CommandForParsers ps r a) ->
    P.Sem (DSLState m c a r) (Command m c a)
commandA :: Text
-> [Text]
-> (c -> CommandForParsers ps r a)
-> Sem (DSLState m c a r) (Command m c a)
commandA Text
name [Text]
aliases c -> CommandForParsers ps r a
cmd = do
    Maybe (Group m c a)
parent <- forall (r :: EffectRow).
Member (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
    Bool
hidden <- Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : DSLState m c a r) Bool
 -> Sem (DSLState m c a r) Bool)
-> Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow). Member (Reader Bool) r => Sem r Bool
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
    [Check m c]
checks <- forall (r :: EffectRow).
Member (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
    c -> Text
help' <- forall (r :: EffectRow).
Member (Reader (c -> Text)) r =>
Sem r (c -> Text)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
    Command m c a
cmd' <- Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a)
forall (r :: EffectRow) x (m :: * -> *) c a.
Sem r x -> Sem (DSLState m c a r) x
raiseDSL (Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a))
-> Sem r (Command m c a) -> Sem (DSLState m c a r) (Command m c a)
forall a b. (a -> b) -> a -> b
$ NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> [Check m c]
-> (c -> Text)
-> (c -> CommandForParsers ps r a)
-> Sem r (Command m c a)
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 @ps (Text
name Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
aliases) Maybe (Group m c a)
parent Bool
hidden [Check m c]
checks c -> Text
help' c -> CommandForParsers ps r a
cmd
    HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Command m c a, AliasType)
-> HashMap Text (Command m c a, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name (Command m c a
cmd', AliasType
Original)
    HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Command m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ [(Text, (Command m c a, AliasType))]
-> HashMap Text (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList [(Text
name, (Command m c a
cmd', AliasType
Alias)) | Text
name <- [Text]
aliases]
    Command m c a -> Sem (DSLState m c a r) (Command m c a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command m c a
cmd'

{- | Set the visibility of any groups or commands registered inside the given
 action to hidden.
-}
hide ::
    P.Member (P.Tagged "hidden" (P.Reader Bool)) r =>
    P.Sem r x ->
    P.Sem r x
hide :: Sem r x -> Sem r x
hide = forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
Member (Tagged "hidden" e) r =>
Sem (e : r) a -> Sem r a
P.tag @"hidden" (Sem (Reader Bool : r) x -> Sem r x)
-> (Sem r x -> Sem (Reader Bool : r) x) -> Sem r x -> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool)
-> Sem (Reader Bool : r) x -> Sem (Reader Bool : r) x
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @Bool (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True) (Sem (Reader Bool : r) x -> Sem (Reader Bool : r) x)
-> (Sem r x -> Sem (Reader Bool : r) x)
-> Sem r x
-> Sem (Reader Bool : r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r x -> Sem (Reader Bool : r) x
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise

{- | Set the help for any groups or commands registered inside the given action.

 ==== Examples

 @
 'help' ('const' "Add two integers") $
   'command' \@\'['CalamityCommands.Parser.Named' "a" 'Int', 'CalamityCommands.Parser.Named' "b" 'Int']
     "add" $ \\ctx a b -> 'pure' '$' 'Right' (a '+' b)
 @
-}
help ::
    P.Member (P.Reader (c -> T.Text)) r =>
    (c -> T.Text) ->
    P.Sem r a ->
    P.Sem r a
help :: (c -> Text) -> Sem r a -> Sem r a
help = ((c -> Text) -> c -> Text) -> Sem r a -> Sem r a
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local (((c -> Text) -> c -> Text) -> Sem r a -> Sem r a)
-> ((c -> Text) -> (c -> Text) -> c -> Text)
-> (c -> Text)
-> Sem r a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Text) -> (c -> Text) -> c -> Text
forall a b. a -> b -> a
const

{- | Add to the list of checks for any commands registered inside the given
 action.
-}
requires ::
    [Check m c] ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
requires :: [Check m c] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
requires = ([Check m c] -> [Check m c])
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local (([Check m c] -> [Check m c])
 -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x)
-> ([Check m c] -> [Check m c] -> [Check m c])
-> [Check m c]
-> Sem (DSLState m c a r) x
-> Sem (DSLState m c a r) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Check m c] -> [Check m c] -> [Check m c]
forall a. Semigroup a => a -> a -> a
(<>)

{- | Construct a check and add it to the list of checks for any commands
 registered inside the given action.

 Refer to 'CalamityCommands.Check.Check' for more info on checks.
-}
requires' ::
    (Monad m, P.Member (P.Final m) r) =>
    -- | The name of the check
    T.Text ->
    -- | The callback for the check
    (c -> P.Sem r (Maybe T.Text)) ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
requires' :: Text
-> (c -> Sem r (Maybe Text))
-> Sem (DSLState m c a r) x
-> Sem (DSLState m c a r) x
requires' Text
name c -> Sem r (Maybe Text)
cb Sem (DSLState m c a r) x
m = do
    Check m c
check <- Sem r (Check m c) -> Sem (DSLState m c a r) (Check m c)
forall (r :: EffectRow) x (m :: * -> *) c a.
Sem r x -> Sem (DSLState m c a r) x
raiseDSL (Sem r (Check m c) -> Sem (DSLState m c a r) (Check m c))
-> Sem r (Check m c) -> Sem (DSLState m c a r) (Check m c)
forall a b. (a -> b) -> a -> b
$ Text -> (c -> Sem r (Maybe Text)) -> Sem r (Check m c)
forall (m :: * -> *) (r :: EffectRow) c.
(Monad m, Member (Final m) r) =>
Text -> (c -> Sem r (Maybe Text)) -> Sem r (Check m c)
buildCheck Text
name c -> Sem r (Maybe Text)
cb
    [Check m c] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall (m :: * -> *) c a (r :: EffectRow) x.
[Check m c] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
requires [Check m c
check] Sem (DSLState m c a r) x
m

{- | Construct some pure checks and add them to the list of checks for any
 commands registered inside the given action.

 Refer to 'CalamityCommands.Check.Check' for more info on checks.

 ==== Examples

 @
 'requiresPure' [("always ok", 'const' 'Nothing')] $
   'command' \@\'['CalamityCommands.Parser.Named' "a" 'Int', 'CalamityCommands.Parser.Named' "b" 'Int']
     "add" $ \\ctx a b -> 'pure' '$' 'Right' (a '+' b)
 @
-}
requiresPure ::
    Monad m =>
    [(T.Text, c -> Maybe T.Text)] ->
    -- A list of check names and check callbacks
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
requiresPure :: [(Text, c -> Maybe Text)]
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
requiresPure [(Text, c -> Maybe Text)]
checks = [Check m c] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall (m :: * -> *) c a (r :: EffectRow) x.
[Check m c] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
requires ([Check m c]
 -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x)
-> [Check m c]
-> Sem (DSLState m c a r) x
-> Sem (DSLState m c a r) x
forall a b. (a -> b) -> a -> b
$ ((Text, c -> Maybe Text) -> Check m c)
-> [(Text, c -> Maybe Text)] -> [Check m c]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> (c -> Maybe Text) -> Check m c)
-> (Text, c -> Maybe Text) -> Check m c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> (c -> Maybe Text) -> Check m c
forall (m :: * -> *) c.
Monad m =>
Text -> (c -> Maybe Text) -> Check m c
buildCheckPure) [(Text, c -> Maybe Text)]
checks

{- | Construct a group and place any commands registered in the given action
 into the new group.

 This also resets the @help@ function back to its original value, use
 'group'' if you don't want that (i.e. your help function is context aware).
-}
group ::
    (Monad m, P.Member (P.Final m) r) =>
    -- | The name of the group
    T.Text ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
group :: Text -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
group Text
name Sem (DSLState m c a r) x
m = Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall x c (m :: * -> *) a (r :: EffectRow).
(Monad m, Member (Final m) r) =>
Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
groupA Text
name [] Sem (DSLState m c a r) x
m

{- | Construct a group with aliases and place any commands registered in the
 given action into the new group.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.

 This also resets the @help@ function back to its original value, use
 'group'' if you don't want that (i.e. your help function is context aware).
-}
groupA ::
    forall x c m a r.
    (Monad m, P.Member (P.Final m) r) =>
    -- | The name of the group
    T.Text ->
    -- | The aliases of the group
    [T.Text] ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
groupA :: Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
groupA Text
name [Text]
aliases Sem (DSLState m c a r) x
m = mdo
    Maybe (Group m c a)
parent <- forall (r :: EffectRow).
Member (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
    Bool
hidden <- Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : DSLState m c a r) Bool
 -> Sem (DSLState m c a r) Bool)
-> Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow). Member (Reader Bool) r => Sem r Bool
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
    [Check m c]
checks <- forall (r :: EffectRow).
Member (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
    c -> Text
help' <- forall (r :: EffectRow).
Member (Reader (c -> Text)) r =>
Sem r (c -> Text)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
    c -> Text
origHelp <- Sem (DSLState m c a r) (c -> Text)
forall c (r :: EffectRow).
Member (Tagged "original-help" (Reader (c -> Text))) r =>
Sem r (c -> Text)
fetchOrigHelp
    let group' :: Group m c a
group' = NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> HashMap Text (Command m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
-> (c -> Text)
-> [Check m c]
-> Group m c a
forall (m :: * -> *) c a.
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> HashMap Text (Command m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
-> (c -> Text)
-> [Check m c]
-> Group m c a
Group (Text
name Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
aliases) Maybe (Group m c a)
parent Bool
hidden HashMap Text (Command m c a, AliasType)
commands HashMap Text (Group m c a, AliasType)
children c -> Text
help' [Check m c]
checks
    (HashMap Text (Group m c a, AliasType)
children, (HashMap Text (Command m c a, AliasType)
commands, x
res)) <-
        forall (r :: EffectRow) a.
Member (LocalWriter (HashMap Text (Group m c a, AliasType))) r =>
Sem r a -> Sem r (HashMap Text (Group m c a, AliasType), a)
forall o (r :: EffectRow) a.
Member (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap T.Text (Group m c a, AliasType)) (Sem
   (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
 -> Sem
      (DSLState m c a r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> Sem
     (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
-> Sem
     (DSLState m c a r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall a b. (a -> b) -> a -> b
$
            forall (r :: EffectRow) a.
Member (LocalWriter (HashMap Text (Command m c a, AliasType))) r =>
Sem r a -> Sem r (HashMap Text (Command m c a, AliasType), a)
forall o (r :: EffectRow) a.
Member (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap T.Text (Command m c a, AliasType)) (Sem (DSLState m c a r) x
 -> Sem
      (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x))
-> Sem (DSLState m c a r) x
-> Sem
     (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
forall a b. (a -> b) -> a -> b
$
                (Maybe (Group m c a) -> Maybe (Group m c a))
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(Maybe (Group m c a)) (Maybe (Group m c a) -> Maybe (Group m c a) -> Maybe (Group m c a)
forall a b. a -> b -> a
const (Maybe (Group m c a) -> Maybe (Group m c a) -> Maybe (Group m c a))
-> Maybe (Group m c a)
-> Maybe (Group m c a)
-> Maybe (Group m c a)
forall a b. (a -> b) -> a -> b
$ Group m c a -> Maybe (Group m c a)
forall a. a -> Maybe a
Just Group m c a
group') (Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x)
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall a b. (a -> b) -> a -> b
$
                    ((c -> Text) -> c -> Text)
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(c -> T.Text) ((c -> Text) -> (c -> Text) -> c -> Text
forall a b. a -> b -> a
const c -> Text
origHelp) Sem (DSLState m c a r) x
m
    HashMap Text (Group m c a, AliasType) -> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Group m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Group m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name (Group m c a
group', AliasType
Original)
    HashMap Text (Group m c a, AliasType) -> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Group m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ [(Text, (Group m c a, AliasType))]
-> HashMap Text (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList [(Text
name, (Group m c a
group', AliasType
Alias)) | Text
name <- [Text]
aliases]
    x -> Sem (DSLState m c a r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
res

fetchOrigHelp :: P.Member (P.Tagged "original-help" (P.Reader (c -> T.Text))) r => P.Sem r (c -> T.Text)
fetchOrigHelp :: Sem r (c -> Text)
fetchOrigHelp = Sem (Reader (c -> Text) : r) (c -> Text) -> Sem r (c -> Text)
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag Sem (Reader (c -> Text) : r) (c -> Text)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask

{- | Construct a group and place any commands registered in the given action
 into the new group.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.

 Unlike 'help' this doesn't reset the @help@ function back to its original
 value.
-}
group' ::
    P.Member (P.Final m) r =>
    -- | The name of the group
    T.Text ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
group' :: Text -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
group' Text
name Sem (DSLState m c a r) x
m = Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall x c (m :: * -> *) a (r :: EffectRow).
Member (Final m) r =>
Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
groupA' Text
name [] Sem (DSLState m c a r) x
m

{- | Construct a group with aliases and place any commands registered in the given action
 into the new group.

 The parent group, visibility, checks, and command help are drawn from the
 reader context.

 Unlike 'help' this doesn't reset the @help@ function back to its original
 value.
-}
groupA' ::
    forall x c m a r.
    P.Member (P.Final m) r =>
    -- | The name of the group
    T.Text ->
    -- | The aliases of the group
    [T.Text] ->
    P.Sem (DSLState m c a r) x ->
    P.Sem (DSLState m c a r) x
groupA' :: Text
-> [Text] -> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
groupA' Text
name [Text]
aliases Sem (DSLState m c a r) x
m = mdo
    Maybe (Group m c a)
parent <- forall (r :: EffectRow).
Member (Reader (Maybe (Group m c a))) r =>
Sem r (Maybe (Group m c a))
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
    Bool
hidden <- Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : DSLState m c a r) Bool
 -> Sem (DSLState m c a r) Bool)
-> Sem (Reader Bool : DSLState m c a r) Bool
-> Sem (DSLState m c a r) Bool
forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow). Member (Reader Bool) r => Sem r Bool
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
    [Check m c]
checks <- forall (r :: EffectRow).
Member (Reader [Check m c]) r =>
Sem r [Check m c]
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
    c -> Text
help' <- forall (r :: EffectRow).
Member (Reader (c -> Text)) r =>
Sem r (c -> Text)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
    let group' :: Group m c a
group' = NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> HashMap Text (Command m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
-> (c -> Text)
-> [Check m c]
-> Group m c a
forall (m :: * -> *) c a.
NonEmpty Text
-> Maybe (Group m c a)
-> Bool
-> HashMap Text (Command m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
-> (c -> Text)
-> [Check m c]
-> Group m c a
Group (Text
name Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
aliases) Maybe (Group m c a)
parent Bool
hidden HashMap Text (Command m c a, AliasType)
commands HashMap Text (Group m c a, AliasType)
children c -> Text
help' [Check m c]
checks
    (HashMap Text (Group m c a, AliasType)
children, (HashMap Text (Command m c a, AliasType)
commands, x
res)) <-
        forall (r :: EffectRow) a.
Member (LocalWriter (HashMap Text (Group m c a, AliasType))) r =>
Sem r a -> Sem r (HashMap Text (Group m c a, AliasType), a)
forall o (r :: EffectRow) a.
Member (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap T.Text (Group m c a, AliasType)) (Sem
   (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
 -> Sem
      (DSLState m c a r)
      (HashMap Text (Group m c a, AliasType),
       (HashMap Text (Command m c a, AliasType), x)))
-> Sem
     (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
-> Sem
     (DSLState m c a r)
     (HashMap Text (Group m c a, AliasType),
      (HashMap Text (Command m c a, AliasType), x))
forall a b. (a -> b) -> a -> b
$
            forall (r :: EffectRow) a.
Member (LocalWriter (HashMap Text (Command m c a, AliasType))) r =>
Sem r a -> Sem r (HashMap Text (Command m c a, AliasType), a)
forall o (r :: EffectRow) a.
Member (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap T.Text (Command m c a, AliasType)) (Sem (DSLState m c a r) x
 -> Sem
      (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x))
-> Sem (DSLState m c a r) x
-> Sem
     (DSLState m c a r) (HashMap Text (Command m c a, AliasType), x)
forall a b. (a -> b) -> a -> b
$
                (Maybe (Group m c a) -> Maybe (Group m c a))
-> Sem (DSLState m c a r) x -> Sem (DSLState m c a r) x
forall i (r :: EffectRow) a.
Member (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(Maybe (Group m c a)) (Maybe (Group m c a) -> Maybe (Group m c a) -> Maybe (Group m c a)
forall a b. a -> b -> a
const (Maybe (Group m c a) -> Maybe (Group m c a) -> Maybe (Group m c a))
-> Maybe (Group m c a)
-> Maybe (Group m c a)
-> Maybe (Group m c a)
forall a b. (a -> b) -> a -> b
$ Group m c a -> Maybe (Group m c a)
forall a. a -> Maybe a
Just Group m c a
group') Sem (DSLState m c a r) x
m
    HashMap Text (Group m c a, AliasType) -> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Group m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Group m c a, AliasType)
-> HashMap Text (Group m c a, AliasType)
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name (Group m c a
group', AliasType
Original)
    HashMap Text (Group m c a, AliasType) -> Sem (DSLState m c a r) ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType)
 -> Sem (DSLState m c a r) ())
-> HashMap Text (Group m c a, AliasType)
-> Sem (DSLState m c a r) ()
forall a b. (a -> b) -> a -> b
$ [(Text, (Group m c a, AliasType))]
-> HashMap Text (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LH.fromList [(Text
name, (Group m c a
group', AliasType
Alias)) | Text
name <- [Text]
aliases]
    x -> Sem (DSLState m c a r) x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
res

-- | Retrieve the final command handler for this block
fetchHandler :: P.Sem (DSLState m c a r) (CommandHandler m c a)
fetchHandler :: Sem (DSLState m c a r) (CommandHandler m c a)
fetchHandler = Sem (DSLState m c a r) (CommandHandler m c a)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask