{-# LANGUAGE RecursiveDo #-}
module Calamity.Commands.Dsl
( command'
, command
, help
, requires
, requires'
, requiresPure
, group
, group'
, DSLState
, raiseDSL ) where
import Calamity.Commands.Check
import Calamity.Commands.Command hiding ( help )
import Calamity.Commands.CommandUtils
import Calamity.Commands.Context hiding ( command )
import Calamity.Commands.Error
import Calamity.Commands.Group hiding ( help )
import Calamity.Commands.Handler
import Calamity.Internal.LocalWriter
import qualified Data.HashMap.Lazy as LH
import qualified Data.Text as S
import qualified Data.Text.Lazy as L
import qualified Polysemy as P
import qualified Polysemy.Fail as P
import qualified Polysemy.Tagged as P
import qualified Polysemy.Fixpoint as P
import qualified Polysemy.Reader as P
type DSLState r = (LocalWriter (LH.HashMap S.Text Command) ':
LocalWriter (LH.HashMap S.Text Group) ':
P.Reader (Maybe Group) ':
P.Reader (Context -> L.Text) ':
P.Tagged "original-help" (P.Reader (Context -> L.Text)) ':
P.Reader [Check] ':
P.Reader CommandHandler ':
P.Fixpoint ': r)
raiseDSL :: P.Sem r a -> P.Sem (DSLState r) a
raiseDSL :: Sem r a -> Sem (DSLState r) a
raiseDSL = Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem (DSLState r) a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem (DSLState r) a)
-> (Sem r a
-> Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> Sem r a
-> Sem (DSLState r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> (Sem r a
-> Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> Sem r a
-> Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> (Sem r a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> Sem r a
-> Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> (Sem r a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> Sem r a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a)
-> (Sem r a
-> Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a)
-> Sem r a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Reader CommandHandler : Fixpoint : r) a
-> Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem (Reader CommandHandler : Fixpoint : r) a
-> Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a)
-> (Sem r a -> Sem (Reader CommandHandler : Fixpoint : r) a)
-> Sem r a
-> Sem (Reader [Check] : Reader CommandHandler : Fixpoint : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fixpoint : r) a
-> Sem (Reader CommandHandler : Fixpoint : r) a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise (Sem (Fixpoint : r) a
-> Sem (Reader CommandHandler : Fixpoint : r) a)
-> (Sem r a -> Sem (Fixpoint : r) a)
-> Sem r a
-> Sem (Reader CommandHandler : Fixpoint : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r a -> Sem (Fixpoint : r) a
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
P.raise
command'
:: P.Member (P.Final IO) r
=> S.Text
-> [S.Text]
-> (Context -> P.Sem r (Either CommandError a))
-> ((Context, a) -> P.Sem (P.Fail ': r) ())
-> P.Sem (DSLState r) Command
command' :: Text
-> [Text]
-> (Context -> Sem r (Either CommandError a))
-> ((Context, a) -> Sem (Fail : r) ())
-> Sem (DSLState r) Command
command' name :: Text
name params :: [Text]
params parser :: Context -> Sem r (Either CommandError a)
parser cb :: (Context, a) -> Sem (Fail : r) ()
cb = do
Maybe Group
parent <- forall (r :: EffectRow).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Maybe Group)
[Check]
checks <- forall (r :: EffectRow).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @[Check]
Context -> Text
help' <- forall (r :: EffectRow).
MemberWithError (Reader (Context -> Text)) r =>
Sem r (Context -> Text)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Context -> L.Text)
Command
cmd <- Sem r Command -> Sem (DSLState r) Command
forall (r :: EffectRow) a. Sem r a -> Sem (DSLState r) a
raiseDSL (Sem r Command -> Sem (DSLState r) Command)
-> Sem r Command -> Sem (DSLState r) Command
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Group
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> Sem r (Either CommandError a))
-> ((Context, a) -> Sem (Fail : r) ())
-> Sem r Command
forall (r :: EffectRow) a.
Member (Final IO) r =>
Text
-> Maybe Group
-> [Check]
-> [Text]
-> (Context -> Text)
-> (Context -> Sem r (Either CommandError a))
-> ((Context, a) -> Sem (Fail : r) ())
-> Sem r Command
buildCommand' Text
name Maybe Group
parent [Check]
checks [Text]
params Context -> Text
help' Context -> Sem r (Either CommandError a)
parser (Context, a) -> Sem (Fail : r) ()
cb
HashMap Text Command -> Sem (DSLState r) ()
forall o (r :: EffectRow).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text Command -> Sem (DSLState r) ())
-> HashMap Text Command -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> Command -> HashMap Text Command
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name Command
cmd
Command -> Sem (DSLState r) Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
cmd
command :: forall ps r.
( P.Member (P.Final IO) r,
TypedCommandC ps r)
=> S.Text
-> (Context -> CommandForParsers ps r)
-> P.Sem (DSLState r) Command
command :: Text
-> (Context -> CommandForParsers ps r) -> Sem (DSLState r) Command
command name :: Text
name cmd :: Context -> CommandForParsers ps r
cmd = do
Maybe Group
parent <- forall (r :: EffectRow).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Maybe Group)
[Check]
checks <- forall (r :: EffectRow).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @[Check]
Context -> Text
help' <- forall (r :: EffectRow).
MemberWithError (Reader (Context -> Text)) r =>
Sem r (Context -> Text)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Context -> L.Text)
Command
cmd' <- Sem r Command -> Sem (DSLState r) Command
forall (r :: EffectRow) a. Sem r a -> Sem (DSLState r) a
raiseDSL (Sem r Command -> Sem (DSLState r) Command)
-> Sem r Command -> Sem (DSLState r) Command
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
forall (ps :: [*]) (r :: EffectRow).
(Member (Final IO) r, TypedCommandC ps r) =>
Text
-> Maybe Group
-> [Check]
-> (Context -> Text)
-> (Context -> CommandForParsers ps r)
-> Sem r Command
buildCommand @ps Text
name Maybe Group
parent [Check]
checks Context -> Text
help' Context -> CommandForParsers ps r
cmd
HashMap Text Command -> Sem (DSLState r) ()
forall o (r :: EffectRow).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text Command -> Sem (DSLState r) ())
-> HashMap Text Command -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> Command -> HashMap Text Command
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name Command
cmd'
Command -> Sem (DSLState r) Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
cmd'
help :: P.Member (P.Reader (Context -> L.Text)) r
=> (Context -> L.Text)
-> P.Sem r a
-> P.Sem r a
help :: (Context -> Text) -> Sem r a -> Sem r a
help = ((Context -> Text) -> Context -> Text) -> Sem r a -> Sem r a
forall i (r :: EffectRow) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local (((Context -> Text) -> Context -> Text) -> Sem r a -> Sem r a)
-> ((Context -> Text) -> (Context -> Text) -> Context -> Text)
-> (Context -> Text)
-> Sem r a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context -> Text) -> (Context -> Text) -> Context -> Text
forall a b. a -> b -> a
const
requires :: [Check]
-> P.Sem (DSLState r) a
-> P.Sem (DSLState r) a
requires :: [Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
requires = ([Check] -> [Check]) -> Sem (DSLState r) a -> Sem (DSLState r) a
forall i (r :: EffectRow) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local (([Check] -> [Check]) -> Sem (DSLState r) a -> Sem (DSLState r) a)
-> ([Check] -> [Check] -> [Check])
-> [Check]
-> Sem (DSLState r) a
-> Sem (DSLState r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Check] -> [Check] -> [Check]
forall a. Semigroup a => a -> a -> a
(<>)
requires' :: P.Member (P.Final IO) r
=> S.Text
-> (Context -> P.Sem r (Maybe L.Text))
-> P.Sem (DSLState r) a
-> P.Sem (DSLState r) a
requires' :: Text
-> (Context -> Sem r (Maybe Text))
-> Sem (DSLState r) a
-> Sem (DSLState r) a
requires' name :: Text
name cb :: Context -> Sem r (Maybe Text)
cb m :: Sem (DSLState r) a
m = do
Check
check <- Sem r Check -> Sem (DSLState r) Check
forall (r :: EffectRow) a. Sem r a -> Sem (DSLState r) a
raiseDSL (Sem r Check -> Sem (DSLState r) Check)
-> Sem r Check -> Sem (DSLState r) Check
forall a b. (a -> b) -> a -> b
$ Text -> (Context -> Sem r (Maybe Text)) -> Sem r Check
forall (r :: EffectRow).
Member (Final IO) r =>
Text -> (Context -> Sem r (Maybe Text)) -> Sem r Check
buildCheck Text
name Context -> Sem r (Maybe Text)
cb
[Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
forall (r :: EffectRow) a.
[Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
requires [Check
check] Sem (DSLState r) a
m
requiresPure :: [(S.Text, Context -> Maybe L.Text)]
-> P.Sem (DSLState r) a
-> P.Sem (DSLState r) a
requiresPure :: [(Text, Context -> Maybe Text)]
-> Sem (DSLState r) a -> Sem (DSLState r) a
requiresPure checks :: [(Text, Context -> Maybe Text)]
checks = [Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
forall (r :: EffectRow) a.
[Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
requires ([Check] -> Sem (DSLState r) a -> Sem (DSLState r) a)
-> [Check] -> Sem (DSLState r) a -> Sem (DSLState r) a
forall a b. (a -> b) -> a -> b
$ ((Text, Context -> Maybe Text) -> Check)
-> [(Text, Context -> Maybe Text)] -> [Check]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> (Context -> Maybe Text) -> Check)
-> (Text, Context -> Maybe Text) -> Check
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> (Context -> Maybe Text) -> Check
buildCheckPure) [(Text, Context -> Maybe Text)]
checks
group :: P.Member (P.Final IO) r
=> S.Text
-> P.Sem (DSLState r) a
-> P.Sem (DSLState r) a
group :: Text -> Sem (DSLState r) a -> Sem (DSLState r) a
group name :: Text
name m :: Sem (DSLState r) a
m = mdo
Maybe Group
parent <- forall (r :: EffectRow).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Maybe Group)
[Check]
checks <- forall (r :: EffectRow).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @[Check]
Context -> Text
help' <- forall (r :: EffectRow).
MemberWithError (Reader (Context -> Text)) r =>
Sem r (Context -> Text)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Context -> L.Text)
Context -> Text
origHelp <- Sem (DSLState r) (Context -> Text)
forall (r :: EffectRow).
Member (Tagged "original-help" (Reader (Context -> Text))) r =>
Sem r (Context -> Text)
fetchOrigHelp
let group' :: Group
group' = Text
-> Maybe Group
-> HashMap Text Command
-> HashMap Text Group
-> (Context -> Text)
-> [Check]
-> Group
Group Text
name Maybe Group
parent HashMap Text Command
commands HashMap Text Group
children Context -> Text
help' [Check]
checks
(children :: HashMap Text Group
children, (commands :: HashMap Text Command
commands, res :: a
res)) <- forall (r :: EffectRow) a.
MemberWithError (LocalWriter (HashMap Text Group)) r =>
Sem r a -> Sem r (HashMap Text Group, a)
forall o (r :: EffectRow) a.
MemberWithError (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap S.Text Group) (Sem (DSLState r) (HashMap Text Command, a)
-> Sem
(DSLState r) (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) (HashMap Text Command, a)
-> Sem (DSLState r) (HashMap Text Group, (HashMap Text Command, a))
forall a b. (a -> b) -> a -> b
$
forall (r :: EffectRow) a.
MemberWithError (LocalWriter (HashMap Text Command)) r =>
Sem r a -> Sem r (HashMap Text Command, a)
forall o (r :: EffectRow) a.
MemberWithError (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap S.Text Command) (Sem (DSLState r) a -> Sem (DSLState r) (HashMap Text Command, a))
-> Sem (DSLState r) a -> Sem (DSLState r) (HashMap Text Command, a)
forall a b. (a -> b) -> a -> b
$
(Maybe Group -> Maybe Group)
-> Sem (DSLState r) a -> Sem (DSLState r) a
forall i (r :: EffectRow) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(Maybe Group) (Maybe Group -> Maybe Group -> Maybe Group
forall a b. a -> b -> a
const (Maybe Group -> Maybe Group -> Maybe Group)
-> Maybe Group -> Maybe Group -> Maybe Group
forall a b. (a -> b) -> a -> b
$ Group -> Maybe Group
forall a. a -> Maybe a
Just Group
group') (Sem (DSLState r) a -> Sem (DSLState r) a)
-> Sem (DSLState r) a -> Sem (DSLState r) a
forall a b. (a -> b) -> a -> b
$
((Context -> Text) -> Context -> Text)
-> Sem (DSLState r) a -> Sem (DSLState r) a
forall i (r :: EffectRow) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(Context -> L.Text) ((Context -> Text) -> (Context -> Text) -> Context -> Text
forall a b. a -> b -> a
const Context -> Text
origHelp) Sem (DSLState r) a
m
HashMap Text Group -> Sem (DSLState r) ()
forall o (r :: EffectRow).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text Group -> Sem (DSLState r) ())
-> HashMap Text Group -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> Group -> HashMap Text Group
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name Group
group'
a -> Sem (DSLState r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
fetchOrigHelp :: P.Member (P.Tagged "original-help" (P.Reader (Context -> L.Text))) r => P.Sem r (Context -> L.Text)
fetchOrigHelp :: Sem r (Context -> Text)
fetchOrigHelp = Sem (Reader (Context -> Text) : r) (Context -> Text)
-> Sem r (Context -> 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 (Context -> Text) : r) (Context -> Text)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask
group' :: P.Member (P.Final IO) r
=> S.Text
-> P.Sem (DSLState r) a
-> P.Sem (DSLState r) a
group' :: Text -> Sem (DSLState r) a -> Sem (DSLState r) a
group' name :: Text
name m :: Sem (DSLState r) a
m = mdo
Maybe Group
parent <- forall (r :: EffectRow).
MemberWithError (Reader (Maybe Group)) r =>
Sem r (Maybe Group)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Maybe Group)
[Check]
checks <- forall (r :: EffectRow).
MemberWithError (Reader [Check]) r =>
Sem r [Check]
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @[Check]
Context -> Text
help' <- forall (r :: EffectRow).
MemberWithError (Reader (Context -> Text)) r =>
Sem r (Context -> Text)
forall i (r :: EffectRow). MemberWithError (Reader i) r => Sem r i
P.ask @(Context -> L.Text)
let group' :: Group
group' = Text
-> Maybe Group
-> HashMap Text Command
-> HashMap Text Group
-> (Context -> Text)
-> [Check]
-> Group
Group Text
name Maybe Group
parent HashMap Text Command
commands HashMap Text Group
children Context -> Text
help' [Check]
checks
(children :: HashMap Text Group
children, (commands :: HashMap Text Command
commands, res :: a
res)) <- forall (r :: EffectRow) a.
MemberWithError (LocalWriter (HashMap Text Group)) r =>
Sem r a -> Sem r (HashMap Text Group, a)
forall o (r :: EffectRow) a.
MemberWithError (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap S.Text Group) (Sem (DSLState r) (HashMap Text Command, a)
-> Sem
(DSLState r) (HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) (HashMap Text Command, a)
-> Sem (DSLState r) (HashMap Text Group, (HashMap Text Command, a))
forall a b. (a -> b) -> a -> b
$
forall (r :: EffectRow) a.
MemberWithError (LocalWriter (HashMap Text Command)) r =>
Sem r a -> Sem r (HashMap Text Command, a)
forall o (r :: EffectRow) a.
MemberWithError (LocalWriter o) r =>
Sem r a -> Sem r (o, a)
llisten @(LH.HashMap S.Text Command) (Sem (DSLState r) a -> Sem (DSLState r) (HashMap Text Command, a))
-> Sem (DSLState r) a -> Sem (DSLState r) (HashMap Text Command, a)
forall a b. (a -> b) -> a -> b
$
(Maybe Group -> Maybe Group)
-> Sem (DSLState r) a -> Sem (DSLState r) a
forall i (r :: EffectRow) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(Maybe Group) (Maybe Group -> Maybe Group -> Maybe Group
forall a b. a -> b -> a
const (Maybe Group -> Maybe Group -> Maybe Group)
-> Maybe Group -> Maybe Group -> Maybe Group
forall a b. (a -> b) -> a -> b
$ Group -> Maybe Group
forall a. a -> Maybe a
Just Group
group') Sem (DSLState r) a
m
HashMap Text Group -> Sem (DSLState r) ()
forall o (r :: EffectRow).
MemberWithError (LocalWriter o) r =>
o -> Sem r ()
ltell (HashMap Text Group -> Sem (DSLState r) ())
-> HashMap Text Group -> Sem (DSLState r) ()
forall a b. (a -> b) -> a -> b
$ Text -> Group -> HashMap Text Group
forall k v. Hashable k => k -> v -> HashMap k v
LH.singleton Text
name Group
group'
a -> Sem (DSLState r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res