{-# LANGUAGE RecursiveDo #-}
module CalamityCommands.Dsl (
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
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
command' ::
(Monad m, P.Member (P.Final m) r) =>
T.Text ->
[ParameterInfo] ->
(c -> P.Sem r (Either CommandError p)) ->
((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
commandA' ::
forall p c a m r.
(Monad m, P.Member (P.Final m) r) =>
T.Text ->
[T.Text] ->
[ParameterInfo] ->
(c -> P.Sem r (Either CommandError p)) ->
((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
command ::
forall ps c a m r.
( Monad m
, P.Member (P.Final m) r
, TypedCommandC ps c a r
, CommandContext m c a
) =>
T.Text ->
(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
commandA ::
forall ps c a m r.
( Monad m
, P.Member (P.Final m) r
, TypedCommandC ps c a r
, CommandContext m c a
) =>
T.Text ->
[T.Text] ->
(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'
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
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
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
(<>)
requires' ::
(Monad m, P.Member (P.Final m) r) =>
T.Text ->
(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
requiresPure ::
Monad m =>
[(T.Text, c -> Maybe T.Text)] ->
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
group ::
(Monad m, P.Member (P.Final m) r) =>
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
groupA ::
forall x c m a r.
(Monad m, P.Member (P.Final m) r) =>
T.Text ->
[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
group' ::
P.Member (P.Final m) r =>
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
groupA' ::
forall x c m a r.
P.Member (P.Final m) r =>
T.Text ->
[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
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