{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

module Discord.Internal.Types.Interactions
  ( Interaction (..),
    ComponentData (..),
    ApplicationCommandData (..),
    OptionsData (..),
    OptionDataSubcommandOrGroup (..),
    OptionDataSubcommand (..),
    OptionDataValue (..),
    InteractionToken,
    ResolvedData (..),
    MemberOrUser (..),
    InteractionResponse (..),
    interactionResponseBasic,
    InteractionResponseAutocomplete (..),
    InteractionResponseMessage (..),
    interactionResponseMessageBasic,
    InteractionResponseMessageFlags (..),
    InteractionResponseMessageFlag (..),
    InteractionResponseModalData (..),
  )
where

import Control.Applicative (Alternative ((<|>)))
import Control.Monad (join)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Bits (Bits (shift, (.|.)))
import Data.Foldable (Foldable (toList))
import qualified Data.Text as T
import Discord.Internal.Types.ApplicationCommands (Choice, Number)
import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)
import Discord.Internal.Types.Components (ActionRow, TextInput)
import Discord.Internal.Types.Embed (CreateEmbed, createEmbed)
import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId, objectFromMaybes, (.=?))
import Discord.Internal.Types.User (GuildMember, User)

-- | An interaction received from discord.
data Interaction
  = InteractionComponent
      { -- | The id of this interaction.
        Interaction -> InteractionId
interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        Interaction -> ApplicationId
interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> ComponentData
componentData :: ComponentData,
        -- | What guild this interaction comes from.
        Interaction -> Maybe GuildId
interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        Interaction -> Maybe ChannelId
interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        Interaction -> MemberOrUser
interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        Interaction -> InteractionToken
interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        Interaction -> Int
interactionVersion :: Int,
        -- | What message is associated with this interaction.
        Interaction -> Message
interactionMessage :: Message,
        -- | What permissions does the app or bot have within the sent channel.
        Interaction -> Maybe Text
interactionPermissions :: Maybe T.Text,
        -- | The invoking user's preferred locale.
        Interaction -> Text
interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        Interaction -> Maybe Text
interactionGuildLocale :: Maybe T.Text
      }
  | InteractionPing
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | What permissions does the app or bot have within the sent channel.
        interactionPermissions :: Maybe T.Text
      }
  | InteractionApplicationCommand
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> ApplicationCommandData
applicationCommandData :: ApplicationCommandData,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | What permissions does the app or bot have within the sent channel.
        interactionPermissions :: Maybe T.Text,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  | InteractionApplicationCommandAutocomplete
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        applicationCommandData :: ApplicationCommandData,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | What permissions does the app or bot have within the sent channel.
        interactionPermissions :: Maybe T.Text,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  | InteractionModalSubmit
      { -- | The id of this interaction.
        interactionId :: InteractionId,
        -- | The id of the application that this interaction belongs to.
        interactionApplicationId :: ApplicationId,
        -- | The data for this interaction.
        Interaction -> ModalData
modalData :: ModalData,
        -- | What guild this interaction comes from.
        interactionGuildId :: Maybe GuildId,
        -- | What channel this interaction comes from.
        interactionChannelId :: Maybe ChannelId,
        -- | What user/member this interaction comes from.
        interactionUser :: MemberOrUser,
        -- | The unique token that represents this interaction.
        interactionToken :: InteractionToken,
        -- | What version of interaction is this (always 1).
        interactionVersion :: Int,
        -- | What permissions does the app or bot have within the sent channel.
        interactionPermissions :: Maybe T.Text,
        -- | The invoking user's preferred locale.
        interactionLocale :: T.Text,
        -- | The invoking guild's preferred locale.
        interactionGuildLocale :: Maybe T.Text
      }
  deriving (Int -> Interaction -> ShowS
[Interaction] -> ShowS
Interaction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interaction] -> ShowS
$cshowList :: [Interaction] -> ShowS
show :: Interaction -> String
$cshow :: Interaction -> String
showsPrec :: Int -> Interaction -> ShowS
$cshowsPrec :: Int -> Interaction -> ShowS
Show, ReadPrec [Interaction]
ReadPrec Interaction
Int -> ReadS Interaction
ReadS [Interaction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Interaction]
$creadListPrec :: ReadPrec [Interaction]
readPrec :: ReadPrec Interaction
$creadPrec :: ReadPrec Interaction
readList :: ReadS [Interaction]
$creadList :: ReadS [Interaction]
readsPrec :: Int -> ReadS Interaction
$creadsPrec :: Int -> ReadS Interaction
Read, Interaction -> Interaction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interaction -> Interaction -> Bool
$c/= :: Interaction -> Interaction -> Bool
== :: Interaction -> Interaction -> Bool
$c== :: Interaction -> Interaction -> Bool
Eq, Eq Interaction
Interaction -> Interaction -> Bool
Interaction -> Interaction -> Ordering
Interaction -> Interaction -> Interaction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Interaction -> Interaction -> Interaction
$cmin :: Interaction -> Interaction -> Interaction
max :: Interaction -> Interaction -> Interaction
$cmax :: Interaction -> Interaction -> Interaction
>= :: Interaction -> Interaction -> Bool
$c>= :: Interaction -> Interaction -> Bool
> :: Interaction -> Interaction -> Bool
$c> :: Interaction -> Interaction -> Bool
<= :: Interaction -> Interaction -> Bool
$c<= :: Interaction -> Interaction -> Bool
< :: Interaction -> Interaction -> Bool
$c< :: Interaction -> Interaction -> Bool
compare :: Interaction -> Interaction -> Ordering
$ccompare :: Interaction -> Interaction -> Ordering
Ord)

instance FromJSON Interaction where
  parseJSON :: Value -> Parser Interaction
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Interaction"
      ( \Object
v -> do
          InteractionId
iid <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          ApplicationId
aid <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
          Maybe GuildId
gid <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
          Maybe ChannelId
cid <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
          InteractionToken
tok <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
          Int
version <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          Maybe Text
glocale <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_locale"
          Maybe Text
permissions <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"app_permissions"
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InteractionId
-> ApplicationId
-> InteractionToken
-> Int
-> Maybe Text
-> Interaction
InteractionPing InteractionId
iid ApplicationId
aid InteractionToken
tok Int
version Maybe Text
permissions
            Int
2 ->
              InteractionId
-> ApplicationId
-> ApplicationCommandData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Maybe Text
-> Text
-> Maybe Text
-> Interaction
InteractionApplicationCommand InteractionId
iid ApplicationId
aid
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
3 ->
              InteractionId
-> ApplicationId
-> ComponentData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Message
-> Maybe Text
-> Text
-> Maybe Text
-> Interaction
InteractionComponent InteractionId
iid ApplicationId
aid
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
4 ->
              InteractionId
-> ApplicationId
-> ApplicationCommandData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Maybe Text
-> Text
-> Maybe Text
-> Interaction
InteractionApplicationCommandAutocomplete InteractionId
iid ApplicationId
aid
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
5 ->
              InteractionId
-> ApplicationId
-> ModalData
-> Maybe GuildId
-> Maybe ChannelId
-> MemberOrUser
-> InteractionToken
-> Int
-> Maybe Text
-> Text
-> Maybe Text
-> Interaction
InteractionModalSubmit InteractionId
iid ApplicationId
aid
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction type"
      )

