{-# LANGUAGE RecursiveDo #-}
module CalamityCommands.Utils (
buildCommands,
processCommands,
handleCommands,
findCommand,
CmdInvokeFailReason (..),
) where
import CalamityCommands.AliasType
import CalamityCommands.Command
import CalamityCommands.CommandUtils
import CalamityCommands.Context
import CalamityCommands.Dsl
import CalamityCommands.Error
import CalamityCommands.Group
import CalamityCommands.Handler
import CalamityCommands.Internal.LocalWriter
import CalamityCommands.ParsePrefix
import Control.Lens hiding (Context)
import Control.Monad.Fix (MonadFix)
import Data.Char (isSpace)
import qualified Data.HashMap.Lazy as LH
import qualified Data.Text as S
import qualified Data.Text.Lazy as L
import GHC.Generics (Generic)
import qualified Polysemy as P
import qualified Polysemy.Error as P
import qualified Polysemy.Fixpoint as P
import qualified Polysemy.Reader as P
import qualified Polysemy.Tagged as P
mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft e -> e'
f (Left e
x) = e' -> Either e' a
forall a b. a -> Either a b
Left (e' -> Either e' a) -> e' -> Either e' a
forall a b. (a -> b) -> a -> b
$ e -> e'
f e
x
mapLeft e -> e'
_ (Right a
x) = a -> Either e' a
forall a b. b -> Either a b
Right a
x
data CmdInvokeFailReason c
= NoContext
| NotFound [L.Text]
| CommandInvokeError c CommandError
deriving (Int -> CmdInvokeFailReason c -> ShowS
[CmdInvokeFailReason c] -> ShowS
CmdInvokeFailReason c -> String
(Int -> CmdInvokeFailReason c -> ShowS)
-> (CmdInvokeFailReason c -> String)
-> ([CmdInvokeFailReason c] -> ShowS)
-> Show (CmdInvokeFailReason c)
forall c. Show c => Int -> CmdInvokeFailReason c -> ShowS
forall c. Show c => [CmdInvokeFailReason c] -> ShowS
forall c. Show c => CmdInvokeFailReason c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdInvokeFailReason c] -> ShowS
$cshowList :: forall c. Show c => [CmdInvokeFailReason c] -> ShowS
show :: CmdInvokeFailReason c -> String
$cshow :: forall c. Show c => CmdInvokeFailReason c -> String
showsPrec :: Int -> CmdInvokeFailReason c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> CmdInvokeFailReason c -> ShowS
Show, (forall x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x)
-> (forall x.
Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c)
-> Generic (CmdInvokeFailReason c)
forall x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
forall x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
forall c x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
$cto :: forall c x. Rep (CmdInvokeFailReason c) x -> CmdInvokeFailReason c
$cfrom :: forall c x. CmdInvokeFailReason c -> Rep (CmdInvokeFailReason c) x
Generic)
processCommands ::
( Monad m
, P.Members '[ParsePrefix msg, ConstructContext msg c m a, P.Embed m] r
, CommandContext m c a
) =>
CommandHandler m c a ->
msg ->
P.Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
processCommands :: CommandHandler m c a
-> msg -> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
processCommands CommandHandler m c a
handler msg
msg =
msg -> Sem r (Maybe (Text, Text))
forall msg (r :: [Effect]).
MemberWithError (ParsePrefix msg) r =>
msg -> Sem r (Maybe (Text, Text))
parsePrefix msg
msg Sem r (Maybe (Text, Text))
-> (Maybe (Text, Text)
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a))))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (Text
pre, Text
cmd) -> Either (CmdInvokeFailReason c) (c, a)
-> Maybe (Either (CmdInvokeFailReason c) (c, a))
forall a. a -> Maybe a
Just (Either (CmdInvokeFailReason c) (c, a)
-> Maybe (Either (CmdInvokeFailReason c) (c, a)))
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall (m :: * -> *) msg c a (r :: [Effect]).
(Monad m, Members '[ConstructContext msg c m a, Embed m] r,
CommandContext m c a) =>
CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands CommandHandler m c a
handler msg
msg Text
pre Text
cmd
Maybe (Text, Text)
Nothing -> Maybe (Either (CmdInvokeFailReason c) (c, a))
-> Sem r (Maybe (Either (CmdInvokeFailReason c) (c, a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either (CmdInvokeFailReason c) (c, a))
forall a. Maybe a
Nothing
handleCommands ::
( Monad m
, P.Members '[ConstructContext msg c m a, P.Embed m] r
, CommandContext m c a
) =>
CommandHandler m c a ->
msg ->
L.Text ->
L.Text ->
P.Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands :: CommandHandler m c a
-> msg
-> Text
-> Text
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands CommandHandler m c a
handler msg
msg Text
prefix Text
cmd = Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall e (r :: [Effect]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a)))
-> Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall a b. (a -> b) -> a -> b
$ do
(Command m c a
command, Text
unparsedParams) <- Either (CmdInvokeFailReason c) (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either (CmdInvokeFailReason c) (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text))
-> (Either [Text] (Command m c a, Text)
-> Either (CmdInvokeFailReason c) (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> CmdInvokeFailReason c)
-> Either [Text] (Command m c a, Text)
-> Either (CmdInvokeFailReason c) (Command m c a, Text)
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft [Text] -> CmdInvokeFailReason c
forall c. [Text] -> CmdInvokeFailReason c
NotFound (Either [Text] (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
-> Sem (Error (CmdInvokeFailReason c) : r) (Command m c a, Text)
forall a b. (a -> b) -> a -> b
$ CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
forall c a (m :: * -> *).
CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
findCommand CommandHandler m c a
handler Text
cmd
c
ctx <- CmdInvokeFailReason c
-> Maybe c -> Sem (Error (CmdInvokeFailReason c) : r) c
forall e (r :: [Effect]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note CmdInvokeFailReason c
forall c. CmdInvokeFailReason c
NoContext (Maybe c -> Sem (Error (CmdInvokeFailReason c) : r) c)
-> Sem (Error (CmdInvokeFailReason c) : r) (Maybe c)
-> Sem (Error (CmdInvokeFailReason c) : r) c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Text, Command m c a, Text)
-> msg -> Sem (Error (CmdInvokeFailReason c) : r) (Maybe c)
forall msg ctx (m' :: * -> *) a' (r :: [Effect]).
MemberWithError (ConstructContext msg ctx m' a') r =>
(Text, Command m' ctx a', Text) -> msg -> Sem r (Maybe ctx)
constructContext (Text
prefix, Command m c a
command, Text
unparsedParams) msg
msg
a
r <- Either (CmdInvokeFailReason c) a
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either (CmdInvokeFailReason c) a
-> Sem (Error (CmdInvokeFailReason c) : r) a)
-> (Either CommandError a -> Either (CmdInvokeFailReason c) a)
-> Either CommandError a
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandError -> CmdInvokeFailReason c)
-> Either CommandError a -> Either (CmdInvokeFailReason c) a
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft (c -> CommandError -> CmdInvokeFailReason c
forall c. c -> CommandError -> CmdInvokeFailReason c
CommandInvokeError c
ctx) (Either CommandError a
-> Sem (Error (CmdInvokeFailReason c) : r) a)
-> Sem (Error (CmdInvokeFailReason c) : r) (Either CommandError a)
-> Sem (Error (CmdInvokeFailReason c) : r) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< c
-> Command m c a
-> Sem (Error (CmdInvokeFailReason c) : r) (Either CommandError a)
forall (m :: * -> *) (r :: [Effect]) c a.
(Monad m, Member (Embed m) r) =>
c -> Command m c a -> Sem r (Either CommandError a)
invokeCommand c
ctx (c -> Command m c a
forall (m :: * -> *) c a.
CommandContext m c a =>
c -> Command m c a
ctxCommand c
ctx)
(c, a) -> Sem (Error (CmdInvokeFailReason c) : r) (c, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c
ctx, a
r)
buildCommands ::
forall r c m a x.
(Monad m, MonadFix m, P.Member (P.Final m) r) =>
P.Sem (DSLState m c a r) x ->
P.Sem r (CommandHandler m c a, x)
buildCommands :: Sem (DSLState m c a r) x -> Sem r (CommandHandler m c a, x)
buildCommands Sem (DSLState m c a r) x
m = Sem (Fixpoint : r) (CommandHandler m c a, x)
-> Sem r (CommandHandler m c a, x)
forall (m :: * -> *) (r :: [Effect]) a.
(Member (Final m) r, MonadFix m) =>
Sem (Fixpoint : r) a -> Sem r a
P.fixpointToFinal (Sem (Fixpoint : r) (CommandHandler m c a, x)
-> Sem r (CommandHandler m c a, x))
-> Sem (Fixpoint : r) (CommandHandler m c a, x)
-> Sem r (CommandHandler m c a, x)
forall a b. (a -> b) -> a -> b
$ mdo
(HashMap Text (Group m c a, AliasType)
groups, (HashMap Text (Command m c a, AliasType)
cmds, x
a)) <- CommandHandler m c a
-> Sem (DSLState m c a r) x
-> Sem
(Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
inner CommandHandler m c a
handler Sem (DSLState m c a r) x
m
let handler :: CommandHandler m c a
handler = HashMap Text (Group m c a, AliasType)
-> HashMap Text (Command m c a, AliasType) -> CommandHandler m c a
forall (m :: * -> *) c a.
HashMap Text (Group m c a, AliasType)
-> HashMap Text (Command m c a, AliasType) -> CommandHandler m c a
CommandHandler HashMap Text (Group m c a, AliasType)
groups HashMap Text (Command m c a, AliasType)
cmds
(CommandHandler m c a, x)
-> Sem (Fixpoint : r) (CommandHandler m c a, x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandHandler m c a
handler, x
a)
where
inner ::
CommandHandler m c a ->
P.Sem (DSLState m c a r) x ->
P.Sem
(P.Fixpoint ': r)
( LH.HashMap S.Text (Group m c a, AliasType)
, (LH.HashMap S.Text (Command m c a, AliasType), x)
)
inner :: CommandHandler m c a
-> Sem (DSLState m c a r) x
-> Sem
(Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
inner CommandHandler m c a
h =
CommandHandler m c a
-> Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader CommandHandler m c a
h
(Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Check m c]
-> Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader []
(Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Text)
-> Sem
(Reader (c -> Text)
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader c -> Text
forall a b. IsString a => b -> a
defaultHelp
(Sem
(Reader (c -> Text)
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Reader (c -> Text)
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: Effect) (r :: [Effect]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: Effect) (r :: [Effect]) a.
Sem (Tagged "original-help" e : r) a -> Sem (e : r) a
P.untag @"original-help"
(Sem
(Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader (c -> Text)
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Reader (c -> Text)
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Text)
-> Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader c -> Text
forall a b. IsString a => b -> a
defaultHelp
(Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Sem
(Reader Bool
: Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader Bool
False
(Sem
(Reader Bool
: Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a r) x
-> Sem
(Reader Bool
: Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Reader (c -> Text)
: Tagged "original-help" (Reader (c -> Text)) : Reader [Check m c]
: Reader (CommandHandler m c a) : Fixpoint : r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: Effect) (r :: [Effect]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: Effect) (r :: [Effect]) a.
Sem (Tagged "hidden" e : r) a -> Sem (e : r) a
P.untag @"hidden"
(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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
-> Sem
(Reader Bool
: Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a r) x
-> Sem
(Reader Bool
: Reader (c -> Text) : Tagged "original-help" (Reader (c -> Text))
: Reader [Check m c] : Reader (CommandHandler m c a) : Fixpoint
: r)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Group m c a)
-> 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
P.runReader Maybe (Group m c a)
forall a. Maybe a
Nothing
(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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> Sem (DSLState m c a 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [Effect]) a.
Monoid (HashMap Text (Group m c a, AliasType)) =>
Sem (LocalWriter (HashMap Text (Group m c a, AliasType)) : r) a
-> Sem r (HashMap Text (Group m c a, AliasType), a)
forall o (r :: [Effect]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Group m c a, AliasType))
(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)
(HashMap Text (Command m c a, AliasType), 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x)))
-> (Sem (DSLState m c a 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)
(HashMap Text (Command m c a, AliasType), x))
-> Sem (DSLState m c a 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)
(HashMap Text (Group m c a, AliasType),
(HashMap Text (Command m c a, AliasType), x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [Effect]) a.
Monoid (HashMap Text (Command m c a, AliasType)) =>
Sem (LocalWriter (HashMap Text (Command m c a, AliasType)) : r) a
-> Sem r (HashMap Text (Command m c a, AliasType), a)
forall o (r :: [Effect]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Command m c a, AliasType))
defaultHelp :: b -> a
defaultHelp = a -> b -> a
forall a b. a -> b -> a
const a
"This command or group has no help."
nextWord :: L.Text -> (L.Text, L.Text)
nextWord :: Text -> (Text, Text)
nextWord = (Char -> Bool) -> Text -> (Text, Text)
L.break Char -> Bool
isSpace (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
L.stripStart
findCommand :: forall c a m. CommandHandler m c a -> L.Text -> Either [L.Text] (Command m c a, L.Text)
findCommand :: CommandHandler m c a -> Text -> Either [Text] (Command m c a, Text)
findCommand CommandHandler m c a
handler Text
msg = (Text, Text) -> Either [Text] (Command m c a, Text)
goH ((Text, Text) -> Either [Text] (Command m c a, Text))
-> (Text, Text) -> Either [Text] (Command m c a, Text)
forall a b. (a -> b) -> a -> b
$ Text -> (Text, Text)
nextWord Text
msg
where
goH :: (L.Text, L.Text) -> Either [L.Text] (Command m c a, L.Text)
goH :: (Text, Text) -> Either [Text] (Command m c a, Text)
goH (Text
"", Text
_) = [Text] -> Either [Text] (Command m c a, Text)
forall a b. a -> Either a b
Left []
goH (Text
x, Text
xs) =
Text
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar
Text
x
( ((,Text
xs) (Command m c a -> (Command m c a, Text))
-> Either [Text] (Command m c a)
-> Either [Text] (Command m c a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Command m c a, AliasType) -> Either [Text] (Command m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Command m c a, AliasType)
-> Maybe (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler m c a
handler CommandHandler m c a
-> Getting
(HashMap Text (Command m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Command m c a, AliasType)))
Getting
(HashMap Text (Command m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Command m c a, AliasType))
#commands)))
Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe (Group m c a, AliasType) -> Either [Text] (Group m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Group m c a, AliasType)
-> Maybe (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler m c a
handler CommandHandler m c a
-> Getting
(HashMap Text (Group m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"groups"
(Getting
(HashMap Text (Group m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Group m c a, AliasType)))
Getting
(HashMap Text (Group m c a, AliasType))
(CommandHandler m c a)
(HashMap Text (Group m c a, AliasType))
#groups)) Either [Text] (Group m c a)
-> (Group m c a -> Either [Text] (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group m c a -> Either [Text] (Command m c a, Text)
goG (Text -> (Text, Text)
nextWord Text
xs))
)
goG :: (L.Text, L.Text) -> Group m c a -> Either [L.Text] (Command m c a, L.Text)
goG :: (Text, Text) -> Group m c a -> Either [Text] (Command m c a, Text)
goG (Text
"", Text
_) Group m c a
_ = [Text] -> Either [Text] (Command m c a, Text)
forall a b. a -> Either a b
Left []
goG (Text
x, Text
xs) Group m c a
g =
Text
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar
Text
x
( ((,Text
xs) (Command m c a -> (Command m c a, Text))
-> Either [Text] (Command m c a)
-> Either [Text] (Command m c a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Command m c a, AliasType) -> Either [Text] (Command m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Command m c a, AliasType)
-> Maybe (Command m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group m c a
g Group m c a
-> Getting
(HashMap Text (Command m c a, AliasType))
(Group m c a)
(HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command m c a, AliasType))
(Group m c a)
(HashMap Text (Command m c a, AliasType)))
Getting
(HashMap Text (Command m c a, AliasType))
(Group m c a)
(HashMap Text (Command m c a, AliasType))
#commands)))
Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
-> Either [Text] (Command m c a, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe (Group m c a, AliasType) -> Either [Text] (Group m c a)
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Group m c a, AliasType)
-> Maybe (Group m c a, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group m c a
g Group m c a
-> Getting
(HashMap Text (Group m c a, AliasType))
(Group m c a)
(HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"children"
(Getting
(HashMap Text (Group m c a, AliasType))
(Group m c a)
(HashMap Text (Group m c a, AliasType)))
Getting
(HashMap Text (Group m c a, AliasType))
(Group m c a)
(HashMap Text (Group m c a, AliasType))
#children)) Either [Text] (Group m c a)
-> (Group m c a -> Either [Text] (Command m c a, Text))
-> Either [Text] (Command m c a, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group m c a -> Either [Text] (Command m c a, Text)
goG (Text -> (Text, Text)
nextWord Text
xs))
)
attachInitial :: forall a b. Maybe (a, b) -> Either [L.Text] a
attachInitial :: Maybe (a, b) -> Either [Text] a
attachInitial (Just (a
a, b
_)) = a -> Either [Text] a
forall a b. b -> Either a b
Right a
a
attachInitial Maybe (a, b)
Nothing = [Text] -> Either [Text] a
forall a b. a -> Either a b
Left []
attachSoFar :: forall a. L.Text -> Either [L.Text] a -> Either [L.Text] a
attachSoFar :: Text -> Either [Text] a -> Either [Text] a
attachSoFar Text
cmd (Left [Text]
xs) = [Text] -> Either [Text] a
forall a b. a -> Either a b
Left (Text
cmd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
attachSoFar Text
_ Either [Text] a
r = Either [Text] a
r