-- | Command invokation context
module Calamity.Commands.Context (
  CalamityCommandContext (..),
  FullContext (..),
  useFullContext,
  LightContext (..),
  useLightContext,
) where

import Calamity.Cache.Eff
import Calamity.Commands.Types
import Calamity.Internal.Utils
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import Calamity.Types.Tellable
import qualified CalamityCommands.Context as CC
import Control.Applicative
import Control.Lens hiding (Context)
import Control.Monad
import qualified Data.Text as T
import GHC.Generics
import qualified Polysemy as P
import qualified Polysemy.Fail as P
import TextShow
import qualified TextShow.Generic as TSG

class CommandContext c => CalamityCommandContext c where
  -- | The id of the channel that invoked this command
  ctxChannelID :: c -> Snowflake Channel

  -- | The id of the guild the command was invoked in, if in a guild
  ctxGuildID :: c -> Maybe (Snowflake Guild)

  -- | The id of the user that invoked this command
  ctxUserID :: c -> Snowflake User

  -- | The message that triggered this command
  ctxMessage :: c -> Message

-- | Invokation context for commands
data FullContext = FullContext
  { -- | The message that the command was invoked from
    FullContext -> Message
message :: Message
  , -- | If the command was sent in a guild, this will be present
    FullContext -> Maybe Guild
guild :: Maybe Guild
  , -- | The member that invoked the command, if in a guild
    --
    -- Note: If discord sent a member with the message, this is used; otherwise
    -- we try to fetch the member from the cache.
    FullContext -> Maybe Member
member :: Maybe Member
  , -- | The channel the command was invoked from
    FullContext -> Channel
channel :: Channel
  , -- | The user that invoked the command
    FullContext -> User
user :: User
  , -- | The command that was invoked
    FullContext -> Command FullContext
command :: Command FullContext
  , -- | The prefix that was used to invoke the command
    FullContext -> Text
prefix :: T.Text
  , -- | The message remaining after consuming the prefix
    FullContext -> Text
unparsedParams :: T.Text
  }
  deriving (Int -> FullContext -> ShowS
[FullContext] -> ShowS
FullContext -> String
(Int -> FullContext -> ShowS)
-> (FullContext -> String)
-> ([FullContext] -> ShowS)
-> Show FullContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullContext] -> ShowS
$cshowList :: [FullContext] -> ShowS
show :: FullContext -> String
$cshow :: FullContext -> String
showsPrec :: Int -> FullContext -> ShowS
$cshowsPrec :: Int -> FullContext -> ShowS
Show, (forall x. FullContext -> Rep FullContext x)
-> (forall x. Rep FullContext x -> FullContext)
-> Generic FullContext
forall x. Rep FullContext x -> FullContext
forall x. FullContext -> Rep FullContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FullContext x -> FullContext
$cfrom :: forall x. FullContext -> Rep FullContext x
Generic)
  deriving (Int -> FullContext -> Builder
Int -> FullContext -> Text
Int -> FullContext -> Text
[FullContext] -> Builder
[FullContext] -> Text
[FullContext] -> Text
FullContext -> Builder
FullContext -> Text
FullContext -> Text
(Int -> FullContext -> Builder)
-> (FullContext -> Builder)
-> ([FullContext] -> Builder)
-> (Int -> FullContext -> Text)
-> (FullContext -> Text)
-> ([FullContext] -> Text)
-> (Int -> FullContext -> Text)
-> (FullContext -> Text)
-> ([FullContext] -> Text)
-> TextShow FullContext
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [FullContext] -> Text
$cshowtlList :: [FullContext] -> Text
showtl :: FullContext -> Text
$cshowtl :: FullContext -> Text
showtlPrec :: Int -> FullContext -> Text
$cshowtlPrec :: Int -> FullContext -> Text
showtList :: [FullContext] -> Text
$cshowtList :: [FullContext] -> Text
showt :: FullContext -> Text
$cshowt :: FullContext -> Text
showtPrec :: Int -> FullContext -> Text
$cshowtPrec :: Int -> FullContext -> Text
showbList :: [FullContext] -> Builder
$cshowbList :: [FullContext] -> Builder
showb :: FullContext -> Builder
$cshowb :: FullContext -> Builder
showbPrec :: Int -> FullContext -> Builder
$cshowbPrec :: Int -> FullContext -> Builder
TextShow) via TSG.FromGeneric FullContext
  deriving (HasID Channel) via HasIDField "channel" FullContext
  deriving (HasID Message) via HasIDField "message" FullContext
  deriving (HasID User) via HasIDField "user" FullContext