newtype MemberOrUser = MemberOrUser (Either GuildMember User)
  deriving (Int -> MemberOrUser -> ShowS
[MemberOrUser] -> ShowS
MemberOrUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemberOrUser] -> ShowS
$cshowList :: [MemberOrUser] -> ShowS
show :: MemberOrUser -> String
$cshow :: MemberOrUser -> String
showsPrec :: Int -> MemberOrUser -> ShowS
$cshowsPrec :: Int -> MemberOrUser -> ShowS
Show, ReadPrec [MemberOrUser]
ReadPrec MemberOrUser
Int -> ReadS MemberOrUser
ReadS [MemberOrUser]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MemberOrUser]
$creadListPrec :: ReadPrec [MemberOrUser]
readPrec :: ReadPrec MemberOrUser
$creadPrec :: ReadPrec MemberOrUser
readList :: ReadS [MemberOrUser]
$creadList :: ReadS [MemberOrUser]
readsPrec :: Int -> ReadS MemberOrUser
$creadsPrec :: Int -> ReadS MemberOrUser
Read, MemberOrUser -> MemberOrUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemberOrUser -> MemberOrUser -> Bool
$c/= :: MemberOrUser -> MemberOrUser -> Bool
== :: MemberOrUser -> MemberOrUser -> Bool
$c== :: MemberOrUser -> MemberOrUser -> Bool
Eq, Eq MemberOrUser
MemberOrUser -> MemberOrUser -> Bool
MemberOrUser -> MemberOrUser -> Ordering
MemberOrUser -> MemberOrUser -> MemberOrUser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MemberOrUser -> MemberOrUser -> MemberOrUser
$cmin :: MemberOrUser -> MemberOrUser -> MemberOrUser
max :: MemberOrUser -> MemberOrUser -> MemberOrUser
$cmax :: MemberOrUser -> MemberOrUser -> MemberOrUser
>= :: MemberOrUser -> MemberOrUser -> Bool
$c>= :: MemberOrUser -> MemberOrUser -> Bool
> :: MemberOrUser -> MemberOrUser -> Bool
$c> :: MemberOrUser -> MemberOrUser -> Bool
<= :: MemberOrUser -> MemberOrUser -> Bool
$c<= :: MemberOrUser -> MemberOrUser -> Bool
< :: MemberOrUser -> MemberOrUser -> Bool
$c< :: MemberOrUser -> MemberOrUser -> Bool
compare :: MemberOrUser -> MemberOrUser -> Ordering
$ccompare :: MemberOrUser -> MemberOrUser -> Ordering
Ord)

instance {-# OVERLAPPING #-} FromJSON MemberOrUser where
  parseJSON :: Value -> Parser MemberOrUser
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"MemberOrUser"
      ( \Object
v -> Either GuildMember User -> MemberOrUser
MemberOrUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"member" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user")
      )

data ComponentData
  = ButtonData
      { -- | The unique id of the component (up to 100 characters).
        ComponentData -> Text
componentDataCustomId :: T.Text
      }
  | SelectMenuData
      { -- | The unique id of the component (up to 100 characters).
        componentDataCustomId :: T.Text,
        -- | Values for the select menu.
        ComponentData -> [Text]
componentDataValues :: [T.Text]
      }
  deriving (Int -> ComponentData -> ShowS
[ComponentData] -> ShowS
ComponentData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentData] -> ShowS
$cshowList :: [ComponentData] -> ShowS
show :: ComponentData -> String
$cshow :: ComponentData -> String
showsPrec :: Int -> ComponentData -> ShowS
$cshowsPrec :: Int -> ComponentData -> ShowS
Show, ReadPrec [ComponentData]
ReadPrec ComponentData
Int -> ReadS ComponentData
ReadS [ComponentData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentData]
$creadListPrec :: ReadPrec [ComponentData]
readPrec :: ReadPrec ComponentData
$creadPrec :: ReadPrec ComponentData
readList :: ReadS [ComponentData]
$creadList :: ReadS [ComponentData]
readsPrec :: Int -> ReadS ComponentData
$creadsPrec :: Int -> ReadS ComponentData
Read, ComponentData -> ComponentData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentData -> ComponentData -> Bool
$c/= :: ComponentData -> ComponentData -> Bool
== :: ComponentData -> ComponentData -> Bool
$c== :: ComponentData -> ComponentData -> Bool
Eq, Eq ComponentData
ComponentData -> ComponentData -> Bool
ComponentData -> ComponentData -> Ordering
ComponentData -> ComponentData -> ComponentData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentData -> ComponentData -> ComponentData
$cmin :: ComponentData -> ComponentData -> ComponentData
max :: ComponentData -> ComponentData -> ComponentData
$cmax :: ComponentData -> ComponentData -> ComponentData
>= :: ComponentData -> ComponentData -> Bool
$c>= :: ComponentData -> ComponentData -> Bool
> :: ComponentData -> ComponentData -> Bool
$c> :: ComponentData -> ComponentData -> Bool
<= :: ComponentData -> ComponentData -> Bool
$c<= :: ComponentData -> ComponentData -> Bool
< :: ComponentData -> ComponentData -> Bool
$c< :: ComponentData -> ComponentData -> Bool
compare :: ComponentData -> ComponentData -> Ordering
$ccompare :: ComponentData -> ComponentData -> Ordering
Ord)

instance FromJSON ComponentData where
  parseJSON :: Value -> Parser ComponentData
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ComponentData"
      ( \Object
v -> do
          Text
cid <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component_type" :: Parser Int
          case Int
t of
            Int
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ComponentData
ButtonData Text
cid
            Int
3 ->
              Text -> [Text] -> ComponentData
SelectMenuData Text
cid
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values"
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction data component type"
      )

