-- | Command invokation context
module Calamity.Commands.Context
    ( Context(..) ) where

import {-# SOURCE #-} Calamity.Commands.Command
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 Data.Text.Lazy               as L

import           GHC.Generics

import           TextShow
import qualified TextShow.Generic             as TSG

-- | Invokation context for commands
data Context = Context
  { Context -> Message
message        :: Message
    -- ^ The message that the command was invoked from
  , Context -> Maybe Guild
guild          :: Maybe Guild
    -- ^ If the command was sent in a guild, this will be present
  , Context -> Maybe Member
member         :: Maybe Member
    -- ^ The member that invoked the command, if in a guild
  , Context -> Channel
channel        :: Channel
    -- ^ The channel the command was invoked from
  , Context -> User
user           :: User
    -- ^ The user that invoked the command
  , Context -> Command
command        :: Command
    -- ^ The command that was invoked
  , Context -> Text
prefix         :: L.Text
    -- ^ The prefix that was used to invoke the command
  , Context -> Text
unparsedParams :: L.Text
    -- ^ The message remaining after consuming the prefix
  }
  deriving ( Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, (forall x. Context -> Rep Context x)
-> (forall x. Rep Context x -> Context) -> Generic Context
forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Context x -> Context
$cfrom :: forall x. Context -> Rep Context x
Generic )
  deriving ( Int -> Context -> Builder
Int -> Context -> Text
Int -> Context -> Text
[Context] -> Builder
[Context] -> Text
[Context] -> Text
Context -> Builder
Context -> Text
Context -> Text
(Int -> Context -> Builder)
-> (Context -> Builder)
-> ([Context] -> Builder)
-> (Int -> Context -> Text)
-> (Context -> Text)
-> ([Context] -> Text)
-> (Int -> Context -> Text)
-> (Context -> Text)
-> ([Context] -> Text)
-> TextShow Context
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 :: [Context] -> Text
$cshowtlList :: [Context] -> Text
showtl :: Context -> Text
$cshowtl :: Context -> Text
showtlPrec :: Int -> Context -> Text
$cshowtlPrec :: Int -> Context -> Text
showtList :: [Context] -> Text
$cshowtList :: [Context] -> Text
showt :: Context -> Text
$cshowt :: Context -> Text
showtPrec :: Int -> Context -> Text
$cshowtPrec :: Int -> Context -> Text
showbList :: [Context] -> Builder
$cshowbList :: [Context] -> Builder
showb :: Context -> Builder
$cshowb :: Context -> Builder
showbPrec :: Int -> Context -> Builder
$cshowbPrec :: Int -> Context -> Builder
TextShow ) via TSG.FromGeneric Context

instance Tellable Context where
  getChannel :: Context -> Sem r (Snowflake Channel)
getChannel Context { Channel
channel :: Channel
$sel:channel:Context :: Context -> Channel
channel } = Snowflake Channel -> Sem r (Snowflake Channel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snowflake Channel -> Sem r (Snowflake Channel))
-> (Channel -> Snowflake Channel)
-> Channel
-> Sem r (Snowflake Channel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Snowflake Channel
forall b a. HasID b a => a -> Snowflake b
getID (Channel -> Sem r (Snowflake Channel))
-> Channel -> Sem r (Snowflake Channel)
forall a b. (a -> b) -> a -> b
$ Channel
channel