{-# LANGUAGE RecursiveDo #-}
module Calamity.Commands.Utils
( addCommands
, buildCommands
, buildContext ) 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 f :: e -> e'
f (Left x :: 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 _ (Right x :: a
x) = a -> Either e' a
forall a b. b -> Either a b
Right a
x
data FailReason
= NoPrefix
| NoCtx
| NF [L.Text]
| ERR 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 m :: Sem (DSLState r) a
m = do
(handler :: CommandHandler
handler, res :: 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
$ \msg :: EHType 'MessageCreateEvt
msg -> do
Either FailReason Context
err <- Sem (Error FailReason : r) Context
-> Sem r (Either FailReason Context)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error FailReason : r) Context
-> Sem r (Either FailReason Context))
-> Sem (Error FailReason : r) Context
-> Sem r (Either FailReason Context)
forall a b. (a -> b) -> a -> b
$ do
(prefix :: Text
prefix, rest :: Text
rest) <- FailReason
-> Maybe (Text, Text) -> Sem (Error FailReason : r) (Text, Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note FailReason
NoPrefix (Maybe (Text, Text) -> Sem (Error FailReason : r) (Text, Text))
-> Sem (Error FailReason : r) (Maybe (Text, Text))
-> Sem (Error FailReason : r) (Text, Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message -> Sem (Error FailReason : r) (Maybe (Text, Text))
forall (r :: [(* -> *) -> * -> *]).
MemberWithError ParsePrefix r =>
Message -> Sem r (Maybe (Text, Text))
parsePrefix Message
EHType 'MessageCreateEvt
msg
(command :: Command
command, unparsedParams :: Text
unparsedParams) <- Either FailReason (Command, Text)
-> Sem (Error FailReason : r) (Command, Text)
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either FailReason (Command, Text)
-> Sem (Error FailReason : r) (Command, Text))
-> Either FailReason (Command, Text)
-> Sem (Error FailReason : r) (Command, Text)
forall a b. (a -> b) -> a -> b
$ ([Text] -> FailReason)
-> Either [Text] (Command, Text)
-> Either FailReason (Command, Text)
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft [Text] -> FailReason
NF (Either [Text] (Command, Text)
-> Either FailReason (Command, Text))
-> Either [Text] (Command, Text)
-> Either FailReason (Command, Text)
forall a b. (a -> b) -> a -> b
$ CommandHandler -> Text -> Either [Text] (Command, Text)
findCommand CommandHandler
handler Text
rest
Context
ctx <- FailReason -> Maybe Context -> Sem (Error FailReason : r) Context
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
P.note FailReason
NoCtx (Maybe Context -> Sem (Error FailReason : r) Context)
-> Sem (Error FailReason : r) (Maybe Context)
-> Sem (Error FailReason : r) Context
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Message
-> Text
-> Command
-> Text
-> Sem (Error FailReason : r) (Maybe Context)
forall (r :: [(* -> *) -> * -> *]).
BotC r =>
Message -> Text -> Command -> Text -> Sem r (Maybe Context)
buildContext Message
EHType 'MessageCreateEvt
msg Text
prefix Command
command Text
unparsedParams
Either FailReason () -> Sem (Error FailReason : r) ()
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
Either e a -> Sem r a
P.fromEither (Either FailReason () -> Sem (Error FailReason : r) ())
-> (Either CommandError () -> Either FailReason ())
-> Either CommandError ()
-> Sem (Error FailReason : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandError -> FailReason)
-> Either CommandError () -> Either FailReason ()
forall e e' a. (e -> e') -> Either e a -> Either e' a
mapLeft (Context -> CommandError -> FailReason
ERR Context
ctx) (Either CommandError () -> Sem (Error FailReason : r) ())
-> Sem (Error FailReason : r) (Either CommandError ())
-> Sem (Error FailReason : r) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context
-> Command -> Sem (Error FailReason : 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 FailReason : r) Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
ctx
case Either FailReason Context
err of
Left (ERR ctx :: Context
ctx e :: 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 (NF path :: [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
$ [Text] -> CalamityEvent
forall k (s :: k) a. (Typeable s, Typeable a) => a -> CalamityEvent
customEvt @"command-not-found" [Text]
path
Left _ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right ctx :: Context
ctx -> do
Counter
cmdInvoke <- Text -> [(Text, Text)] -> Sem r Counter
forall (r :: [(* -> *) -> * -> *]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter "commands_invoked" [("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 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
(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)
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 m :: 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
(groups :: HashMap Text (Group, AliasType)
groups, (cmds :: HashMap Text (Command, AliasType)
cmds, a :: 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 h :: 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
.
Maybe Group
-> Sem
(Reader (Maybe Group)
: 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 Maybe Group
forall a. Maybe a
Nothing (Sem
(Reader (Maybe Group)
: 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 (Maybe Group)
: 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 (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) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text (Command, AliasType), a)
-> Sem
(Reader (Maybe Group)
: 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) : 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)
: 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 "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 msg :: Message
msg prefix :: Text
prefix command :: Command
command unparsed :: 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 -> Index (SnowflakeMap Member)
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake User -> Index (SnowflakeMap Member))
-> Snowflake User -> Index (SnowflakeMap 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 -> Index (SnowflakeMap GuildChannel)
forall a b. Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Channel -> Index (SnowflakeMap GuildChannel))
-> Snowflake Channel -> Index (SnowflakeMap 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
channel <- case Maybe GuildChannel
gchan of
Just chan :: 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
_ -> 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
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 handler :: CommandHandler
handler msg :: 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] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
goH (x :: Text
x, xs :: 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] -> Either [Text] (Command, Text)
forall a b. a -> Either a b
Left []
goG (x :: Text
x, xs :: Text
xs) g :: 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
a, _)) = a -> Either [Text] a
forall a b. b -> Either a b
Right a
a
attachInitial 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 cmd :: Text
cmd (Left xs :: [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 _ r :: Either [Text] a
r = Either [Text] a
r