data ApplicationCommandData
  = ApplicationCommandDataUser
      { -- | Id of the invoked command.
        ApplicationCommandData -> ApplicationCommandId
applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        ApplicationCommandData -> Text
applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        ApplicationCommandData -> Maybe ResolvedData
resolvedData :: Maybe ResolvedData,
        -- | The id of the user that is the target.
        ApplicationCommandData -> UserId
applicationCommandDataTargetUserId :: UserId
      }
  | ApplicationCommandDataMessage
      { -- | Id of the invoked command.
        applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        resolvedData :: Maybe ResolvedData,
        -- | The id of the message that is the target.
        ApplicationCommandData -> MessageId
applicationCommandDataTargetMessageId :: MessageId
      }
  | ApplicationCommandDataChatInput
      { -- | Id of the invoked command.
        applicationCommandDataId :: ApplicationCommandId,
        -- | Name of the invoked command.
        applicationCommandDataName :: T.Text,
        -- | The resolved data in the command.
        resolvedData :: Maybe ResolvedData,
        -- | The options of the application command.
        ApplicationCommandData -> Maybe OptionsData
optionsData :: Maybe OptionsData
      }
  deriving (Int -> ApplicationCommandData -> ShowS
[ApplicationCommandData] -> ShowS
ApplicationCommandData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandData] -> ShowS
$cshowList :: [ApplicationCommandData] -> ShowS
show :: ApplicationCommandData -> String
$cshow :: ApplicationCommandData -> String
showsPrec :: Int -> ApplicationCommandData -> ShowS
$cshowsPrec :: Int -> ApplicationCommandData -> ShowS
Show, ReadPrec [ApplicationCommandData]
ReadPrec ApplicationCommandData
Int -> ReadS ApplicationCommandData
ReadS [ApplicationCommandData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandData]
$creadListPrec :: ReadPrec [ApplicationCommandData]
readPrec :: ReadPrec ApplicationCommandData
$creadPrec :: ReadPrec ApplicationCommandData
readList :: ReadS [ApplicationCommandData]
$creadList :: ReadS [ApplicationCommandData]
readsPrec :: Int -> ReadS ApplicationCommandData
$creadsPrec :: Int -> ReadS ApplicationCommandData
Read, ApplicationCommandData -> ApplicationCommandData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c/= :: ApplicationCommandData -> ApplicationCommandData -> Bool
== :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c== :: ApplicationCommandData -> ApplicationCommandData -> Bool
Eq, Eq ApplicationCommandData
ApplicationCommandData -> ApplicationCommandData -> Bool
ApplicationCommandData -> ApplicationCommandData -> Ordering
ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
$cmin :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
max :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
$cmax :: ApplicationCommandData
-> ApplicationCommandData -> ApplicationCommandData
>= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c>= :: ApplicationCommandData -> ApplicationCommandData -> Bool
> :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c> :: ApplicationCommandData -> ApplicationCommandData -> Bool
<= :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c<= :: ApplicationCommandData -> ApplicationCommandData -> Bool
< :: ApplicationCommandData -> ApplicationCommandData -> Bool
$c< :: ApplicationCommandData -> ApplicationCommandData -> Bool
compare :: ApplicationCommandData -> ApplicationCommandData -> Ordering
$ccompare :: ApplicationCommandData -> ApplicationCommandData -> Ordering
Ord)

instance FromJSON ApplicationCommandData where
  parseJSON :: Value -> Parser ApplicationCommandData
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandData"
      ( \Object
v -> do
          ApplicationCommandId
aci <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Text
name <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe ResolvedData
rd <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolved_data"
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              ApplicationCommandId
-> Text
-> Maybe ResolvedData
-> Maybe OptionsData
-> ApplicationCommandData
ApplicationCommandDataChatInput ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Int
2 ->
              ApplicationCommandId
-> Text -> Maybe ResolvedData -> UserId -> ApplicationCommandData
ApplicationCommandDataUser ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_id"
            Int
3 ->
              ApplicationCommandId
-> Text
-> Maybe ResolvedData
-> MessageId
-> ApplicationCommandData
ApplicationCommandDataMessage ApplicationCommandId
aci Text
name Maybe ResolvedData
rd
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_id"
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown interaction data component type"
      )

-- | Either subcommands and groups, or values.
data OptionsData
  = OptionsDataSubcommands [OptionDataSubcommandOrGroup]
  | OptionsDataValues [OptionDataValue]
  deriving (Int -> OptionsData -> ShowS
[OptionsData] -> ShowS
OptionsData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionsData] -> ShowS
$cshowList :: [OptionsData] -> ShowS
show :: OptionsData -> String
$cshow :: OptionsData -> String
showsPrec :: Int -> OptionsData -> ShowS
$cshowsPrec :: Int -> OptionsData -> ShowS
Show, ReadPrec [OptionsData]
ReadPrec OptionsData
Int -> ReadS OptionsData
ReadS [OptionsData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionsData]
$creadListPrec :: ReadPrec [OptionsData]
readPrec :: ReadPrec OptionsData
$creadPrec :: ReadPrec OptionsData
readList :: ReadS [OptionsData]
$creadList :: ReadS [OptionsData]
readsPrec :: Int -> ReadS OptionsData
$creadsPrec :: Int -> ReadS OptionsData
Read, OptionsData -> OptionsData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionsData -> OptionsData -> Bool
$c/= :: OptionsData -> OptionsData -> Bool
== :: OptionsData -> OptionsData -> Bool
$c== :: OptionsData -> OptionsData -> Bool
Eq, Eq OptionsData
OptionsData -> OptionsData -> Bool
OptionsData -> OptionsData -> Ordering
OptionsData -> OptionsData -> OptionsData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptionsData -> OptionsData -> OptionsData
$cmin :: OptionsData -> OptionsData -> OptionsData
max :: OptionsData -> OptionsData -> OptionsData
$cmax :: OptionsData -> OptionsData -> OptionsData
>= :: OptionsData -> OptionsData -> Bool
$c>= :: OptionsData -> OptionsData -> Bool
> :: OptionsData -> OptionsData -> Bool
$c> :: OptionsData -> OptionsData -> Bool
<= :: OptionsData -> OptionsData -> Bool
$c<= :: OptionsData -> OptionsData -> Bool
< :: OptionsData -> OptionsData -> Bool
$c< :: OptionsData -> OptionsData -> Bool
compare :: OptionsData -> OptionsData -> Ordering
$ccompare :: OptionsData -> OptionsData -> Ordering
Ord)

instance FromJSON OptionsData where
  parseJSON :: Value -> Parser OptionsData
parseJSON =
    forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray
      String
