{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
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.Monad.Fix (MonadFix)
import Data.Char (isSpace)
import Data.HashMap.Lazy qualified as LH
import Data.Text qualified as T
import Optics
import Polysemy qualified as P
import Polysemy.Error qualified as P
import Polysemy.Fixpoint qualified as P
import Polysemy.Reader qualified as P
import Polysemy.Tagged qualified as P
mapLeft :: (e -> e') -> Either e a -> Either e' a
mapLeft :: forall e e' a. (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 [T.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
$cshowsPrec :: forall c. Show c => Int -> CmdInvokeFailReason c -> ShowS
showsPrec :: Int -> CmdInvokeFailReason c -> ShowS
$cshow :: forall c. Show c => CmdInvokeFailReason c -> String
show :: CmdInvokeFailReason c -> String
$cshowList :: forall c. Show c => [CmdInvokeFailReason c] -> ShowS
showList :: [CmdInvokeFailReason c] -> ShowS
Show)
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 :: forall (m :: * -> *) msg c a (r :: EffectRow).
(Monad m,
Members '[ParsePrefix msg, ConstructContext msg c m a, Embed m] r,
CommandContext m c a) =>
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 :: EffectRow).
Member (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 a b. Sem r a -> (a -> Sem r b) -> Sem r b
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 :: EffectRow).
(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 a. a -> Sem r 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 ->
T.Text ->
T.Text ->
P.Sem r (Either (CmdInvokeFailReason c) (c, a))
handleCommands :: forall (m :: * -> *) msg c a (r :: EffectRow).
(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
prefix Text
cmd = Sem (Error (CmdInvokeFailReason c) : r) (c, a)
-> Sem r (Either (CmdInvokeFailReason c) (c, a))
forall e (r :: EffectRow) 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 :: EffectRow) 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 :: EffectRow) 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 :: EffectRow).
Member (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 :: EffectRow) 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 :: EffectRow) 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 a. a -> Sem (Error (CmdInvokeFailReason c) : r) 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 :: forall (r :: EffectRow) c (m :: * -> *) a x.
(Monad m, MonadFix m, Member (Final m) r) =>
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 :: EffectRow) 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 a. a -> Sem (Fixpoint : r) a
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 T.Text (Group m c a, AliasType)
, (LH.HashMap T.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 :: EffectRow) 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 :: EffectRow) 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 :: EffectRow) 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 :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (k2 :: Symbol) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (Tagged k2 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 :: EffectRow) 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 :: EffectRow) 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 :: (* -> *) -> * -> *) (r :: EffectRow)
a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (k2 :: Symbol) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (Tagged k2 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 :: EffectRow) 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 o (r :: EffectRow) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap T.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 o (r :: EffectRow) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap T.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 :: T.Text -> (T.Text, T.Text)
nextWord :: Text -> (Text, Text)
nextWord = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripStart
findCommand :: forall c a m. CommandHandler m c a -> T.Text -> Either [T.Text] (Command m c a, T.Text)
findCommand :: forall c a (m :: * -> *).
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 :: (T.Text, T.Text) -> Either [T.Text] (Command m c a, T.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
x (CommandHandler m c a
handler CommandHandler m c a
-> Optic'
A_Lens
NoIx
(CommandHandler m c a)
(HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
A_Lens
NoIx
(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
x (CommandHandler m c a
handler CommandHandler m c a
-> Optic'
A_Lens
NoIx
(CommandHandler m c a)
(HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
A_Lens
NoIx
(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 a b.
Either [Text] a -> (a -> Either [Text] b) -> Either [Text] b
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 :: (T.Text, T.Text) -> Group m c a -> Either [T.Text] (Command m c a, T.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
x (Group m c a
g Group m c a
-> Optic'
A_Lens NoIx (Group m c a) (HashMap Text (Command m c a, AliasType))
-> HashMap Text (Command m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
A_Lens NoIx (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
x (Group m c a
g Group m c a
-> Optic'
A_Lens NoIx (Group m c a) (HashMap Text (Group m c a, AliasType))
-> HashMap Text (Group m c a, AliasType)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
A_Lens NoIx (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 a b.
Either [Text] a -> (a -> Either [Text] b) -> Either [Text] b
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 [T.Text] a
attachInitial :: forall a b. 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. T.Text -> Either [T.Text] a -> Either [T.Text] a
attachSoFar :: forall a. 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