{-# 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.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 :: [(* -> *) -> * -> *]) t eh ehIO.
(BotC r, ReactConstraints r 'MessageCreateEvt eh ehIO t) =>
EHType 'MessageCreateEvt (Sem r) () -> Sem r (Sem r ())
forall (s :: EventType) (r :: [(* -> *) -> * -> *]) t eh ehIO.
(BotC r, ReactConstraints r s eh ehIO t) =>
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 :: Message
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
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
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
groups, (cmds :: HashMap Text Command
cmds, a :: a
a)) <- CommandHandler
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
inner CommandHandler
handler Sem (DSLState r) a
m
let handler :: CommandHandler
handler = HashMap Text Group -> HashMap Text Command -> CommandHandler
CommandHandler HashMap Text Group
groups HashMap Text Command
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, (LH.HashMap S.Text Command, a))
inner :: CommandHandler
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
inner h :: CommandHandler
h =
CommandHandler
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a))
-> Sem
(Fixpoint : r) (HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Fixpoint : r) (HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Check]
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a))
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a))
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, 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, (HashMap Text Command, a)))
-> Sem (DSLState r) a
-> Sem
(Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text Group) =>
Sem (LocalWriter (HashMap Text Group) : r) a
-> Sem r (HashMap Text Group, a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text Group) (Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Command, a)
-> Sem
(Reader (Maybe Group)
: Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Group, (HashMap Text Command, a)))
-> (Sem (DSLState r) a
-> Sem
(LocalWriter (HashMap Text Group)
: Reader (Maybe Group) : Reader (Context -> Text)
: Tagged "original-help" (Reader (Context -> Text))
: Reader [Check] : Reader CommandHandler : Fixpoint : r)
(HashMap Text Command, 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, (HashMap Text Command, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]) a.
Monoid (HashMap Text Command) =>
Sem (LocalWriter (HashMap Text Command) : r) a
-> Sem r (HashMap Text Command, a)
forall o (r :: [(* -> *) -> * -> *]) a.
Monoid o =>
Sem (LocalWriter o : r) a -> Sem r (o, a)
runLocalWriter @(LH.HashMap S.Text Command)
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 -> Either [Text] Command
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Command -> Maybe Command
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) CommandHandler (HashMap Text Command)
-> HashMap Text Command
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting
(HashMap Text Command) CommandHandler (HashMap Text Command))
Getting
(HashMap Text Command) CommandHandler (HashMap Text Command)
#commands)))
Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe Group -> Either [Text] Group
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Group -> Maybe Group
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) CommandHandler (HashMap Text Group)
-> HashMap Text Group
forall s a. s -> Getting a s a -> a
^. IsLabel
"groups"
(Getting (HashMap Text Group) CommandHandler (HashMap Text Group))
Getting (HashMap Text Group) CommandHandler (HashMap Text Group)
#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 -> Either [Text] Command
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Command -> Maybe Command
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) Group (HashMap Text Command)
-> HashMap Text Command
forall s a. s -> Getting a s a -> a
^. IsLabel
"commands"
(Getting (HashMap Text Command) Group (HashMap Text Command))
Getting (HashMap Text Command) Group (HashMap Text Command)
#commands)))
Either [Text] (Command, Text)
-> Either [Text] (Command, Text) -> Either [Text] (Command, Text)
forall a. Semigroup a => a -> a -> a
<> (Maybe Group -> Either [Text] Group
forall a. Maybe a -> Either [Text] a
attachInitial (Text -> HashMap Text Group -> Maybe Group
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) Group (HashMap Text Group)
-> HashMap Text Group
forall s a. s -> Getting a s a -> a
^. IsLabel
"children"
(Getting (HashMap Text Group) Group (HashMap Text Group))
Getting (HashMap Text Group) Group (HashMap Text Group)
#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 -> Either [L.Text] a
attachInitial :: Maybe a -> 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