"OptionsData"
      ( \Array
a -> do
          let a' :: [Value]
a' = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
          case [Value]
a' of
            [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [OptionDataValue] -> OptionsData
OptionsDataValues []
            (Value
v' : [Value]
_) ->
              forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                String
"OptionsData item"
                ( \Object
v -> do
                    Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
                    if Int
t forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
t forall a. Eq a => a -> a -> Bool
== Int
2
                      then [OptionDataSubcommandOrGroup] -> OptionsData
OptionsDataSubcommands forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                      else [OptionDataValue] -> OptionsData
OptionsDataValues forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                )
                Value
v'
      )

-- | Either a subcommand group or a subcommand.
data OptionDataSubcommandOrGroup
  = OptionDataSubcommandGroup
      { OptionDataSubcommandOrGroup -> Text
optionDataSubcommandGroupName :: T.Text,
        OptionDataSubcommandOrGroup -> [OptionDataSubcommand]
optionDataSubcommandGroupOptions :: [OptionDataSubcommand],
        OptionDataSubcommandOrGroup -> Bool
optionDataSubcommandGroupFocused :: Bool
      }
  | OptionDataSubcommandOrGroupSubcommand OptionDataSubcommand
  deriving (Int -> OptionDataSubcommandOrGroup -> ShowS
[OptionDataSubcommandOrGroup] -> ShowS
OptionDataSubcommandOrGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionDataSubcommandOrGroup] -> ShowS
$cshowList :: [OptionDataSubcommandOrGroup] -> ShowS
show :: OptionDataSubcommandOrGroup -> String
$cshow :: OptionDataSubcommandOrGroup -> String
showsPrec :: Int -> OptionDataSubcommandOrGroup -> ShowS
$cshowsPrec :: Int -> OptionDataSubcommandOrGroup -> ShowS
Show, ReadPrec [OptionDataSubcommandOrGroup]
ReadPrec OptionDataSubcommandOrGroup
Int -> ReadS OptionDataSubcommandOrGroup
ReadS [OptionDataSubcommandOrGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionDataSubcommandOrGroup]
$creadListPrec :: ReadPrec [OptionDataSubcommandOrGroup]
readPrec :: ReadPrec OptionDataSubcommandOrGroup
$creadPrec :: ReadPrec OptionDataSubcommandOrGroup
readList :: ReadS [OptionDataSubcommandOrGroup]
$creadList :: ReadS [OptionDataSubcommandOrGroup]
readsPrec :: Int -> ReadS OptionDataSubcommandOrGroup
$creadsPrec :: Int -> ReadS OptionDataSubcommandOrGroup
Read, OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c/= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
== :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c== :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
Eq, Eq OptionDataSubcommandOrGroup
OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> Ordering
OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
$cmin :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
max :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
$cmax :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
>= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c>= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
> :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c> :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
<= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c<= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
< :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c< :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
compare :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> Ordering
$ccompare :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> Ordering
Ord)

instance FromJSON OptionDataSubcommandOrGroup where
  parseJSON :: Value -> Parser OptionDataSubcommandOrGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataSubcommandOrGroup"
      ( \Object
v -> do
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
2 ->
              Text
-> [OptionDataSubcommand] -> Bool -> OptionDataSubcommandOrGroup
OptionDataSubcommandGroup
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
1 -> OptionDataSubcommand -> OptionDataSubcommandOrGroup
OptionDataSubcommandOrGroupSubcommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand group type"
      )

-- | Data for a single subcommand.
data OptionDataSubcommand = OptionDataSubcommand
  { OptionDataSubcommand -> Text
optionDataSubcommandName :: T.Text,
    OptionDataSubcommand -> [OptionDataValue]
optionDataSubcommandOptions :: [OptionDataValue],
    OptionDataSubcommand -> Bool
optionDataSubcommandFocused :: Bool
  }
  deriving (Int -> OptionDataSubcommand -> ShowS
[OptionDataSubcommand] -> ShowS
OptionDataSubcommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionDataSubcommand] -> ShowS
$cshowList :: [OptionDataSubcommand] -> ShowS
show :: OptionDataSubcommand -> String
$cshow :: OptionDataSubcommand -> String
showsPrec :: Int -> OptionDataSubcommand -> ShowS
$cshowsPrec :: Int -> OptionDataSubcommand -> ShowS
Show, ReadPrec [OptionDataSubcommand]
ReadPrec OptionDataSubcommand
Int -> ReadS OptionDataSubcommand
ReadS [OptionDataSubcommand]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionDataSubcommand]
$creadListPrec :: ReadPrec [OptionDataSubcommand]
readPrec :: ReadPrec OptionDataSubcommand
$creadPrec :: ReadPrec OptionDataSubcommand
readList :: ReadS [OptionDataSubcommand]
$creadList :: ReadS [OptionDataSubcommand]
readsPrec :: Int -> ReadS OptionDataSubcommand
$creadsPrec :: Int -> ReadS OptionDataSubcommand
Read, OptionDataSubcommand -> OptionDataSubcommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c/= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
== :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c== :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
Eq, Eq OptionDataSubcommand
OptionDataSubcommand -> OptionDataSubcommand -> Bool
OptionDataSubcommand -> OptionDataSubcommand -> Ordering
OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
$cmin :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
max :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
$cmax :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
>= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c>= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
> :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c> :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
<= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c<= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
< :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c< :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
compare :: OptionDataSubcommand -> OptionDataSubcommand -> Ordering
$ccompare :: OptionDataSubcommand -> OptionDataSubcommand -> Ordering
Ord)

instance FromJSON OptionDataSubcommand where
  parseJSON :: Value -> Parser OptionDataSubcommand
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataSubcommand"
      ( \Object
v -> do
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              Text -> [OptionDataValue] -> Bool -> OptionDataSubcommand
OptionDataSubcommand
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options" forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected subcommand type"
      )

-- | Data for a single value.
data OptionDataValue
  = OptionDataValueString
      { OptionDataValue -> Text
optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Text
optionDataValueString :: Either T.Text T.Text
      }
  | OptionDataValueInteger
      { optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Integer
optionDataValueInteger :: Either T.Text Integer
      }
  | OptionDataValueBoolean
      { optionDataValueName :: T.Text,
        OptionDataValue -> Bool
optionDataValueBoolean :: Bool
      }
  | OptionDataValueUser
      { optionDataValueName :: T.Text,
        OptionDataValue -> UserId
optionDataValueUser :: UserId
      }
  | OptionDataValueChannel
      { optionDataValueName :: T.Text,
        OptionDataValue -> ChannelId
optionDataValueChannel :: ChannelId
      }
  | OptionDataValueRole
      { optionDataValueName :: T.Text,
        OptionDataValue -> RoleId
optionDataValueRole :: RoleId
      }
  | OptionDataValueMentionable
      { optionDataValueName :: T.Text,
        OptionDataValue -> Snowflake
optionDataValueMentionable :: Snowflake
      }
  | OptionDataValueNumber
      { optionDataValueName :: T.Text,
        OptionDataValue -> Either Text Number
optionDataValueNumber :: Either T.Text Number
      }
  deriving (Int -> OptionDataValue -> ShowS
[OptionDataValue] -> ShowS
OptionDataValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionDataValue] -> ShowS
$cshowList :: [OptionDataValue] -> ShowS
show :: OptionDataValue -> String
$cshow :: OptionDataValue -> String
showsPrec :: Int -> OptionDataValue -> ShowS
$cshowsPrec :: Int -> OptionDataValue -> ShowS
Show, ReadPrec [OptionDataValue]
ReadPrec OptionDataValue
Int -> ReadS OptionDataValue
ReadS [OptionDataValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OptionDataValue]
$creadListPrec :: ReadPrec [OptionDataValue]
readPrec :: ReadPrec OptionDataValue
$creadPrec :: ReadPrec OptionDataValue
readList :: ReadS [OptionDataValue]
$creadList :: ReadS [OptionDataValue]
readsPrec :: Int -> ReadS OptionDataValue
$creadsPrec :: Int -> ReadS OptionDataValue
Read, OptionDataValue -> OptionDataValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionDataValue -> OptionDataValue -> Bool
$c/= :: OptionDataValue -> OptionDataValue -> Bool
== :: OptionDataValue -> OptionDataValue -> Bool
$c== :: OptionDataValue -> OptionDataValue -> Bool
Eq, Eq OptionDataValue
OptionDataValue -> OptionDataValue -> Bool
OptionDataValue -> OptionDataValue -> Ordering
OptionDataValue -> OptionDataValue -> OptionDataValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OptionDataValue -> OptionDataValue -> OptionDataValue
$cmin :: OptionDataValue -> OptionDataValue -> OptionDataValue
max :: OptionDataValue -> OptionDataValue -> OptionDataValue
$cmax :: OptionDataValue -> OptionDataValue -> OptionDataValue
>= :: OptionDataValue -> OptionDataValue -> Bool
$c>= :: OptionDataValue -> OptionDataValue -> Bool
> :: OptionDataValue -> OptionDataValue -> Bool
$c> :: OptionDataValue -> OptionDataValue -> Bool
<= :: OptionDataValue -> OptionDataValue -> Bool
$c<= :: OptionDataValue -> OptionDataValue -> Bool
< :: OptionDataValue -> OptionDataValue -> Bool
$c< :: OptionDataValue -> OptionDataValue -> Bool
compare :: OptionDataValue -> OptionDataValue -> Ordering
$ccompare :: OptionDataValue -> OptionDataValue -> Ordering
Ord)

