{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
module CalamityCommands.Dsl (
command,
command',
commandA,
commandA',
hide,
help,
requires,
requires',
requiresPure,
group,
group',
groupA,
groupA',
DSLState,
DSLC,
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.Internal.LocalWriter
import CalamityCommands.ParameterInfo
import Data.HashMap.Lazy qualified as LH
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text qualified as T
import Polysemy qualified as P
import Polysemy.Fail qualified as P
import Polysemy.Fixpoint qualified as P
import Polysemy.Reader qualified as P
import Polysemy.Tagged qualified as P
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
)
type DSLC m c a r =
P.Members
[ 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 :: forall (r :: EffectRow) x (m :: * -> *) c a.
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
(LocalWriter (HashMap Text (Command m c a, AliasType))
: 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 :: (* -> *) -> * -> *) (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
(LocalWriter (HashMap Text (Command m c a, AliasType))
: 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
(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
(LocalWriter (HashMap Text (Command m c a, AliasType))
: 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
(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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (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 :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
P.raise
command' ::
(Monad m, P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
[ParameterInfo] ->
(c -> P.Sem r (Either CommandError p)) ->
((c, p) -> P.Sem (P.Fail ': r) a) ->
P.Sem r (Command m c a)
command' :: forall (m :: * -> *) (r :: EffectRow) c a p.
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
command' Text
name = Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
forall p c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem r (Command m c a)
commandA' Text
name []
commandA' ::
forall p c a m r.
(Monad m, P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
[T.Text] ->
[ParameterInfo] ->
(c -> P.Sem r (Either CommandError p)) ->
((c, p) -> P.Sem (P.Fail ': r) a) ->
P.Sem r (Command m c a)
commandA' :: forall p c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text
-> [Text]
-> [ParameterInfo]
-> (c -> Sem r (Either CommandError p))
-> ((c, p) -> Sem (Fail : r) a)
-> Sem 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 i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
Bool
hidden <- Sem (Reader Bool : r) Bool -> Sem r Bool
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : r) Bool -> Sem r Bool)
-> Sem (Reader Bool : r) Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
[Check m c]
checks <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
c -> Text
help' <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
Command m c a
cmd <- 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType) -> Sem r ())
-> HashMap Text (Command m c a, AliasType) -> Sem 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType) -> Sem r ())
-> HashMap Text (Command m c a, AliasType) -> Sem 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 r (Command m c a)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command m c a
cmd
command ::
forall ps c a m r.
( Monad m
, P.Member (P.Final m) r
, DSLC m c a r
, TypedCommandC ps c a r
, CommandContext m c a
) =>
T.Text ->
(c -> CommandForParsers ps r a) ->
P.Sem r (Command m c a)
command :: forall (ps :: [*]) c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r, TypedCommandC ps c a r,
CommandContext m c a) =>
Text -> (c -> CommandForParsers ps r a) -> Sem r (Command m c a)
command Text
name = forall (ps :: [*]) c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r, TypedCommandC ps c a r,
CommandContext m c a) =>
Text
-> [Text]
-> (c -> CommandForParsers ps r a)
-> Sem r (Command m c a)
commandA @ps Text
name []
commandA ::
forall ps c a m r.
( Monad m
, P.Member (P.Final m) r
, DSLC m c a r
, TypedCommandC ps c a r
, CommandContext m c a
) =>
T.Text ->
[T.Text] ->
(c -> CommandForParsers ps r a) ->
P.Sem r (Command m c a)
commandA :: forall (ps :: [*]) c a (m :: * -> *) (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r, TypedCommandC ps c a r,
CommandContext m c a) =>
Text
-> [Text]
-> (c -> CommandForParsers ps r a)
-> Sem r (Command m c a)
commandA Text
name [Text]
aliases c -> CommandForParsers ps r a
cmd = do
Maybe (Group m c a)
parent <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
Bool
hidden <- Sem (Reader Bool : r) Bool -> Sem r Bool
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : r) Bool -> Sem r Bool)
-> Sem (Reader Bool : r) Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
[Check m c]
checks <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
c -> Text
help' <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
Command m c a
cmd' <- 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType) -> Sem r ())
-> HashMap Text (Command m c a, AliasType) -> Sem 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Command m c a, AliasType) -> Sem r ())
-> HashMap Text (Command m c a, AliasType) -> Sem 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 r (Command m c a)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command m c a
cmd'
hide ::
(P.Member (P.Tagged "hidden" (P.Reader Bool)) r) =>
P.Sem r x ->
P.Sem r x
hide :: forall (r :: EffectRow) x.
Member (Tagged "hidden" (Reader Bool)) r =>
Sem r x -> Sem r x
hide = forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
forall (k2 :: Symbol) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Tagged k2 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
. 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 :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
P.raise
help ::
(P.Member (P.Reader (c -> T.Text)) r) =>
(c -> T.Text) ->
P.Sem r a ->
P.Sem r a
help :: forall c (r :: EffectRow) a.
Member (Reader (c -> Text)) r =>
(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
requires ::
(DSLC m c a r) =>
[Check m c] ->
P.Sem r x ->
P.Sem r x
requires :: forall (m :: * -> *) c a (r :: EffectRow) x.
DSLC m c a r =>
[Check m c] -> Sem r x -> Sem r x
requires = ([Check m c] -> [Check m c]) -> Sem r x -> Sem 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 r x -> Sem r x)
-> ([Check m c] -> [Check m c] -> [Check m c])
-> [Check m c]
-> Sem r x
-> Sem 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
(<>)
requires' ::
(Monad m, P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
(c -> P.Sem r (Maybe T.Text)) ->
P.Sem r x ->
P.Sem r x
requires' :: forall (m :: * -> *) (r :: EffectRow) c a x.
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text -> (c -> Sem r (Maybe Text)) -> Sem r x -> Sem r x
requires' Text
name c -> Sem r (Maybe Text)
cb Sem r x
m = do
Check m c
check <- 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 r x -> Sem r x
forall (m :: * -> *) c a (r :: EffectRow) x.
DSLC m c a r =>
[Check m c] -> Sem r x -> Sem r x
requires [Check m c
check] Sem r x
m
requiresPure ::
(Monad m, DSLC m c a r) =>
[(T.Text, c -> Maybe T.Text)] ->
P.Sem r x ->
P.Sem r x
requiresPure :: forall (m :: * -> *) c a (r :: EffectRow) x.
(Monad m, DSLC m c a r) =>
[(Text, c -> Maybe Text)] -> Sem r x -> Sem r x
requiresPure [(Text, c -> Maybe Text)]
checks = [Check m c] -> Sem r x -> Sem r x
forall (m :: * -> *) c a (r :: EffectRow) x.
DSLC m c a r =>
[Check m c] -> Sem r x -> Sem r x
requires ([Check m c] -> Sem r x -> Sem r x)
-> [Check m c] -> Sem r x -> Sem 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]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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
group ::
(Monad m, P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
P.Sem r x ->
P.Sem r x
group :: forall (m :: * -> *) (r :: EffectRow) c a x.
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text -> Sem r x -> Sem r x
group Text
name = Text -> [Text] -> Sem r x -> Sem r x
forall x c (m :: * -> *) a (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text -> [Text] -> Sem r x -> Sem r x
groupA Text
name []
groupA ::
forall x c m a r.
(Monad m, P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
[T.Text] ->
P.Sem r x ->
P.Sem r x
groupA :: forall x c (m :: * -> *) a (r :: EffectRow).
(Monad m, Member (Final m) r, DSLC m c a r) =>
Text -> [Text] -> Sem r x -> Sem r x
groupA Text
name [Text]
aliases Sem r x
m = mdo
Maybe (Group m c a)
parent <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
Bool
hidden <- Sem (Reader Bool : r) Bool -> Sem r Bool
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : r) Bool -> Sem r Bool)
-> Sem (Reader Bool : r) Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
[Check m c]
checks <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
c -> Text
help' <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(c -> T.Text)
c -> Text
origHelp <- Sem 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 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 r (HashMap Text (Command m c a, AliasType), x)
-> Sem
r
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem r (HashMap Text (Command m c a, AliasType), x)
-> Sem
r
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall a b. (a -> b) -> a -> b
$
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 r x -> Sem r (HashMap Text (Command m c a, AliasType), x))
-> Sem r x -> Sem r (HashMap Text (Command m c a, AliasType), x)
forall a b. (a -> b) -> a -> b
$
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 r x -> Sem r x) -> Sem r x -> Sem r x
forall a b. (a -> b) -> a -> b
$
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 r x
m
HashMap Text (Group m c a, AliasType) -> Sem r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType) -> Sem r ())
-> HashMap Text (Group m c a, AliasType) -> Sem 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType) -> Sem r ())
-> HashMap Text (Group m c a, AliasType) -> Sem 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 r x
forall a. a -> Sem r a
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 :: forall c (r :: EffectRow).
Member (Tagged "original-help" (Reader (c -> Text))) r =>
Sem r (c -> Text)
fetchOrigHelp = Sem (Reader (c -> Text) : r) (c -> Text) -> Sem r (c -> Text)
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (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
group' ::
(P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
P.Sem r x ->
P.Sem r x
group' :: forall (m :: * -> *) (r :: EffectRow) c a x.
(Member (Final m) r, DSLC m c a r) =>
Text -> Sem r x -> Sem r x
group' Text
name = Text -> [Text] -> Sem r x -> Sem r x
forall x c (m :: * -> *) a (r :: EffectRow).
(Member (Final m) r, DSLC m c a r) =>
Text -> [Text] -> Sem r x -> Sem r x
groupA' Text
name []
groupA' ::
forall x c m a r.
(P.Member (P.Final m) r, DSLC m c a r) =>
T.Text ->
[T.Text] ->
P.Sem r x ->
P.Sem r x
groupA' :: forall x c (m :: * -> *) a (r :: EffectRow).
(Member (Final m) r, DSLC m c a r) =>
Text -> [Text] -> Sem r x -> Sem r x
groupA' Text
name [Text]
aliases Sem r x
m = mdo
Maybe (Group m c a)
parent <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @(Maybe (Group m c a))
Bool
hidden <- Sem (Reader Bool : r) Bool -> Sem r Bool
forall {k1} (k2 :: k1) (e :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Member (Tagged k2 e) r =>
Sem (e : r) a -> Sem r a
P.tag (Sem (Reader Bool : r) Bool -> Sem r Bool)
-> Sem (Reader Bool : r) Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @Bool
[Check m c]
checks <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask @[Check m c]
c -> Text
help' <- 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 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 r (HashMap Text (Command m c a, AliasType), x)
-> Sem
r
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem r (HashMap Text (Command m c a, AliasType), x)
-> Sem
r
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall a b. (a -> b) -> a -> b
$
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 r x -> Sem r (HashMap Text (Command m c a, AliasType), x))
-> Sem r x -> Sem r (HashMap Text (Command m c a, AliasType), x)
forall a b. (a -> b) -> a -> b
$
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 r x
m
HashMap Text (Group m c a, AliasType) -> Sem r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType) -> Sem r ())
-> HashMap Text (Group m c a, AliasType) -> Sem 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 r ()
forall o (r :: EffectRow).
Member (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text (Group m c a, AliasType) -> Sem r ())
-> HashMap Text (Group m c a, AliasType) -> Sem 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 r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
res
fetchHandler :: (DSLC m c a r) => P.Sem r (CommandHandler m c a)
fetchHandler :: forall (m :: * -> *) c a (r :: EffectRow).
DSLC m c a r =>
Sem r (CommandHandler m c a)
fetchHandler = Sem r (CommandHandler m c a)
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
P.ask