instance CC.CommandContext IO FullContext () where
  ctxPrefix :: FullContext -> Text
ctxPrefix = (FullContext -> Getting Text FullContext Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "prefix" (Getting Text FullContext Text)
Getting Text FullContext Text
#prefix)
  ctxCommand :: FullContext -> Command FullContext
ctxCommand = (FullContext
-> Getting (Command FullContext) FullContext (Command FullContext)
-> Command FullContext
forall s a. s -> Getting a s a -> a
^. IsLabel
  "command"
  (Getting (Command FullContext) FullContext (Command FullContext))
Getting (Command FullContext) FullContext (Command FullContext)
#command)
  ctxUnparsedParams :: FullContext -> Text
ctxUnparsedParams = (FullContext -> Getting Text FullContext Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "unparsedParams" (Getting Text FullContext Text)
Getting Text FullContext Text
#unparsedParams)

instance CalamityCommandContext FullContext where
  ctxChannelID :: FullContext -> Snowflake Channel
ctxChannelID = Channel -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID (Channel -> Snowflake Channel)
-> (FullContext -> Channel) -> FullContext -> Snowflake Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FullContext -> Getting Channel FullContext Channel -> Channel
forall s a. s -> Getting a s a -> a
^. IsLabel "channel" (Getting Channel FullContext Channel)
Getting Channel FullContext Channel
#channel)
  ctxGuildID :: FullContext -> Maybe (Snowflake Guild)
ctxGuildID FullContext
c = Guild -> Snowflake Guild
forall b a. HasID b a => a -> Snowflake b
getID (Guild -> Snowflake Guild)
-> Maybe Guild -> Maybe (Snowflake Guild)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FullContext
c FullContext
-> Getting (Maybe Guild) FullContext (Maybe Guild) -> Maybe Guild
forall s a. s -> Getting a s a -> a
^. IsLabel "guild" (Getting (Maybe Guild) FullContext (Maybe Guild))
Getting (Maybe Guild) FullContext (Maybe Guild)
#guild
  ctxUserID :: FullContext -> Snowflake User
ctxUserID = User -> Snowflake User
forall b a. HasID b a => a -> Snowflake b
getID (User -> Snowflake User)
-> (FullContext -> User) -> FullContext -> Snowflake User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FullContext -> Getting User FullContext User -> User
forall s a. s -> Getting a s a -> a
^. IsLabel "user" (Getting User FullContext User)
Getting User FullContext User
#user)
  ctxMessage :: FullContext -> Message
ctxMessage = (FullContext -> Getting Message FullContext Message -> Message
forall s a. s -> Getting a s a -> a
^. IsLabel "message" (Getting Message FullContext Message)
Getting Message FullContext Message
#message)

instance Tellable FullContext where
  getChannel :: FullContext -> Sem r (Snowflake Channel)
getChannel = Snowflake Channel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake Channel -> Sem r (Snowflake Channel))
-> (FullContext -> Snowflake Channel)
-> FullContext
-> Sem r (Snowflake Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullContext -> Snowflake Channel
forall c. CalamityCommandContext c => c -> Snowflake Channel
ctxChannelID

useFullContext :: P.Member CacheEff r => P.Sem (CC.ConstructContext (Message, User, Maybe Member) FullContext IO () ': r) a -> P.Sem r a
useFullContext :: Sem
  (ConstructContext (Message, User, Maybe Member) FullContext IO ()
     : r)
  a
-> Sem r a
useFullContext =
  (forall (rInitial :: EffectRow) x.
 ConstructContext
   (Message, User, Maybe Member) FullContext IO () (Sem rInitial) x
 -> Sem r x)
-> Sem
     (ConstructContext (Message, User, Maybe Member) FullContext IO ()
        : r)
     a
-> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
    ( \case
        CC.ConstructContext (pre, cmd, up) (msg, usr, mem) -> Message
-> User
-> Maybe Member
-> Text
-> Command FullContext
-> Text
-> Sem r (Maybe FullContext)
forall (r :: EffectRow).
Member CacheEff r =>
Message
-> User
-> Maybe Member
-> Text
-> Command FullContext
-> Text
-> Sem r (Maybe FullContext)
buildContext Message
msg User
usr Maybe Member
mem Text
pre Command FullContext
cmd Text
up
    )

buildContext :: P.Member CacheEff r => Message -> User -> Maybe Member -> T.Text -> Command FullContext -> T.Text -> P.Sem r (Maybe FullContext)
buildContext :: Message
-> User
-> Maybe Member
-> Text
-> Command FullContext
-> Text
-> Sem r (Maybe FullContext)
buildContext Message
msg User
usr Maybe Member
mem Text
prefix Command FullContext
command Text
unparsed = (Either String FullContext -> Maybe FullContext
forall e a. Either e a -> Maybe a
rightToMaybe (Either String FullContext -> Maybe FullContext)
-> Sem r (Either String FullContext) -> Sem r (Maybe FullContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Sem r (Either String FullContext) -> Sem r (Maybe FullContext))
-> (Sem (Fail : r) FullContext
    -> Sem r (Either String FullContext))
-> Sem (Fail : r) FullContext
-> Sem r (Maybe FullContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Fail : r) FullContext -> Sem r (Either String FullContext)
forall (r :: EffectRow) a.
Sem (Fail : r) a -> Sem r (Either String a)
P.runFail (Sem (Fail : r) FullContext -> Sem r (Maybe FullContext))
-> Sem (Fail : r) FullContext -> Sem r (Maybe FullContext)
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 :: EffectRow).
Member 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 Member
mem Maybe Member -> Maybe Member -> Maybe Member
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 :: EffectRow).
Member 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)

  FullContext -> Sem (Fail : r) FullContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FullContext -> Sem (Fail : r) FullContext)
-> FullContext -> Sem (Fail : r) FullContext
forall a b. (a -> b) -> a -> b
$ Message
-> Maybe Guild
-> Maybe Member
-> Channel
-> User
-> Command FullContext
-> Text
-> Text
-> FullContext
FullContext Message
msg Maybe Guild
guild Maybe Member
member Channel
channel User
usr Command FullContext
command Text
prefix Text
unparsed

-- | A lightweight context that doesn't need any cache information
data LightContext = LightContext
  { -- | The message that the command was invoked from
    LightContext -> Message
message :: Message
  , -- | If the command was sent in a guild, this will be present
    LightContext -> Maybe (Snowflake Guild)
guildID :: Maybe (Snowflake Guild)
  , -- | The channel the command was invoked from
    LightContext -> Snowflake Channel
channelID :: Snowflake Channel
  , -- | The user that invoked the command
    LightContext -> User
user :: User
  , -- | The member that triggered the command.
    --
    -- Note: Only sent if discord sent the member object with the message.
    LightContext -> Maybe Member
member :: Maybe Member
  , -- | The command that was invoked
    LightContext -> Command LightContext
command :: Command LightContext
  , -- | The prefix that was used to invoke the command
    LightContext -> Text
prefix :: T.Text
  , -- | The message remaining after consuming the prefix
    LightContext -> Text
unparsedParams :: T.Text
  }
  deriving (Int -> LightContext -> ShowS
[LightContext] -> ShowS
LightContext -> String
(Int -> LightContext -> ShowS)
-> (LightContext -> String)
-> ([LightContext] -> ShowS)
-> Show LightContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LightContext] -> ShowS
$cshowList :: [LightContext] -> ShowS
show :: LightContext -> String
$cshow :: LightContext -> String
showsPrec :: Int -> LightContext -> ShowS
$cshowsPrec :: Int -> LightContext -> ShowS
Show, (forall x. LightContext -> Rep LightContext x)
-> (forall x. Rep LightContext x -> LightContext)
-> Generic LightContext
forall x. Rep LightContext x -> LightContext
forall x. LightContext -> Rep LightContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LightContext x -> LightContext
$cfrom :: forall x. LightContext -> Rep LightContext x
Generic)
  deriving (Int -> LightContext -> Builder
Int -> LightContext -> Text
Int -> LightContext -> Text
[LightContext] -> Builder
[LightContext] -> Text
[LightContext] -> Text
LightContext -> Builder
LightContext -> Text
LightContext -> Text
(Int -> LightContext -> Builder)
-> (LightContext -> Builder)
-> ([LightContext] -> Builder)
-> (Int -> LightContext -> Text)
-> (LightContext -> Text)
-> ([LightContext] -> Text)
-> (Int -> LightContext -> Text)
-> (LightContext -> Text)
-> ([LightContext] -> Text)
-> TextShow LightContext
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [LightContext] -> Text
$cshowtlList :: [LightContext] -> Text
showtl :: LightContext -> Text
$cshowtl :: LightContext -> Text
showtlPrec :: Int -> LightContext -> Text
$cshowtlPrec :: Int -> LightContext -> Text
showtList :: [LightContext] -> Text
$cshowtList :: [LightContext] -> Text
showt :: LightContext -> Text
$cshowt :: LightContext -> Text
showtPrec :: Int -> LightContext -> Text
$cshowtPrec :: Int -> LightContext -> Text
showbList :: [LightContext] -> Builder
$cshowbList :: [LightContext] -> Builder
showb :: LightContext -> Builder
$cshowb :: LightContext -> Builder
showbPrec :: Int -> LightContext -> Builder
$cshowbPrec :: Int -> LightContext -> Builder
TextShow) via TSG.FromGeneric LightContext
  deriving (HasID Channel) via HasIDField "channelID" LightContext
  deriving (HasID Message) via HasIDField "message" LightContext
  deriving (HasID User) via HasIDField "user" LightContext

instance CC.CommandContext IO LightContext () where
  ctxPrefix :: LightContext -> Text
ctxPrefix = (LightContext -> Getting Text LightContext Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "prefix" (Getting Text LightContext Text)
Getting Text LightContext Text
#prefix)
  ctxCommand :: LightContext -> Command LightContext
ctxCommand = (LightContext
-> Getting
     (Command LightContext) LightContext (Command LightContext)
-> Command LightContext
forall s a. s -> Getting a s a -> a
^. IsLabel
  "command"
  (Getting
     (Command LightContext) LightContext (Command LightContext))
Getting (Command LightContext) LightContext (Command LightContext)
#command)
  ctxUnparsedParams :: LightContext -> Text
ctxUnparsedParams = (LightContext -> Getting Text LightContext Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "unparsedParams" (Getting Text LightContext Text)
Getting Text LightContext Text
#unparsedParams)

instance CalamityCommandContext LightContext where
  ctxChannelID :: LightContext -> Snowflake Channel
ctxChannelID = (LightContext
-> Getting (Snowflake Channel) LightContext (Snowflake Channel)
-> Snowflake Channel
forall s a. s -> Getting a s a -> a
^. IsLabel
  "channelID"
  (Getting (Snowflake Channel) LightContext (Snowflake Channel))
Getting (Snowflake Channel) LightContext (Snowflake Channel)
#channelID)
  ctxGuildID :: LightContext -> Maybe (Snowflake Guild)
ctxGuildID = (LightContext
-> Getting
     (Maybe (Snowflake Guild)) LightContext (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "guildID"
  (Getting
     (Maybe (Snowflake Guild)) LightContext (Maybe (Snowflake Guild)))
Getting
  (Maybe (Snowflake Guild)) LightContext (Maybe (Snowflake Guild))
#guildID)
  ctxUserID :: LightContext -> Snowflake User
ctxUserID = (LightContext
-> Getting (Snowflake User) LightContext (Snowflake User)
-> Snowflake User
forall s a. s -> Getting a s a -> a
^. IsLabel
  "user"
  ((User -> Const (Snowflake User) User)
   -> LightContext -> Const (Snowflake User) LightContext)
(User -> Const (Snowflake User) User)
-> LightContext -> Const (Snowflake User) LightContext
#user ((User -> Const (Snowflake User) User)
 -> LightContext -> Const (Snowflake User) LightContext)
-> ((Snowflake User -> Const (Snowflake User) (Snowflake User))
    -> User -> Const (Snowflake User) User)
-> Getting (Snowflake User) LightContext (Snowflake User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "id"
  ((Snowflake User -> Const (Snowflake User) (Snowflake User))
   -> User -> Const (Snowflake User) User)
(Snowflake User -> Const (Snowflake User) (Snowflake User))
-> User -> Const (Snowflake User) User
#id)
  ctxMessage :: LightContext -> Message
ctxMessage = (LightContext -> Getting Message LightContext Message -> Message
forall s a. s -> Getting a s a -> a
^. IsLabel "message" (Getting Message LightContext Message)
Getting Message LightContext Message
#message)

instance Tellable LightContext where
  getChannel :: LightContext -> Sem r (Snowflake Channel)
getChannel = Snowflake Channel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake Channel -> Sem r (Snowflake Channel))
-> (LightContext -> Snowflake Channel)
-> LightContext
-> Sem r (Snowflake Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LightContext -> Snowflake Channel
forall c. CalamityCommandContext c => c -> Snowflake Channel
ctxChannelID

useLightContext :: P.Sem (CC.ConstructContext (Message, User, Maybe Member) LightContext IO () ': r) a -> P.Sem r a
useLightContext :: Sem
  (ConstructContext (Message, User, Maybe Member) LightContext IO ()
     : r)
  a
-> Sem r a
useLightContext =
  (forall (rInitial :: EffectRow) x.
 ConstructContext
   (Message, User, Maybe Member) LightContext IO () (Sem rInitial) x
 -> Sem r x)
-> Sem
     (ConstructContext (Message, User, Maybe Member) LightContext IO ()
        : r)
     a
-> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
    ( \case
        CC.ConstructContext (pre, cmd, up) (msg, usr, mem) ->
          Maybe LightContext -> Sem r (Maybe LightContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LightContext -> Sem r (Maybe LightContext))
-> (LightContext -> Maybe LightContext)
-> LightContext
-> Sem r (Maybe LightContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LightContext -> Maybe LightContext
forall a. a -> Maybe a
Just (LightContext -> Sem r (Maybe LightContext))
-> LightContext -> Sem r (Maybe LightContext)
forall a b. (a -> b) -> a -> b
$ Message
-> Maybe (Snowflake Guild)
-> Snowflake Channel
-> User
-> Maybe Member
-> Command LightContext
-> Text
-> Text
-> LightContext
LightContext Message
msg (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) (Message
msg Message
-> Getting (Snowflake Channel) Message (Snowflake Channel)
-> Snowflake Channel
forall s a. s -> Getting a s a -> a
^. IsLabel
  "channelID"
  (Getting (Snowflake Channel) Message (Snowflake Channel))
Getting (Snowflake Channel) Message (Snowflake Channel)
#channelID) User
usr Maybe Member
mem Command LightContext
cmd Text
pre Text
up
    )