instance FromJSON OptionDataValue where
  parseJSON :: Value -> Parser OptionDataValue
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataValue"
      ( \Object
v -> do
          Text
name <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Bool
focused <- Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Int
t <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
3 ->
              Text -> Either Text Text -> OptionDataValue
OptionDataValueString Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
4 ->
              Text -> Either Text Integer -> OptionDataValue
OptionDataValueInteger Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
10 ->
              Text -> Either Text Number -> OptionDataValue
OptionDataValueNumber Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
5 ->
              Text -> Bool -> OptionDataValue
OptionDataValueBoolean Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
6 ->
              Text -> UserId -> OptionDataValue
OptionDataValueUser Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
7 ->
              Text -> ChannelId -> OptionDataValue
OptionDataValueChannel Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
8 ->
              Text -> RoleId -> OptionDataValue
OptionDataValueRole Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
9 ->
              Text -> Snowflake -> OptionDataValue
OptionDataValueMentionable Text
name
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unexpected interaction data application command option value type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
t
      )

data ModalData = ModalData
  { -- | The unique id of the component (up to 100 characters).
    ModalData -> Text
modalDataCustomId :: T.Text,
    -- | Components from the modal.
    ModalData -> [TextInput]
modalDataComponents :: [TextInput]
  }
  deriving (Int -> ModalData -> ShowS
[ModalData] -> ShowS
ModalData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModalData] -> ShowS
$cshowList :: [ModalData] -> ShowS
show :: ModalData -> String
$cshow :: ModalData -> String
showsPrec :: Int -> ModalData -> ShowS
$cshowsPrec :: Int -> ModalData -> ShowS
Show, ReadPrec [ModalData]
ReadPrec ModalData
Int -> ReadS ModalData
ReadS [ModalData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModalData]
$creadListPrec :: ReadPrec [ModalData]
readPrec :: ReadPrec ModalData
$creadPrec :: ReadPrec ModalData
readList :: ReadS [ModalData]
$creadList :: ReadS [ModalData]
readsPrec :: Int -> ReadS ModalData
$creadsPrec :: Int -> ReadS ModalData
Read, ModalData -> ModalData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModalData -> ModalData -> Bool
$c/= :: ModalData -> ModalData -> Bool
== :: ModalData -> ModalData -> Bool
$c== :: ModalData -> ModalData -> Bool
Eq, Eq ModalData
ModalData -> ModalData -> Bool
ModalData -> ModalData -> Ordering
ModalData -> ModalData -> ModalData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModalData -> ModalData -> ModalData
$cmin :: ModalData -> ModalData -> ModalData
max :: ModalData -> ModalData -> ModalData
$cmax :: ModalData -> ModalData -> ModalData
>= :: ModalData -> ModalData -> Bool
$c>= :: ModalData -> ModalData -> Bool
> :: ModalData -> ModalData -> Bool
$c> :: ModalData -> ModalData -> Bool
<= :: ModalData -> ModalData -> Bool
$c<= :: ModalData -> ModalData -> Bool
< :: ModalData -> ModalData -> Bool
$c< :: ModalData -> ModalData -> Bool
compare :: ModalData -> ModalData -> Ordering
$ccompare :: ModalData -> ModalData -> Ordering
Ord)

instance FromJSON ModalData where
  parseJSON :: Value -> Parser ModalData
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ModalData"
      ( \Object
v ->
          Text -> [TextInput] -> ModalData
ModalData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser [TextInput]
getTextInput)
      )
    where
      getTextInput :: Value -> Parser [TextInput]
      getTextInput :: Value -> Parser [TextInput]
getTextInput = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModalData.TextInput" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Int
t <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
        case Int
t of
          Int
1 -> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components"
          Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"expected action row type (1), got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
t

parseValue :: (FromJSON a) => Object -> Bool -> Parser (Either T.Text a)
parseValue :: forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
o Bool
True = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
parseValue Object
o Bool
False = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"

-- resolved data -- this should be formalised and integrated, instead of being
--  left as values

-- | I'm not sure what this stuff is, so you're on your own.
--
-- It's not worth the time working out how to create this stuff.
-- If you need to extract from these values, check out the link below.
--
-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-resolved-data-structure
data ResolvedData = ResolvedData
  { ResolvedData -> Maybe Value
resolvedDataUsers :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataMembers :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataRoles :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataChannels :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataMessages :: Maybe Value,
    ResolvedData -> Maybe Value
resolvedDataAttachments :: Maybe Value
  }
  deriving (Int -> ResolvedData -> ShowS
[ResolvedData] -> ShowS
ResolvedData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedData] -> ShowS
$cshowList :: [ResolvedData] -> ShowS
show :: ResolvedData -> String
$cshow :: ResolvedData -> String
showsPrec :: Int -> ResolvedData -> ShowS
$cshowsPrec :: Int -> ResolvedData -> ShowS
Show, ReadPrec [ResolvedData]
ReadPrec ResolvedData
Int -> ReadS ResolvedData
ReadS [ResolvedData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResolvedData]
$creadListPrec :: ReadPrec [ResolvedData]
readPrec :: ReadPrec ResolvedData
$creadPrec :: ReadPrec ResolvedData
readList :: ReadS [ResolvedData]
$creadList :: ReadS [ResolvedData]
readsPrec :: Int -> ReadS ResolvedData
$creadsPrec :: Int -> ReadS ResolvedData
Read, ResolvedData -> ResolvedData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvedData -> ResolvedData -> Bool
$c/= :: ResolvedData -> ResolvedData -> Bool
== :: ResolvedData -> ResolvedData -> Bool
$c== :: ResolvedData -> ResolvedData -> Bool
Eq, Eq ResolvedData
ResolvedData -> ResolvedData -> Bool
ResolvedData -> ResolvedData -> Ordering
ResolvedData -> ResolvedData -> ResolvedData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResolvedData -> ResolvedData -> ResolvedData
$cmin :: ResolvedData -> ResolvedData -> ResolvedData
max :: ResolvedData -> ResolvedData -> ResolvedData
$cmax :: ResolvedData -> ResolvedData -> ResolvedData
>= :: ResolvedData -> ResolvedData -> Bool
$c>= :: ResolvedData -> ResolvedData -> Bool
> :: ResolvedData -> ResolvedData -> Bool
$c> :: ResolvedData -> ResolvedData -> Bool
<= :: ResolvedData -> ResolvedData -> Bool
$c<= :: ResolvedData -> ResolvedData -> Bool
< :: ResolvedData -> ResolvedData -> Bool
$c< :: ResolvedData -> ResolvedData -> Bool
compare :: ResolvedData -> ResolvedData -> Ordering
$ccompare :: ResolvedData -> ResolvedData -> Ordering
Ord)

