{-# LANGUAGE RecursiveDo #-}
module Calamity.Commands.Utils
( addCommands
, buildCommands
, buildContext
, handleCommands
, findCommand
, CmdInvokeFailReason(..) ) where
import Calamity.Cache.Eff
import Calamity.Metrics.Eff
import Calamity.Client.Client
import Calamity.Client.Types
import Calamity.Commands.AliasType
import Calamity.Commands.Command
import Calamity.Commands.CommandUtils
import Calamity.Commands.Context
import Calamity.Commands.Dsl
import Calamity.Commands.Handler
import Calamity.Commands.Error
import Calamity.Commands.Group
import Calamity.Commands.ParsePrefix
import Calamity.Internal.LocalWriter
import Calamity.Internal.Utils
import Calamity.Types.Model.Channel
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Control.Lens hiding ( Context )
import Control.Monad
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 qualified Polysemy as P
import qualified Polysemy.Error 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
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
= NoContext
| NotFound [L.Text]
| CommandInvokeError Context CommandError
addCommands :: (BotC r, P.Member ParsePrefix r) => P.Sem (DSLState r) a -> P.Sem r (P.Sem r (), CommandHandler, a)
addCommands :: Sem (DSLState r) a -> Sem r (Sem r (), CommandHandler, a)
addCommands Sem (DSLState r) a
m = do
(CommandHandler
handler, a
res) <- Sem (DSLState r) a -> Sem r (CommandHandler, a)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
Sem (DSLState r) a -> Sem r (CommandHandler, a)
buildCommands Sem (DSLState r) a
m
Sem r ()
remove <- forall (r :: [(* -> *) -> * -> *]).
(BotC r, ReactConstraints 'MessageCreateEvt) =>
(EHType 'MessageCreateEvt -> Sem r ()) -> Sem r (Sem r ())
forall (s :: EventType) (r :: [(* -> *) -> * -> *]).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react @'MessageCreateEvt ((EHType 'MessageCreateEvt -> Sem r ()) -> Sem r (Sem r ()))
-> (EHType 'MessageCreateEvt -> Sem r ()) -> Sem r (Sem r ())
forall a b. (a -> b) -> a -> b
$ \EHType 'MessageCreateEvt
msg -> do
Message -> Sem r (Maybe (Text, Text))
forall (r :: [(* -> *) -> * -> *]).
MemberWithError ParsePrefix r =>
Message -> Sem r (Maybe (Text, Text))
parsePrefix Message
EHType 'MessageCreateEvt
msg Sem r (Maybe (Text, Text))
-> (Maybe (Text, Text) -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (Text
prefix, Text
cmd) -> do
Either CmdInvokeFailReason Context
r <- CommandHandler
-> Message
-> Text
-> Text
-> Sem r (Either CmdInvokeFailReason Context)
forall (r :: [(* -> *) -> * -> *]).
(BotC r, Member ParsePrefix r) =>
CommandHandler
-> Message
-> Text
-> Text
-> Sem r (Either CmdInvokeFailReason Context)
handleCommands CommandHandler
handler Message
EHType 'MessageCreateEvt
msg Text
prefix Text
cmd
case Either CmdInvokeFailReason Context
r of
Left (CommandInvokeError Context
ctx CommandError
e) -> CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (Context, CommandError) -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-error" (Context
ctx, CommandError
e)
Left (NotFound [Text]
path) -> CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (Message, [Text]) -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-not-found" (Message
EHType 'MessageCreateEvt
msg, [Text]
path)
Left CmdInvokeFailReason
NoContext -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right Context
ctx -> do
Counter
cmdInvoke <- Text -> [(Text, Text)] -> Sem r Counter
forall (r :: [(* -> *) -> * -> *]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter Text
"commands_invoked" [(Text
"name", [Text] -> Text
S.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
commandPath (Context
ctx Context -> Getting Command Context Command -> Command
forall s a. s -> Getting a s a -> a
^. IsLabel "command" (Getting Command Context Command)
Getting Command Context Command
#command))]
Sem r Int -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Int -> Sem r ()) -> Sem r Int -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Int -> Counter -> Sem r Int
forall (r :: [(* -> *) -> * -> *]).
MemberWithError MetricEff r =>
Int -> Counter -> Sem r Int
addCounter Int
1 Counter
cmdInvoke
CalamityEvent -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
CalamityEvent -> Sem r ()
fire (CalamityEvent -> Sem r ()) -> CalamityEvent -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Context -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-invoked" Context
ctx
Maybe (Text, Text)
Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Sem r (), CommandHandler, a)
-> Sem r (Sem r (), CommandHandler, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sem r ()
remove, CommandHandler
handler, a
res)
handleCommands :: (BotC r, P.Member ParsePrefix r)
=> CommandHandler
-> Message
-> L.Text
-> L.Text
-> P.Sem r (Either CmdInvokeFailReason Context)
handleCommands :: CommandHandler
-> Message
-> Text
-> Text
-> Sem r (Either CmdInvokeFailReason Context)
handleCommands CommandHandler
handler Message
msg Text
prefix Text
cmd = Sem (Error CmdInvokeFailReason : r) Context
-> Sem r (Either CmdInvokeFailReason Context)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error CmdInvokeFailReason : r) Context
-> Sem r (Either CmdInvokeFailReason Context))
-> Sem (Error CmdInvokeFailReason : r) Context
-> Sem r (Either CmdInvokeFailReason Context)
forall a b. (a -> b) -> a -> b
$ do
(Command
command, Text
unparsedParams) <- Either CmdInvokeFailReason (Command, Text)
-> Sem (Error CmdInvokeFailReason : r) (Command, Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either CmdInvokeFailReason (Command, Text)
-> Sem (Error CmdInvokeFailReason : r) (Command, Text))
-> Either CmdInvokeFailReason (Command, Text)
-> Sem (Error CmdInvokeFailReason : r) (Command, Text)
forall a b. (a -> b) -> a -> b
$ ([Text] -> CmdInvokeFailReason)
-> Either [Text] (Command, Text)
-> Either CmdInvokeFailReason (Command, Text)
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft [Text] -> CmdInvokeFailReason
NotFound (Either [Text] (Command, Text)
-> Either CmdInvokeFailReason (Command, Text))
-> Either [Text] (Command, Text)
-> Either CmdInvokeFailReason (Command, Text)
forall a b. (a -> b) -> a -> b
$ CommandHandler -> Text -> Either [Text] (Command, Text)
findCommand CommandHandler
handler Text
cmd
Context
ctx <- CmdInvokeFailReason
-> Maybe Context -> Sem (Error CmdInvokeFailReason : r) Context
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note CmdInvokeFailReason
NoContext (Maybe Context -> Sem (Error CmdInvokeFailReason : r) Context)
-> Sem (Error CmdInvokeFailReason : r) (Maybe Context)
-> Sem (Error CmdInvokeFailReason : r) Context
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message
-> Text
-> Command
-> Text
-> Sem (Error CmdInvokeFailReason : r) (Maybe Context)
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
Message -> Text -> Command -> Text -> Sem r (Maybe Context)
buildContext Message
msg Text
prefix Command
command Text
unparsedParams
Either CmdInvokeFailReason ()
-> Sem (Error CmdInvokeFailReason : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either CmdInvokeFailReason ()
-> Sem (Error CmdInvokeFailReason : r) ())
-> (Either CommandError () -> Either CmdInvokeFailReason ())
-> Either CommandError ()
-> Sem (Error CmdInvokeFailReason : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandError -> CmdInvokeFailReason)
-> Either CommandError () -> Either CmdInvokeFailReason ()
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft (Context -> CommandError -> CmdInvokeFailReason
CommandInvokeError Context
ctx) (Either CommandError () -> Sem (Error CmdInvokeFailReason : r) ())
-> Sem (Error CmdInvokeFailReason : r) (Either CommandError ())
-> Sem (Error CmdInvokeFailReason : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
-> Command
-> Sem (Error CmdInvokeFailReason : r) (Either CommandError ())
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Context -> Command -> Sem r (Either CommandError ())
invokeCommand Context
ctx (Context
ctx Context -> Getting Command Context Command -> Command
forall s a. s -> Getting a s a -> a
^. IsLabel "command" (Getting Command Context Command)
Getting Command Context Command
#command)
Context -> Sem (Error CmdInvokeFailReason : r) Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
ctx
buildCommands :: forall r a. P.Member (P.Final IO) r
=> P.Sem (DSLState r) a
-> P.Sem r (CommandHandler, a)
buildCommands :: Sem (DSLState r) a -> Sem r (CommandHandler, a)
buildCommands Sem (DSLState r) a
m = Sem (Fixpoint : r) (CommandHandler, a) -> Sem r (CommandHandler, a)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member (Final m) r, MonadFix m) =>
Sem (Fixpoint : r) a -> Sem r a
P.fixpointToFinal (Sem (Fixpoint : r) (CommandHandler, a)
-> Sem r (CommandHandler, a))
-> Sem (Fixpoint : r) (CommandHandler, a)
-> Sem r (CommandHandler, a)
forall a b. (a -> b) -> a -> b
$ mdo
(HashMap Text (Group, AliasType)
groups, (HashMap Text (Command, AliasType)
cmds, a
a)) <- CommandHandler
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
inner CommandHandler
handler Sem (DSLState r) a
m
let handler :: CommandHandler
handler = HashMap Text (Group, AliasType)
-> HashMap Text (Command, AliasType) -> CommandHandler
CommandHandler HashMap Text (Group, AliasType)
groups HashMap Text (Command, AliasType)
cmds
(CommandHandler, a) -> Sem (Fixpoint : r) (CommandHandler, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandHandler
handler, a
a)
where inner :: CommandHandler -> P.Sem (DSLState r) a
-> P.Sem (P.Fixpoint ': r) (LH.HashMap S.Text (Group, AliasType),
(LH.HashMap S.Text (Command, AliasType), a))
inner :: CommandHandler
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
inner CommandHandler
h =
CommandHandler
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader CommandHandler
h (Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Check]
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader [] (Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Context -> Text)
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Context -> Text
forall a b. IsString a => b -> a
defaultHelp (Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged "original-help" e : r) a -> Sem (e : r) a
P.untag @"original-help" (Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Context -> Text)
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Context -> Text
forall a b. IsString a => b -> a
defaultHelp (Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool
-> Sem
(Reader Bool
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Bool
False (Sem
(Reader Bool
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader Bool
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged "hidden" e : r) a -> Sem (e : r) a
P.untag @"hidden" (Sem
(Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Reader Bool
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Reader Bool
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe Group
-> Sem
(Reader (Maybe Group)
: Tagged "hidden" (Reader Bool) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Maybe Group
forall a. Maybe a
Nothing (Sem
(Reader (Maybe Group)
: Tagged "hidden" (Reader Bool) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
-> Sem
(Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(Reader (Maybe Group)
: Tagged "hidden" (Reader Bool) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> Sem (DSLState r) a
-> Sem
(Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text (Group, AliasType)) =>
Sem (LocalWriter (HashMap Text (Group, AliasType)) : r) a
-> Sem r (HashMap Text (Group, AliasType), a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Group, AliasType)) (Sem
(LocalWriter (HashMap Text (Group, AliasType))
: Reader (Maybe Group) : Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Command, AliasType), a)
-> Sem
(Reader (Maybe Group)
: Tagged "hidden" (Reader Bool) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a)))
-> (Sem (DSLState r) a
-> Sem
(LocalWriter (HashMap Text (Group, AliasType))
: Reader (Maybe Group) : Tagged "hidden" (Reader Bool)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Command, AliasType), a))
-> Sem (DSLState r) a
-> Sem
(Reader (Maybe Group)
: Tagged "hidden" (Reader Bool) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Group, AliasType),
(HashMap Text (Command, AliasType), a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text (Command, AliasType)) =>
Sem (LocalWriter (HashMap Text (Command, AliasType)) : r) a
-> Sem r (HashMap Text (Command, AliasType), a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text (Command, AliasType))
defaultHelp :: b -> a
defaultHelp = (a -> b -> a
forall a b. a -> b -> a
const a
"This command or group has no help.")
buildContext :: BotC r => Message -> L.Text -> Command -> L.Text -> P.Sem r (Maybe Context)
buildContext :: Message -> Text -> Command -> Text -> Sem r (Maybe Context)
buildContext Message
msg Text
prefix Command
command Text
unparsed = (Either String Context -> Maybe Context
forall e a. Either e a -> Maybe a
rightToMaybe (Either String Context -> Maybe Context)
-> Sem r (Either String Context) -> Sem r (Maybe Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem r (Either String Context) -> Sem r (Maybe Context))
-> (Sem (Fail : r) Context -> Sem r (Either String Context))
-> Sem (Fail : r) Context
-> Sem r (Maybe Context)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fail : r) Context -> Sem r (Either String Context)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail (Sem (Fail : r) Context -> Sem r (Maybe Context))
-> Sem (Fail : r) Context -> Sem r (Maybe Context)
forall a b. (a -> b) -> a -> b
$ do
Maybe Guild
guild <- Maybe (Maybe Guild) -> Maybe Guild
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Guild) -> Maybe Guild)
-> Sem (Fail : r) (Maybe (Maybe Guild))
-> Sem (Fail : r) (Maybe Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Snowflake Guild -> Sem (Fail : r) (Maybe Guild)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake Guild -> Sem r (Maybe Guild)
getGuild (Snowflake Guild -> Sem (Fail : r) (Maybe Guild))
-> Maybe (Snowflake Guild) -> Sem (Fail : r) (Maybe (Maybe Guild))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` (Message
msg Message
-> Getting
(Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall s a. s -> Getting a s a -> a
^. IsLabel
"guildID"
(Getting
(Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild)))
Getting (Maybe (Snowflake Guild)) Message (Maybe (Snowflake Guild))
#guildID)
let member :: Maybe Member
member = Maybe Guild
guild Maybe Guild
-> Getting (First Member) (Maybe Guild) Member -> Maybe Member
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Guild -> Const (First Member) Guild)
-> Maybe Guild -> Const (First Member) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First Member) Guild)
-> Maybe Guild -> Const (First Member) (Maybe Guild))
-> ((Member -> Const (First Member) Member)
-> Guild -> Const (First Member) Guild)
-> Getting (First Member) (Maybe Guild) Member
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
"members"
((SnowflakeMap Member
-> Const (First Member) (SnowflakeMap Member))
-> Guild -> Const (First Member) Guild)
(SnowflakeMap Member -> Const (First Member) (SnowflakeMap Member))
-> Guild -> Const (First Member) Guild
#members ((SnowflakeMap Member
-> Const (First Member) (SnowflakeMap Member))
-> Guild -> Const (First Member) Guild)
-> ((Member -> Const (First Member) Member)
-> SnowflakeMap Member
-> Const (First Member) (SnowflakeMap Member))
-> (Member -> Const (First Member) Member)
-> Guild
-> Const (First Member) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap Member)
-> Traversal' (SnowflakeMap Member) (IxValue (SnowflakeMap Member))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Snowflake User -> Snowflake Member
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake User -> Snowflake Member)
-> Snowflake User -> Snowflake Member
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID @User Message
msg)
let gchan :: Maybe GuildChannel
gchan = Maybe Guild
guild Maybe Guild
-> Getting (First GuildChannel) (Maybe Guild) GuildChannel
-> Maybe GuildChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Guild -> Const (First GuildChannel) Guild)
-> Maybe Guild -> Const (First GuildChannel) (Maybe Guild)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Guild -> Const (First GuildChannel) Guild)
-> Maybe Guild -> Const (First GuildChannel) (Maybe Guild))
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
-> Guild -> Const (First GuildChannel) Guild)
-> Getting (First GuildChannel) (Maybe Guild) GuildChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
"channels"
((SnowflakeMap GuildChannel
-> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> Guild -> Const (First GuildChannel) Guild)
(SnowflakeMap GuildChannel
-> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> Guild -> Const (First GuildChannel) Guild
#channels ((SnowflakeMap GuildChannel
-> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> Guild -> Const (First GuildChannel) Guild)
-> ((GuildChannel -> Const (First GuildChannel) GuildChannel)
-> SnowflakeMap GuildChannel
-> Const (First GuildChannel) (SnowflakeMap GuildChannel))
-> (GuildChannel -> Const (First GuildChannel) GuildChannel)
-> Guild
-> Const (First GuildChannel) Guild
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SnowflakeMap GuildChannel)
-> Traversal'
(SnowflakeMap GuildChannel) (IxValue (SnowflakeMap GuildChannel))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Snowflake Channel -> Snowflake GuildChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Channel -> Snowflake GuildChannel)
-> Snowflake Channel -> Snowflake GuildChannel
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel Message
msg)
Just Channel
channel <- case Maybe GuildChannel
gchan of
Just GuildChannel
chan -> Maybe Channel -> Sem (Fail : r) (Maybe Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Channel -> Sem (Fail : r) (Maybe Channel))
-> (Channel -> Maybe Channel)
-> Channel
-> Sem (Fail : r) (Maybe Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Maybe Channel
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Channel -> Sem (Fail : r) (Maybe Channel))
-> Channel -> Sem (Fail : r) (Maybe Channel)
forall a b. (a -> b) -> a -> b
$ GuildChannel -> Channel
GuildChannel' GuildChannel
chan
Maybe GuildChannel
Nothing -> DMChannel -> Channel
DMChannel' (DMChannel -> Channel)
-> Sem (Fail : r) (Maybe DMChannel)
-> Sem (Fail : r) (Maybe Channel)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Snowflake DMChannel -> Sem (Fail : r) (Maybe DMChannel)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake DMChannel -> Sem r (Maybe DMChannel)
getDM (Snowflake Channel -> Snowflake DMChannel
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Channel -> Snowflake DMChannel)
-> Snowflake Channel -> Snowflake DMChannel
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID @Channel Message
msg)
Just User
user <- Snowflake User -> Sem (Fail : r) (Maybe User)
forall (r :: [(* -> *) -> * -> *]).
MemberWithError CacheEff r =>
Snowflake User -> Sem r (Maybe User)
getUser (Snowflake User -> Sem (Fail : r) (Maybe User))
-> Snowflake User -> Sem (Fail : r) (Maybe User)
forall a b. (a -> b) -> a -> b
$ Message -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID Message
msg
Context -> Sem (Fail : r) Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context -> Sem (Fail : r) Context)
-> Context -> Sem (Fail : r) Context
forall a b. (a -> b) -> a -> b
$ Message
-> Maybe Guild
-> Maybe Member
-> Channel
-> User
-> Command
-> Text
-> Text
-> Context
Context Message
msg Maybe Guild
guild Maybe Member
member Channel
channel User
user Command
command Text
prefix Text
unparsed
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 :: CommandHandler -> L.Text -> Either [L.Text] (Command, L.Text)
findCommand :: CommandHandler -> Text -> Either [Text] (Command, Text)
findCommand CommandHandler
handler Text
msg = (Text, Text) -> Either [Text] (Command, Text)
goH ((Text, Text) -> Either [Text] (Command, Text))
-> (Text, Text) -> Either [Text] (Command, Text)
forall a b. (a -> b) -> a -> b
$ Text -> (Text, Text)
nextWord Text
msg
where
goH :: (L.Text, L.Text) -> Either [L.Text] (Command, L.Text)
goH :: (Text, Text) -> Either [Text] (Command, Text)
goH (Text
"", Text
_) = [Text] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
goH (Text
x, Text
xs) = Text
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar Text
x
(((, Text
xs) (Command -> (Command, Text))
-> Either [Text] Command -> Either [Text] (Command, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Command, AliasType) -> Either [Text] Command
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Command, AliasType) -> Maybe (Command, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
CommandHandler
(HashMap Text (Command, AliasType))
#commands)))
Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe (Group, AliasType) -> Either [Text] Group
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text -> HashMap Text (Group, AliasType) -> Maybe (Group, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (CommandHandler
handler CommandHandler
-> Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"groups"
(Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
CommandHandler
(HashMap Text (Group, AliasType))
#groups)) Either [Text] Group
-> (Group -> Either [Text] (Command, Text))
-> Either [Text] (Command, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group -> Either [Text] (Command, Text)
goG (Text -> (Text, Text)
nextWord Text
xs)))
goG :: (L.Text, L.Text) -> Group -> Either [L.Text] (Command, L.Text)
goG :: (Text, Text) -> Group -> Either [Text] (Command, Text)
goG (Text
"", Text
_) Group
_ = [Text] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
goG (Text
x, Text
xs) Group
g = Text
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Text -> Either [Text] a -> Either [Text] a
attachSoFar Text
x
(((, Text
xs) (Command -> (Command, Text))
-> Either [Text] Command -> Either [Text] (Command, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Command, AliasType) -> Either [Text] Command
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text
-> HashMap Text (Command, AliasType) -> Maybe (Command, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group
g Group
-> Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
-> HashMap Text (Command, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType)))
Getting
(HashMap Text (Command, AliasType))
Group
(HashMap Text (Command, AliasType))
#commands)))
Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe (Group, AliasType) -> Either [Text] Group
forall a b. Maybe (a, b) -> Either [Text] a
attachInitial (Text -> HashMap Text (Group, AliasType) -> Maybe (Group, AliasType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
LH.lookup (Text -> Text
L.toStrict Text
x) (Group
g Group
-> Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
-> HashMap Text (Group, AliasType)
forall s a. s -> Getting a s a -> a
^. IsLabel
"children"
(Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType)))
Getting
(HashMap Text (Group, AliasType))
Group
(HashMap Text (Group, AliasType))
#children)) Either [Text] Group
-> (Group -> Either [Text] (Command, Text))
-> Either [Text] (Command, Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Text) -> Group -> Either [Text] (Command, Text)
goG (Text -> (Text, Text)
nextWord Text
xs)))
attachInitial :: 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 :: 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
cmdText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
attachSoFar Text
_ Either [Text] a
r = Either [Text] a
r