instance ToJSON ResolvedData where
  toJSON :: ResolvedData -> Value
toJSON ResolvedData {Maybe Value
resolvedDataAttachments :: Maybe Value
resolvedDataMessages :: Maybe Value
resolvedDataChannels :: Maybe Value
resolvedDataRoles :: Maybe Value
resolvedDataMembers :: Maybe Value
resolvedDataUsers :: Maybe Value
resolvedDataAttachments :: ResolvedData -> Maybe Value
resolvedDataMessages :: ResolvedData -> Maybe Value
resolvedDataChannels :: ResolvedData -> Maybe Value
resolvedDataRoles :: ResolvedData -> Maybe Value
resolvedDataMembers :: ResolvedData -> Maybe Value
resolvedDataUsers :: ResolvedData -> Maybe Value
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"users" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataUsers,
        Key
"members" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataMembers,
        Key
"roles" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataRoles,
        Key
"channels" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataChannels,
        Key
"messages" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataMessages,
        Key
"attachments" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Value
resolvedDataAttachments
      ]

instance FromJSON ResolvedData where
  parseJSON :: Value -> Parser ResolvedData
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ResolvedData"
      ( \Object
v ->
          Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> Maybe Value
-> ResolvedData
ResolvedData
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"users"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channels"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"messages"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachments"
      )

-- | The data to respond to an interaction with. Unless specified otherwise, you
-- only have three seconds to reply to an interaction before a failure state is
-- given.
data InteractionResponse
  = -- | ACK a Ping
    InteractionResponsePong
  | -- | Respond to an interaction with a message
    InteractionResponseChannelMessage InteractionResponseMessage
  | -- | ACK an interaction and edit a response later (use `CreateFollowupInteractionMessage` and `InteractionResponseMessage` to do so). User sees loading state.
    InteractionResponseDeferChannelMessage
  | -- | for components, ACK an interaction and edit the original message later; the user does not see a loading state.
    InteractionResponseDeferUpdateMessage
  | -- | for components, edit the message the component was attached to
    InteractionResponseUpdateMessage InteractionResponseMessage
  | -- | respond to an autocomplete interaction with suggested choices
    InteractionResponseAutocompleteResult InteractionResponseAutocomplete
  | -- | respond with a popup modal
    InteractionResponseModal InteractionResponseModalData
  deriving (Int -> InteractionResponse -> ShowS
[InteractionResponse] -> ShowS
InteractionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponse] -> ShowS
$cshowList :: [InteractionResponse] -> ShowS
show :: InteractionResponse -> String
$cshow :: InteractionResponse -> String
showsPrec :: Int -> InteractionResponse -> ShowS
$cshowsPrec :: Int -> InteractionResponse -> ShowS
Show, ReadPrec [InteractionResponse]
ReadPrec InteractionResponse
Int -> ReadS InteractionResponse
ReadS [InteractionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponse]
$creadListPrec :: ReadPrec [InteractionResponse]
readPrec :: ReadPrec InteractionResponse
$creadPrec :: ReadPrec InteractionResponse
readList :: ReadS [InteractionResponse]
$creadList :: ReadS [InteractionResponse]
readsPrec :: Int -> ReadS InteractionResponse
$creadsPrec :: Int -> ReadS InteractionResponse
Read, InteractionResponse -> InteractionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponse -> InteractionResponse -> Bool
$c/= :: InteractionResponse -> InteractionResponse -> Bool
== :: InteractionResponse -> InteractionResponse -> Bool
$c== :: InteractionResponse -> InteractionResponse -> Bool
Eq, Eq InteractionResponse
InteractionResponse -> InteractionResponse -> Bool
InteractionResponse -> InteractionResponse -> Ordering
InteractionResponse -> InteractionResponse -> InteractionResponse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponse -> InteractionResponse -> InteractionResponse
$cmin :: InteractionResponse -> InteractionResponse -> InteractionResponse
max :: InteractionResponse -> InteractionResponse -> InteractionResponse
$cmax :: InteractionResponse -> InteractionResponse -> InteractionResponse
>= :: InteractionResponse -> InteractionResponse -> Bool
$c>= :: InteractionResponse -> InteractionResponse -> Bool
> :: InteractionResponse -> InteractionResponse -> Bool
$c> :: InteractionResponse -> InteractionResponse -> Bool
<= :: InteractionResponse -> InteractionResponse -> Bool
$c<= :: InteractionResponse -> InteractionResponse -> Bool
< :: InteractionResponse -> InteractionResponse -> Bool
$c< :: InteractionResponse -> InteractionResponse -> Bool
compare :: InteractionResponse -> InteractionResponse -> Ordering
$ccompare :: InteractionResponse -> InteractionResponse -> Ordering
Ord)

-- | A basic interaction response, sending back the given text.
interactionResponseBasic :: T.Text -> InteractionResponse
interactionResponseBasic :: Text -> InteractionResponse
interactionResponseBasic Text
t = InteractionResponseMessage -> InteractionResponse
InteractionResponseChannelMessage (Text -> InteractionResponseMessage
interactionResponseMessageBasic Text
t)

instance ToJSON InteractionResponse where
  toJSON :: InteractionResponse -> Value
toJSON InteractionResponse
InteractionResponsePong = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
1)]
  toJSON InteractionResponse
InteractionResponseDeferChannelMessage = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
5)]
  toJSON InteractionResponse
InteractionResponseDeferUpdateMessage = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
6)]
  toJSON (InteractionResponseChannelMessage InteractionResponseMessage
ms) = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
4), (Key
"data", forall a. ToJSON a => a -> Value
toJSON InteractionResponseMessage
ms)]
  toJSON (InteractionResponseUpdateMessage InteractionResponseMessage
ms) = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
7), (Key
"data", forall a. ToJSON a => a -> Value
toJSON InteractionResponseMessage
ms)]
  toJSON (InteractionResponseAutocompleteResult InteractionResponseAutocomplete
ms) = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
8), (Key
"data", forall a. ToJSON a => a -> Value
toJSON InteractionResponseAutocomplete
ms)]
  toJSON (InteractionResponseModal InteractionResponseModalData
ms) = [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
9), (Key
"data", forall a. ToJSON a => a -> Value
toJSON InteractionResponseModalData
ms)]

data InteractionResponseAutocomplete
  = InteractionResponseAutocompleteString [Choice T.Text]
  | InteractionResponseAutocompleteInteger [Choice Integer]
  | InteractionResponseAutocompleteNumber [Choice Number]
  deriving (Int -> InteractionResponseAutocomplete -> ShowS
[InteractionResponseAutocomplete] -> ShowS
InteractionResponseAutocomplete -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseAutocomplete] -> ShowS
$cshowList :: [InteractionResponseAutocomplete] -> ShowS
show :: InteractionResponseAutocomplete -> String
$cshow :: InteractionResponseAutocomplete -> String
showsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
$cshowsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
Show, ReadPrec [InteractionResponseAutocomplete]
ReadPrec InteractionResponseAutocomplete
Int -> ReadS InteractionResponseAutocomplete
ReadS [InteractionResponseAutocomplete]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseAutocomplete]
$creadListPrec :: ReadPrec [InteractionResponseAutocomplete]
readPrec :: ReadPrec InteractionResponseAutocomplete
$creadPrec :: ReadPrec InteractionResponseAutocomplete
readList :: ReadS [InteractionResponseAutocomplete]
$creadList :: ReadS [InteractionResponseAutocomplete]
readsPrec :: Int -> ReadS InteractionResponseAutocomplete
$creadsPrec :: Int -> ReadS InteractionResponseAutocomplete
Read, InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
Eq, Eq InteractionResponseAutocomplete
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
$cmin :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
max :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
$cmax :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
>= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c>= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
> :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c> :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
<= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c<= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
< :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c< :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
compare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
$ccompare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
Ord)

instance ToJSON InteractionResponseAutocomplete where
  toJSON :: InteractionResponseAutocomplete -> Value
toJSON (InteractionResponseAutocompleteString [Choice Text]
cs) = [Pair] -> Value
object [(Key
"choices", forall a. ToJSON a => a -> Value
toJSON [Choice Text]
cs)]
  toJSON (InteractionResponseAutocompleteInteger [Choice Integer]
cs) = [Pair] -> Value
object [(Key
"choices", forall a. ToJSON a => a -> Value
toJSON [Choice Integer]
cs)]
  toJSON (InteractionResponseAutocompleteNumber [Choice Number]
cs) = [Pair] -> Value
object [(Key
"choices", forall a. ToJSON a => a -> Value
toJSON [Choice Number]
cs)]

-- | A cut down message structure.
data InteractionResponseMessage = InteractionResponseMessage
  { InteractionResponseMessage -> Maybe Bool
interactionResponseMessageTTS :: Maybe Bool,
    InteractionResponseMessage -> Maybe Text
interactionResponseMessageContent :: Maybe T.Text,
    InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageEmbeds :: Maybe [CreateEmbed],
    InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions,
    InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags,
    InteractionResponseMessage -> Maybe [ActionRow]
interactionResponseMessageComponents :: Maybe [ActionRow],
    InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageAttachments :: Maybe [Attachment]
  }
  deriving (Int -> InteractionResponseMessage -> ShowS
[InteractionResponseMessage] -> ShowS
InteractionResponseMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessage] -> ShowS
$cshowList :: [InteractionResponseMessage] -> ShowS
show :: InteractionResponseMessage -> String
$cshow :: InteractionResponseMessage -> String
showsPrec :: Int -> InteractionResponseMessage -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessage -> ShowS
Show, ReadPrec [InteractionResponseMessage]
ReadPrec InteractionResponseMessage
Int -> ReadS InteractionResponseMessage
ReadS [InteractionResponseMessage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessage]
$creadListPrec :: ReadPrec [InteractionResponseMessage]
readPrec :: ReadPrec InteractionResponseMessage
$creadPrec :: ReadPrec InteractionResponseMessage
readList :: ReadS [InteractionResponseMessage]
$creadList :: ReadS [InteractionResponseMessage]
readsPrec :: Int -> ReadS InteractionResponseMessage
$creadsPrec :: Int -> ReadS InteractionResponseMessage
Read, InteractionResponseMessage -> InteractionResponseMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
Eq, Eq InteractionResponseMessage
InteractionResponseMessage -> InteractionResponseMessage -> Bool
InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
$cmin :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
max :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
$cmax :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
>= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c>= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
> :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c> :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
<= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c<= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
< :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c< :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
compare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
$ccompare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
Ord)

-- | A basic interaction response, sending back the given text. This is
-- effectively a helper function.
interactionResponseMessageBasic :: T.Text -> InteractionResponseMessage
interactionResponseMessageBasic :: Text -> InteractionResponseMessage
interactionResponseMessageBasic Text
t = Maybe Bool
-> Maybe Text
-> Maybe [CreateEmbed]
-> Maybe AllowedMentions
-> Maybe InteractionResponseMessageFlags
-> Maybe [ActionRow]
-> Maybe [Attachment]
-> InteractionResponseMessage
InteractionResponseMessage forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
t) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

instance ToJSON InteractionResponseMessage where
  toJSON :: InteractionResponseMessage -> Value
toJSON InteractionResponseMessage {Maybe Bool
Maybe [CreateEmbed]
Maybe [ActionRow]
Maybe [Attachment]
Maybe Text
Maybe AllowedMentions
Maybe InteractionResponseMessageFlags
interactionResponseMessageAttachments :: Maybe [Attachment]
interactionResponseMessageComponents :: Maybe [ActionRow]
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions
interactionResponseMessageEmbeds :: Maybe [CreateEmbed]
interactionResponseMessageContent :: Maybe Text
interactionResponseMessageTTS :: Maybe Bool
interactionResponseMessageAttachments :: InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageComponents :: InteractionResponseMessage -> Maybe [ActionRow]
interactionResponseMessageFlags :: InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageAllowedMentions :: InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageEmbeds :: InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageContent :: InteractionResponseMessage -> Maybe Text
interactionResponseMessageTTS :: InteractionResponseMessage -> Maybe Bool
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"tts" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
interactionResponseMessageTTS,
        Key
"content" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
interactionResponseMessageContent,
        Key
"embeds" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? ((CreateEmbed -> Embed
createEmbed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CreateEmbed]
interactionResponseMessageEmbeds),
        Key
"allowed_mentions" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe AllowedMentions
interactionResponseMessageAllowedMentions,
        Key
"flags" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags,
        Key
"components" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe [ActionRow]
interactionResponseMessageComponents,
        Key
"attachments" forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe [Attachment]
interactionResponseMessageAttachments
      ]

-- | Types of flags to attach to the interaction message.
--
-- Currently the only flag is EPHERMERAL, which means only the user can see the
-- message.
data InteractionResponseMessageFlag = InteractionResponseMessageFlagEphermeral
  deriving (Int -> InteractionResponseMessageFlag -> ShowS
[InteractionResponseMessageFlag] -> ShowS
InteractionResponseMessageFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessageFlag] -> ShowS
$cshowList :: [InteractionResponseMessageFlag] -> ShowS
show :: InteractionResponseMessageFlag -> String
$cshow :: InteractionResponseMessageFlag -> String
showsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
Show, ReadPrec [InteractionResponseMessageFlag]
ReadPrec InteractionResponseMessageFlag
Int -> ReadS InteractionResponseMessageFlag
ReadS [InteractionResponseMessageFlag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessageFlag]
$creadListPrec :: ReadPrec [InteractionResponseMessageFlag]
readPrec :: ReadPrec InteractionResponseMessageFlag
$creadPrec :: ReadPrec InteractionResponseMessageFlag
readList :: ReadS [InteractionResponseMessageFlag]
$creadList :: ReadS [InteractionResponseMessageFlag]
readsPrec :: Int -> ReadS InteractionResponseMessageFlag
$creadsPrec :: Int -> ReadS InteractionResponseMessageFlag
Read, InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
Eq, Eq InteractionResponseMessageFlag
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
$cmin :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
max :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
$cmax :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
>= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c>= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
> :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c> :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
<= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c<= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
< :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c< :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
compare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
$ccompare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
Ord)

newtype InteractionResponseMessageFlags = InteractionResponseMessageFlags [InteractionResponseMessageFlag]
  deriving (Int -> InteractionResponseMessageFlags -> ShowS
[InteractionResponseMessageFlags] -> ShowS
InteractionResponseMessageFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseMessageFlags] -> ShowS
$cshowList :: [InteractionResponseMessageFlags] -> ShowS
show :: InteractionResponseMessageFlags -> String
$cshow :: InteractionResponseMessageFlags -> String
showsPrec :: Int -> InteractionResponseMessageFlags -> ShowS
$cshowsPrec :: Int -> InteractionResponseMessageFlags -> ShowS
Show, ReadPrec [InteractionResponseMessageFlags]
ReadPrec InteractionResponseMessageFlags
Int -> ReadS InteractionResponseMessageFlags
ReadS [InteractionResponseMessageFlags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseMessageFlags]
$creadListPrec :: ReadPrec [InteractionResponseMessageFlags]
readPrec :: ReadPrec InteractionResponseMessageFlags
$creadPrec :: ReadPrec InteractionResponseMessageFlags
readList :: ReadS [InteractionResponseMessageFlags]
$creadList :: ReadS [InteractionResponseMessageFlags]
readsPrec :: Int -> ReadS InteractionResponseMessageFlags
$creadsPrec :: Int -> ReadS InteractionResponseMessageFlags
Read, InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c/= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
== :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c== :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
Eq, Eq InteractionResponseMessageFlags
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
$cmin :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
max :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
$cmax :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
-> InteractionResponseMessageFlags
>= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c>= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
> :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c> :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
<= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c<= :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
< :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
$c< :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Bool
compare :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
$ccompare :: InteractionResponseMessageFlags
-> InteractionResponseMessageFlags -> Ordering
Ord)

instance Enum InteractionResponseMessageFlag where
  fromEnum :: InteractionResponseMessageFlag -> Int
fromEnum InteractionResponseMessageFlag
InteractionResponseMessageFlagEphermeral = Int
1 forall a. Bits a => a -> Int -> a
`shift` Int
6
  toEnum :: Int -> InteractionResponseMessageFlag
toEnum Int
i
    | Int
i forall a. Eq a => a -> a -> Bool
== Int
1 forall a. Bits a => a -> Int -> a
`shift` Int
6 = InteractionResponseMessageFlag
InteractionResponseMessageFlagEphermeral
    | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"could not find InteractionCallbackDataFlag `" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"`"

instance ToJSON InteractionResponseMessageFlags where
  toJSON :: InteractionResponseMessageFlags -> Value
toJSON (InteractionResponseMessageFlags [InteractionResponseMessageFlag]
fs) = Number -> Value
Number forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) Int
0 (forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionResponseMessageFlag]
fs)

data InteractionResponseModalData = InteractionResponseModalData
  { InteractionResponseModalData -> Text
interactionResponseModalCustomId :: T.Text,
    InteractionResponseModalData -> Text
interactionResponseModalTitle :: T.Text,
    InteractionResponseModalData -> [TextInput]
interactionResponseModalComponents :: [TextInput]
  }
  deriving (Int -> InteractionResponseModalData -> ShowS
[InteractionResponseModalData] -> ShowS
InteractionResponseModalData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionResponseModalData] -> ShowS
$cshowList :: [InteractionResponseModalData] -> ShowS
show :: InteractionResponseModalData -> String
$cshow :: InteractionResponseModalData -> String
showsPrec :: Int -> InteractionResponseModalData -> ShowS
$cshowsPrec :: Int -> InteractionResponseModalData -> ShowS
Show, ReadPrec [InteractionResponseModalData]
ReadPrec InteractionResponseModalData
Int -> ReadS InteractionResponseModalData
ReadS [InteractionResponseModalData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponseModalData]
$creadListPrec :: ReadPrec [InteractionResponseModalData]
readPrec :: ReadPrec InteractionResponseModalData
$creadPrec :: ReadPrec InteractionResponseModalData
readList :: ReadS [InteractionResponseModalData]
$creadList :: ReadS [InteractionResponseModalData]
readsPrec :: Int -> ReadS InteractionResponseModalData
$creadsPrec :: Int -> ReadS InteractionResponseModalData
Read, InteractionResponseModalData
-> InteractionResponseModalData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
Eq, Eq InteractionResponseModalData
InteractionResponseModalData
-> InteractionResponseModalData -> Bool
InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
$cmin :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
max :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
$cmax :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
>= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c>= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
> :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c> :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
<= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c<= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
< :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c< :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
compare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
$ccompare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
Ord)

instance ToJSON InteractionResponseModalData where
  toJSON :: InteractionResponseModalData -> Value
toJSON InteractionResponseModalData {[TextInput]
Text
interactionResponseModalComponents :: [TextInput]
interactionResponseModalTitle :: Text
interactionResponseModalCustomId :: Text
interactionResponseModalComponents :: InteractionResponseModalData -> [TextInput]
interactionResponseModalTitle :: InteractionResponseModalData -> Text
interactionResponseModalCustomId :: InteractionResponseModalData -> Text
..} =
    [Pair] -> Value
object
      [ (Key
"custom_id", forall a. ToJSON a => a -> Value
toJSON Text
interactionResponseModalCustomId),
        (Key
"title", forall a. ToJSON a => a -> Value
toJSON Text
interactionResponseModalTitle),
        (Key
"components", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\TextInput
ti -> [Pair] -> Value
object [(Key
"type", Number -> Value
Number Number
1), (Key
"components", forall a. ToJSON a => a -> Value
toJSON [TextInput
ti])]) [TextInput]
interactionResponseModalComponents)
      ]