{-# 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 (..),
    ModalData (..),
    InteractionResponse (..),
    interactionResponseBasic,
    InteractionResponseAutocomplete (..),
    InteractionResponseMessage (..),
    interactionResponseMessageBasic,
    InteractionResponseMessageFlags (..),
    InteractionResponseMessageFlag (..),
    InteractionResponseModalData (..),
  )
where

import Control.Applicative (Alternative ((<|>)))
import Control.Monad (join)
import Data.Default
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
(Int -> Interaction -> ShowS)
-> (Interaction -> String)
-> ([Interaction] -> ShowS)
-> Show Interaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interaction -> ShowS
showsPrec :: Int -> Interaction -> ShowS
$cshow :: Interaction -> String
show :: Interaction -> String
$cshowList :: [Interaction] -> ShowS
showList :: [Interaction] -> ShowS
Show, ReadPrec [Interaction]
ReadPrec Interaction
Int -> ReadS Interaction
ReadS [Interaction]
(Int -> ReadS Interaction)
-> ReadS [Interaction]
-> ReadPrec Interaction
-> ReadPrec [Interaction]
-> Read Interaction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Interaction
readsPrec :: Int -> ReadS Interaction
$creadList :: ReadS [Interaction]
readList :: ReadS [Interaction]
$creadPrec :: ReadPrec Interaction
readPrec :: ReadPrec Interaction
$creadListPrec :: ReadPrec [Interaction]
readListPrec :: ReadPrec [Interaction]
Read, Interaction -> Interaction -> Bool
(Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool) -> Eq Interaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Interaction -> Interaction -> Bool
== :: Interaction -> Interaction -> Bool
$c/= :: Interaction -> Interaction -> Bool
/= :: Interaction -> Interaction -> Bool
Eq, Eq Interaction
Eq Interaction =>
(Interaction -> Interaction -> Ordering)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Interaction)
-> (Interaction -> Interaction -> Interaction)
-> Ord 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
$ccompare :: Interaction -> Interaction -> Ordering
compare :: Interaction -> Interaction -> Ordering
$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
>= :: Interaction -> Interaction -> Bool
$cmax :: Interaction -> Interaction -> Interaction
max :: Interaction -> Interaction -> Interaction
$cmin :: Interaction -> Interaction -> Interaction
min :: Interaction -> Interaction -> Interaction
Ord)

instance FromJSON Interaction where
  parseJSON :: Value -> Parser Interaction
parseJSON =
    String
-> (Object -> Parser Interaction) -> Value -> Parser Interaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Interaction"
      ( \Object
v -> do
          InteractionId
iid <- Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          ApplicationId
aid <- Object
v Object -> Key -> Parser ApplicationId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
          Maybe GuildId
gid <- Object
v Object -> Key -> Parser (Maybe GuildId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
          Maybe ChannelId
cid <- Object
v Object -> Key -> Parser (Maybe ChannelId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
          InteractionToken
tok <- Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
          Int
version <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          Maybe Text
glocale <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_locale"
          Maybe Text
permissions <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"app_permissions"
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 -> Interaction -> Parser Interaction
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Interaction -> Parser Interaction)
-> Interaction -> Parser Interaction
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
                (ApplicationCommandData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ApplicationCommandData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser Int
-> Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                Parser (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
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
                (ComponentData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Message
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ComponentData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ComponentData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Message
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Message
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int
      -> Message
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int
   -> Message
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser InteractionToken
-> Parser
     (Int -> Message -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser
  (Int -> Message -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser Int
-> Parser
     (Message -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (Message -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser Message
-> Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Message
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                Parser (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
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
                (ApplicationCommandData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ApplicationCommandData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser Int
-> Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                Parser (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
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
                (ModalData
 -> Maybe GuildId
 -> Maybe ChannelId
 -> MemberOrUser
 -> InteractionToken
 -> Int
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Interaction)
-> Parser ModalData
-> Parser
     (Maybe GuildId
      -> Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ModalData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
                Parser
  (Maybe GuildId
   -> Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe GuildId)
-> Parser
     (Maybe ChannelId
      -> MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe GuildId -> Parser (Maybe GuildId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GuildId
gid
                Parser
  (Maybe ChannelId
   -> MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser (Maybe ChannelId)
-> Parser
     (MemberOrUser
      -> InteractionToken
      -> Int
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ChannelId -> Parser (Maybe ChannelId)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
cid
                Parser
  (MemberOrUser
   -> InteractionToken
   -> Int
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Interaction)
-> Parser MemberOrUser
-> Parser
     (InteractionToken
      -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser MemberOrUser
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
                Parser
  (InteractionToken
   -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser InteractionToken
-> Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InteractionToken -> Parser InteractionToken
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return InteractionToken
tok
                Parser (Int -> Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser Int
-> Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
version
                Parser (Maybe Text -> Text -> Maybe Text -> Interaction)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
permissions
                Parser (Text -> Maybe Text -> Interaction)
-> Parser Text -> Parser (Maybe Text -> Interaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locale"
                Parser (Maybe Text -> Interaction)
-> Parser (Maybe Text) -> Parser Interaction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
glocale
            Int
_ -> String -> Parser Interaction
forall a. String -> Parser a
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
(Int -> MemberOrUser -> ShowS)
-> (MemberOrUser -> String)
-> ([MemberOrUser] -> ShowS)
-> Show MemberOrUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemberOrUser -> ShowS
showsPrec :: Int -> MemberOrUser -> ShowS
$cshow :: MemberOrUser -> String
show :: MemberOrUser -> String
$cshowList :: [MemberOrUser] -> ShowS
showList :: [MemberOrUser] -> ShowS
Show, ReadPrec [MemberOrUser]
ReadPrec MemberOrUser
Int -> ReadS MemberOrUser
ReadS [MemberOrUser]
(Int -> ReadS MemberOrUser)
-> ReadS [MemberOrUser]
-> ReadPrec MemberOrUser
-> ReadPrec [MemberOrUser]
-> Read MemberOrUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemberOrUser
readsPrec :: Int -> ReadS MemberOrUser
$creadList :: ReadS [MemberOrUser]
readList :: ReadS [MemberOrUser]
$creadPrec :: ReadPrec MemberOrUser
readPrec :: ReadPrec MemberOrUser
$creadListPrec :: ReadPrec [MemberOrUser]
readListPrec :: ReadPrec [MemberOrUser]
Read, MemberOrUser -> MemberOrUser -> Bool
(MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool) -> Eq MemberOrUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemberOrUser -> MemberOrUser -> Bool
== :: MemberOrUser -> MemberOrUser -> Bool
$c/= :: MemberOrUser -> MemberOrUser -> Bool
/= :: MemberOrUser -> MemberOrUser -> Bool
Eq, Eq MemberOrUser
Eq MemberOrUser =>
(MemberOrUser -> MemberOrUser -> Ordering)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> Bool)
-> (MemberOrUser -> MemberOrUser -> MemberOrUser)
-> (MemberOrUser -> MemberOrUser -> MemberOrUser)
-> Ord 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
$ccompare :: MemberOrUser -> MemberOrUser -> Ordering
compare :: MemberOrUser -> MemberOrUser -> Ordering
$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
>= :: MemberOrUser -> MemberOrUser -> Bool
$cmax :: MemberOrUser -> MemberOrUser -> MemberOrUser
max :: MemberOrUser -> MemberOrUser -> MemberOrUser
$cmin :: MemberOrUser -> MemberOrUser -> MemberOrUser
min :: MemberOrUser -> MemberOrUser -> MemberOrUser
Ord)

instance {-# OVERLAPPING #-} FromJSON MemberOrUser where
  parseJSON :: Value -> Parser MemberOrUser
parseJSON =
    String
-> (Object -> Parser MemberOrUser) -> Value -> Parser MemberOrUser
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"MemberOrUser"
      ( \Object
v -> Either GuildMember User -> MemberOrUser
MemberOrUser (Either GuildMember User -> MemberOrUser)
-> Parser (Either GuildMember User) -> Parser MemberOrUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GuildMember -> Either GuildMember User
forall a b. a -> Either a b
Left (GuildMember -> Either GuildMember User)
-> Parser GuildMember -> Parser (Either GuildMember User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser GuildMember
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"member" Parser (Either GuildMember User)
-> Parser (Either GuildMember User)
-> Parser (Either GuildMember User)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> User -> Either GuildMember User
forall a b. b -> Either a b
Right (User -> Either GuildMember User)
-> Parser User -> Parser (Either GuildMember User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser User
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 -> SelectMenuData
componentDataValues :: SelectMenuData
      }
  deriving (Int -> ComponentData -> ShowS
[ComponentData] -> ShowS
ComponentData -> String
(Int -> ComponentData -> ShowS)
-> (ComponentData -> String)
-> ([ComponentData] -> ShowS)
-> Show ComponentData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentData -> ShowS
showsPrec :: Int -> ComponentData -> ShowS
$cshow :: ComponentData -> String
show :: ComponentData -> String
$cshowList :: [ComponentData] -> ShowS
showList :: [ComponentData] -> ShowS
Show, ReadPrec [ComponentData]
ReadPrec ComponentData
Int -> ReadS ComponentData
ReadS [ComponentData]
(Int -> ReadS ComponentData)
-> ReadS [ComponentData]
-> ReadPrec ComponentData
-> ReadPrec [ComponentData]
-> Read ComponentData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ComponentData
readsPrec :: Int -> ReadS ComponentData
$creadList :: ReadS [ComponentData]
readList :: ReadS [ComponentData]
$creadPrec :: ReadPrec ComponentData
readPrec :: ReadPrec ComponentData
$creadListPrec :: ReadPrec [ComponentData]
readListPrec :: ReadPrec [ComponentData]
Read, ComponentData -> ComponentData -> Bool
(ComponentData -> ComponentData -> Bool)
-> (ComponentData -> ComponentData -> Bool) -> Eq ComponentData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentData -> ComponentData -> Bool
== :: ComponentData -> ComponentData -> Bool
$c/= :: ComponentData -> ComponentData -> Bool
/= :: ComponentData -> ComponentData -> Bool
Eq, Eq ComponentData
Eq ComponentData =>
(ComponentData -> ComponentData -> Ordering)
-> (ComponentData -> ComponentData -> Bool)
-> (ComponentData -> ComponentData -> Bool)
-> (ComponentData -> ComponentData -> Bool)
-> (ComponentData -> ComponentData -> Bool)
-> (ComponentData -> ComponentData -> ComponentData)
-> (ComponentData -> ComponentData -> ComponentData)
-> Ord 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
$ccompare :: ComponentData -> ComponentData -> Ordering
compare :: ComponentData -> ComponentData -> Ordering
$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
>= :: ComponentData -> ComponentData -> Bool
$cmax :: ComponentData -> ComponentData -> ComponentData
max :: ComponentData -> ComponentData -> ComponentData
$cmin :: ComponentData -> ComponentData -> ComponentData
min :: ComponentData -> ComponentData -> ComponentData
Ord)

instance FromJSON ComponentData where
  parseJSON :: Value -> Parser ComponentData
parseJSON =
    String
-> (Object -> Parser ComponentData)
-> Value
-> Parser ComponentData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ComponentData"
      ( \Object
v -> do
          Text
cid <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component_type" :: Parser Int
          case Int
t of
            Int
2 -> ComponentData -> Parser ComponentData
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentData -> Parser ComponentData)
-> ComponentData -> Parser ComponentData
forall a b. (a -> b) -> a -> b
$ Text -> ComponentData
ButtonData Text
cid
            Int
_ | Int
t Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
3, Int
5, Int
6, Int
7, Int
8] ->
              Text -> SelectMenuData -> ComponentData
SelectMenuData Text
cid
                (SelectMenuData -> ComponentData)
-> Parser SelectMenuData -> Parser ComponentData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SelectMenuData
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
forall a. ToJSON a => a -> Value
toJSON Object
v)
            Int
_ -> String -> Parser ComponentData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ComponentData) -> String -> Parser ComponentData
forall a b. (a -> b) -> a -> b
$ String
"unknown interaction data component type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
t
      )

data SelectMenuData
  = SelectMenuDataText [T.Text] -- ^ The values of text chosen options
  | SelectMenuDataUser [UserId] -- ^ The users selected
  | SelectMenuDataRole [RoleId] -- ^ The roles selected
  | SelectMenuDataMentionable [Snowflake] -- ^ The users or roles selected
  | SelectMenuDataChannels [ChannelId] -- ^ The channels selected
  deriving (Int -> SelectMenuData -> ShowS
[SelectMenuData] -> ShowS
SelectMenuData -> String
(Int -> SelectMenuData -> ShowS)
-> (SelectMenuData -> String)
-> ([SelectMenuData] -> ShowS)
-> Show SelectMenuData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectMenuData -> ShowS
showsPrec :: Int -> SelectMenuData -> ShowS
$cshow :: SelectMenuData -> String
show :: SelectMenuData -> String
$cshowList :: [SelectMenuData] -> ShowS
showList :: [SelectMenuData] -> ShowS
Show, ReadPrec [SelectMenuData]
ReadPrec SelectMenuData
Int -> ReadS SelectMenuData
ReadS [SelectMenuData]
(Int -> ReadS SelectMenuData)
-> ReadS [SelectMenuData]
-> ReadPrec SelectMenuData
-> ReadPrec [SelectMenuData]
-> Read SelectMenuData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SelectMenuData
readsPrec :: Int -> ReadS SelectMenuData
$creadList :: ReadS [SelectMenuData]
readList :: ReadS [SelectMenuData]
$creadPrec :: ReadPrec SelectMenuData
readPrec :: ReadPrec SelectMenuData
$creadListPrec :: ReadPrec [SelectMenuData]
readListPrec :: ReadPrec [SelectMenuData]
Read, SelectMenuData -> SelectMenuData -> Bool
(SelectMenuData -> SelectMenuData -> Bool)
-> (SelectMenuData -> SelectMenuData -> Bool) -> Eq SelectMenuData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectMenuData -> SelectMenuData -> Bool
== :: SelectMenuData -> SelectMenuData -> Bool
$c/= :: SelectMenuData -> SelectMenuData -> Bool
/= :: SelectMenuData -> SelectMenuData -> Bool
Eq, Eq SelectMenuData
Eq SelectMenuData =>
(SelectMenuData -> SelectMenuData -> Ordering)
-> (SelectMenuData -> SelectMenuData -> Bool)
-> (SelectMenuData -> SelectMenuData -> Bool)
-> (SelectMenuData -> SelectMenuData -> Bool)
-> (SelectMenuData -> SelectMenuData -> Bool)
-> (SelectMenuData -> SelectMenuData -> SelectMenuData)
-> (SelectMenuData -> SelectMenuData -> SelectMenuData)
-> Ord SelectMenuData
SelectMenuData -> SelectMenuData -> Bool
SelectMenuData -> SelectMenuData -> Ordering
SelectMenuData -> SelectMenuData -> SelectMenuData
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
$ccompare :: SelectMenuData -> SelectMenuData -> Ordering
compare :: SelectMenuData -> SelectMenuData -> Ordering
$c< :: SelectMenuData -> SelectMenuData -> Bool
< :: SelectMenuData -> SelectMenuData -> Bool
$c<= :: SelectMenuData -> SelectMenuData -> Bool
<= :: SelectMenuData -> SelectMenuData -> Bool
$c> :: SelectMenuData -> SelectMenuData -> Bool
> :: SelectMenuData -> SelectMenuData -> Bool
$c>= :: SelectMenuData -> SelectMenuData -> Bool
>= :: SelectMenuData -> SelectMenuData -> Bool
$cmax :: SelectMenuData -> SelectMenuData -> SelectMenuData
max :: SelectMenuData -> SelectMenuData -> SelectMenuData
$cmin :: SelectMenuData -> SelectMenuData -> SelectMenuData
min :: SelectMenuData -> SelectMenuData -> SelectMenuData
Ord)

instance FromJSON SelectMenuData where
  parseJSON :: Value -> Parser SelectMenuData
parseJSON =
    String
-> (Object -> Parser SelectMenuData)
-> Value
-> Parser SelectMenuData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"SelectMenuData"
      ((Object -> Parser SelectMenuData)
 -> Value -> Parser SelectMenuData)
-> (Object -> Parser SelectMenuData)
-> Value
-> Parser SelectMenuData
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component_type" :: Parser Int
          let cons :: forall a. FromJSON a => ([a] -> SelectMenuData) -> Parser SelectMenuData
              cons :: forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [a] -> SelectMenuData
f = [a] -> SelectMenuData
f ([a] -> SelectMenuData) -> Parser [a] -> Parser SelectMenuData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values"
          case Int
t of
            Int
3 -> ([Text] -> SelectMenuData) -> Parser SelectMenuData
forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [Text] -> SelectMenuData
SelectMenuDataText
            Int
5 -> ([UserId] -> SelectMenuData) -> Parser SelectMenuData
forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [UserId] -> SelectMenuData
SelectMenuDataUser
            Int
6 -> ([RoleId] -> SelectMenuData) -> Parser SelectMenuData
forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [RoleId] -> SelectMenuData
SelectMenuDataRole
            Int
7 -> ([Snowflake] -> SelectMenuData) -> Parser SelectMenuData
forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [Snowflake] -> SelectMenuData
SelectMenuDataMentionable
            Int
8 -> ([ChannelId] -> SelectMenuData) -> Parser SelectMenuData
forall a.
FromJSON a =>
([a] -> SelectMenuData) -> Parser SelectMenuData
cons [ChannelId] -> SelectMenuData
SelectMenuDataChannels
            Int
_ -> String -> Parser SelectMenuData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SelectMenuData)
-> String -> Parser SelectMenuData
forall a b. (a -> b) -> a -> b
$ String
"unknown SelectMenuData type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
t

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

instance FromJSON ApplicationCommandData where
  parseJSON :: Value -> Parser ApplicationCommandData
parseJSON =
    String
-> (Object -> Parser ApplicationCommandData)
-> Value
-> Parser ApplicationCommandData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandData"
      ( \Object
v -> do
          ApplicationCommandId
aci <- Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Text
name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Maybe ResolvedData
rd <- Object
v Object -> Key -> Parser (Maybe ResolvedData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolved_data"
          Int
t <- Object
v Object -> Key -> Parser Int
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
                (Maybe OptionsData -> ApplicationCommandData)
-> Parser (Maybe OptionsData) -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe OptionsData)
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
                (UserId -> ApplicationCommandData)
-> Parser UserId -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser UserId
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
                (MessageId -> ApplicationCommandData)
-> Parser MessageId -> Parser ApplicationCommandData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser MessageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_id"
            Int
_ -> String -> Parser ApplicationCommandData
forall a. String -> Parser a
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
(Int -> OptionsData -> ShowS)
-> (OptionsData -> String)
-> ([OptionsData] -> ShowS)
-> Show OptionsData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionsData -> ShowS
showsPrec :: Int -> OptionsData -> ShowS
$cshow :: OptionsData -> String
show :: OptionsData -> String
$cshowList :: [OptionsData] -> ShowS
showList :: [OptionsData] -> ShowS
Show, ReadPrec [OptionsData]
ReadPrec OptionsData
Int -> ReadS OptionsData
ReadS [OptionsData]
(Int -> ReadS OptionsData)
-> ReadS [OptionsData]
-> ReadPrec OptionsData
-> ReadPrec [OptionsData]
-> Read OptionsData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionsData
readsPrec :: Int -> ReadS OptionsData
$creadList :: ReadS [OptionsData]
readList :: ReadS [OptionsData]
$creadPrec :: ReadPrec OptionsData
readPrec :: ReadPrec OptionsData
$creadListPrec :: ReadPrec [OptionsData]
readListPrec :: ReadPrec [OptionsData]
Read, OptionsData -> OptionsData -> Bool
(OptionsData -> OptionsData -> Bool)
-> (OptionsData -> OptionsData -> Bool) -> Eq OptionsData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionsData -> OptionsData -> Bool
== :: OptionsData -> OptionsData -> Bool
$c/= :: OptionsData -> OptionsData -> Bool
/= :: OptionsData -> OptionsData -> Bool
Eq, Eq OptionsData
Eq OptionsData =>
(OptionsData -> OptionsData -> Ordering)
-> (OptionsData -> OptionsData -> Bool)
-> (OptionsData -> OptionsData -> Bool)
-> (OptionsData -> OptionsData -> Bool)
-> (OptionsData -> OptionsData -> Bool)
-> (OptionsData -> OptionsData -> OptionsData)
-> (OptionsData -> OptionsData -> OptionsData)
-> Ord 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
$ccompare :: OptionsData -> OptionsData -> Ordering
compare :: OptionsData -> OptionsData -> Ordering
$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
>= :: OptionsData -> OptionsData -> Bool
$cmax :: OptionsData -> OptionsData -> OptionsData
max :: OptionsData -> OptionsData -> OptionsData
$cmin :: OptionsData -> OptionsData -> OptionsData
min :: OptionsData -> OptionsData -> OptionsData
Ord)

instance FromJSON OptionsData where
  parseJSON :: Value -> Parser OptionsData
parseJSON =
    String
-> (Array -> Parser OptionsData) -> Value -> Parser OptionsData
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray
      String
"OptionsData"
      ( \Array
a -> do
          let a' :: [Value]
a' = Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
          case [Value]
a' of
            [] -> OptionsData -> Parser OptionsData
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionsData -> Parser OptionsData)
-> OptionsData -> Parser OptionsData
forall a b. (a -> b) -> a -> b
$ [OptionDataValue] -> OptionsData
OptionsDataValues []
            (Value
v' : [Value]
_) ->
              String
-> (Object -> Parser OptionsData) -> Value -> Parser OptionsData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                String
"OptionsData item"
                ( \Object
v -> do
                    Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
                    if Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                      then [OptionDataSubcommandOrGroup] -> OptionsData
OptionsDataSubcommands ([OptionDataSubcommandOrGroup] -> OptionsData)
-> Parser [OptionDataSubcommandOrGroup] -> Parser OptionsData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionDataSubcommandOrGroup)
-> [Value] -> Parser [OptionDataSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser OptionDataSubcommandOrGroup
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                      else [OptionDataValue] -> OptionsData
OptionsDataValues ([OptionDataValue] -> OptionsData)
-> Parser [OptionDataValue] -> Parser OptionsData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser OptionDataValue)
-> [Value] -> Parser [OptionDataValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser OptionDataValue
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
(Int -> OptionDataSubcommandOrGroup -> ShowS)
-> (OptionDataSubcommandOrGroup -> String)
-> ([OptionDataSubcommandOrGroup] -> ShowS)
-> Show OptionDataSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionDataSubcommandOrGroup -> ShowS
showsPrec :: Int -> OptionDataSubcommandOrGroup -> ShowS
$cshow :: OptionDataSubcommandOrGroup -> String
show :: OptionDataSubcommandOrGroup -> String
$cshowList :: [OptionDataSubcommandOrGroup] -> ShowS
showList :: [OptionDataSubcommandOrGroup] -> ShowS
Show, ReadPrec [OptionDataSubcommandOrGroup]
ReadPrec OptionDataSubcommandOrGroup
Int -> ReadS OptionDataSubcommandOrGroup
ReadS [OptionDataSubcommandOrGroup]
(Int -> ReadS OptionDataSubcommandOrGroup)
-> ReadS [OptionDataSubcommandOrGroup]
-> ReadPrec OptionDataSubcommandOrGroup
-> ReadPrec [OptionDataSubcommandOrGroup]
-> Read OptionDataSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionDataSubcommandOrGroup
readsPrec :: Int -> ReadS OptionDataSubcommandOrGroup
$creadList :: ReadS [OptionDataSubcommandOrGroup]
readList :: ReadS [OptionDataSubcommandOrGroup]
$creadPrec :: ReadPrec OptionDataSubcommandOrGroup
readPrec :: ReadPrec OptionDataSubcommandOrGroup
$creadListPrec :: ReadPrec [OptionDataSubcommandOrGroup]
readListPrec :: ReadPrec [OptionDataSubcommandOrGroup]
Read, OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
(OptionDataSubcommandOrGroup
 -> OptionDataSubcommandOrGroup -> Bool)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> Bool)
-> Eq OptionDataSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
== :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$c/= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
/= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
Eq, Eq OptionDataSubcommandOrGroup
Eq OptionDataSubcommandOrGroup =>
(OptionDataSubcommandOrGroup
 -> OptionDataSubcommandOrGroup -> Ordering)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> Bool)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> Bool)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> Bool)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> Bool)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup)
-> (OptionDataSubcommandOrGroup
    -> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup)
-> Ord 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
$ccompare :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> Ordering
compare :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> Ordering
$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
>= :: OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup -> Bool
$cmax :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
max :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
$cmin :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
min :: OptionDataSubcommandOrGroup
-> OptionDataSubcommandOrGroup -> OptionDataSubcommandOrGroup
Ord)

instance FromJSON OptionDataSubcommandOrGroup where
  parseJSON :: Value -> Parser OptionDataSubcommandOrGroup
parseJSON =
    String
-> (Object -> Parser OptionDataSubcommandOrGroup)
-> Value
-> Parser OptionDataSubcommandOrGroup
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataSubcommandOrGroup"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
2 ->
              Text
-> [OptionDataSubcommand] -> Bool -> OptionDataSubcommandOrGroup
OptionDataSubcommandGroup
                (Text
 -> [OptionDataSubcommand] -> Bool -> OptionDataSubcommandOrGroup)
-> Parser Text
-> Parser
     ([OptionDataSubcommand] -> Bool -> OptionDataSubcommandOrGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser
  ([OptionDataSubcommand] -> Bool -> OptionDataSubcommandOrGroup)
-> Parser [OptionDataSubcommand]
-> Parser (Bool -> OptionDataSubcommandOrGroup)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [OptionDataSubcommand]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"options"
                Parser (Bool -> OptionDataSubcommandOrGroup)
-> Parser Bool -> Parser OptionDataSubcommandOrGroup
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
1 -> OptionDataSubcommand -> OptionDataSubcommandOrGroup
OptionDataSubcommandOrGroupSubcommand (OptionDataSubcommand -> OptionDataSubcommandOrGroup)
-> Parser OptionDataSubcommand
-> Parser OptionDataSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OptionDataSubcommand
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Int
_ -> String -> Parser OptionDataSubcommandOrGroup
forall a. String -> Parser a
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
(Int -> OptionDataSubcommand -> ShowS)
-> (OptionDataSubcommand -> String)
-> ([OptionDataSubcommand] -> ShowS)
-> Show OptionDataSubcommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionDataSubcommand -> ShowS
showsPrec :: Int -> OptionDataSubcommand -> ShowS
$cshow :: OptionDataSubcommand -> String
show :: OptionDataSubcommand -> String
$cshowList :: [OptionDataSubcommand] -> ShowS
showList :: [OptionDataSubcommand] -> ShowS
Show, ReadPrec [OptionDataSubcommand]
ReadPrec OptionDataSubcommand
Int -> ReadS OptionDataSubcommand
ReadS [OptionDataSubcommand]
(Int -> ReadS OptionDataSubcommand)
-> ReadS [OptionDataSubcommand]
-> ReadPrec OptionDataSubcommand
-> ReadPrec [OptionDataSubcommand]
-> Read OptionDataSubcommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionDataSubcommand
readsPrec :: Int -> ReadS OptionDataSubcommand
$creadList :: ReadS [OptionDataSubcommand]
readList :: ReadS [OptionDataSubcommand]
$creadPrec :: ReadPrec OptionDataSubcommand
readPrec :: ReadPrec OptionDataSubcommand
$creadListPrec :: ReadPrec [OptionDataSubcommand]
readListPrec :: ReadPrec [OptionDataSubcommand]
Read, OptionDataSubcommand -> OptionDataSubcommand -> Bool
(OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> (OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> Eq OptionDataSubcommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
== :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$c/= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
/= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
Eq, Eq OptionDataSubcommand
Eq OptionDataSubcommand =>
(OptionDataSubcommand -> OptionDataSubcommand -> Ordering)
-> (OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> (OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> (OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> (OptionDataSubcommand -> OptionDataSubcommand -> Bool)
-> (OptionDataSubcommand
    -> OptionDataSubcommand -> OptionDataSubcommand)
-> (OptionDataSubcommand
    -> OptionDataSubcommand -> OptionDataSubcommand)
-> Ord 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
$ccompare :: OptionDataSubcommand -> OptionDataSubcommand -> Ordering
compare :: OptionDataSubcommand -> OptionDataSubcommand -> Ordering
$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
>= :: OptionDataSubcommand -> OptionDataSubcommand -> Bool
$cmax :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
max :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
$cmin :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
min :: OptionDataSubcommand
-> OptionDataSubcommand -> OptionDataSubcommand
Ord)

instance FromJSON OptionDataSubcommand where
  parseJSON :: Value -> Parser OptionDataSubcommand
parseJSON =
    String
-> (Object -> Parser OptionDataSubcommand)
-> Value
-> Parser OptionDataSubcommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataSubcommand"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
          case Int
t of
            Int
1 ->
              Text -> [OptionDataValue] -> Bool -> OptionDataSubcommand
OptionDataSubcommand
                (Text -> [OptionDataValue] -> Bool -> OptionDataSubcommand)
-> Parser Text
-> Parser ([OptionDataValue] -> Bool -> OptionDataSubcommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser ([OptionDataValue] -> Bool -> OptionDataSubcommand)
-> Parser [OptionDataValue]
-> Parser (Bool -> OptionDataSubcommand)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [OptionDataValue])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options" Parser (Maybe [OptionDataValue])
-> [OptionDataValue] -> Parser [OptionDataValue]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
                Parser (Bool -> OptionDataSubcommand)
-> Parser Bool -> Parser OptionDataSubcommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Int
_ -> String -> Parser OptionDataSubcommand
forall a. String -> Parser a
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
(Int -> OptionDataValue -> ShowS)
-> (OptionDataValue -> String)
-> ([OptionDataValue] -> ShowS)
-> Show OptionDataValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionDataValue -> ShowS
showsPrec :: Int -> OptionDataValue -> ShowS
$cshow :: OptionDataValue -> String
show :: OptionDataValue -> String
$cshowList :: [OptionDataValue] -> ShowS
showList :: [OptionDataValue] -> ShowS
Show, ReadPrec [OptionDataValue]
ReadPrec OptionDataValue
Int -> ReadS OptionDataValue
ReadS [OptionDataValue]
(Int -> ReadS OptionDataValue)
-> ReadS [OptionDataValue]
-> ReadPrec OptionDataValue
-> ReadPrec [OptionDataValue]
-> Read OptionDataValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OptionDataValue
readsPrec :: Int -> ReadS OptionDataValue
$creadList :: ReadS [OptionDataValue]
readList :: ReadS [OptionDataValue]
$creadPrec :: ReadPrec OptionDataValue
readPrec :: ReadPrec OptionDataValue
$creadListPrec :: ReadPrec [OptionDataValue]
readListPrec :: ReadPrec [OptionDataValue]
Read, OptionDataValue -> OptionDataValue -> Bool
(OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> Eq OptionDataValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionDataValue -> OptionDataValue -> Bool
== :: OptionDataValue -> OptionDataValue -> Bool
$c/= :: OptionDataValue -> OptionDataValue -> Bool
/= :: OptionDataValue -> OptionDataValue -> Bool
Eq, Eq OptionDataValue
Eq OptionDataValue =>
(OptionDataValue -> OptionDataValue -> Ordering)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> Bool)
-> (OptionDataValue -> OptionDataValue -> OptionDataValue)
-> (OptionDataValue -> OptionDataValue -> OptionDataValue)
-> Ord 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
$ccompare :: OptionDataValue -> OptionDataValue -> Ordering
compare :: OptionDataValue -> OptionDataValue -> Ordering
$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
>= :: OptionDataValue -> OptionDataValue -> Bool
$cmax :: OptionDataValue -> OptionDataValue -> OptionDataValue
max :: OptionDataValue -> OptionDataValue -> OptionDataValue
$cmin :: OptionDataValue -> OptionDataValue -> OptionDataValue
min :: OptionDataValue -> OptionDataValue -> OptionDataValue
Ord)

instance FromJSON OptionDataValue where
  parseJSON :: Value -> Parser OptionDataValue
parseJSON =
    String
-> (Object -> Parser OptionDataValue)
-> Value
-> Parser OptionDataValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"OptionDataValue"
      ( \Object
v -> do
          Text
name <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          Bool
focused <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"focused" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Int
t <- Object
v Object -> Key -> Parser Int
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
                (Either Text Text -> OptionDataValue)
-> Parser (Either Text Text) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Text)
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
                (Either Text Integer -> OptionDataValue)
-> Parser (Either Text Integer) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Integer)
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
                (Either Text Number -> OptionDataValue)
-> Parser (Either Text Number) -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Bool -> Parser (Either Text Number)
forall a. FromJSON a => Object -> Bool -> Parser (Either Text a)
parseValue Object
v Bool
focused
            Int
5 ->
              Text -> Bool -> OptionDataValue
OptionDataValueBoolean Text
name
                (Bool -> OptionDataValue) -> Parser Bool -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
6 ->
              Text -> UserId -> OptionDataValue
OptionDataValueUser Text
name
                (UserId -> OptionDataValue)
-> Parser UserId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
7 ->
              Text -> ChannelId -> OptionDataValue
OptionDataValueChannel Text
name
                (ChannelId -> OptionDataValue)
-> Parser ChannelId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ChannelId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
8 ->
              Text -> RoleId -> OptionDataValue
OptionDataValueRole Text
name
                (RoleId -> OptionDataValue)
-> Parser RoleId -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser RoleId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
9 ->
              Text -> Snowflake -> OptionDataValue
OptionDataValueMentionable Text
name
                (Snowflake -> OptionDataValue)
-> Parser Snowflake -> Parser OptionDataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Snowflake
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
            Int
_ -> String -> Parser OptionDataValue
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser OptionDataValue)
-> String -> Parser OptionDataValue
forall a b. (a -> b) -> a -> b
$ String
"unexpected interaction data application command option value type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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
(Int -> ModalData -> ShowS)
-> (ModalData -> String)
-> ([ModalData] -> ShowS)
-> Show ModalData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModalData -> ShowS
showsPrec :: Int -> ModalData -> ShowS
$cshow :: ModalData -> String
show :: ModalData -> String
$cshowList :: [ModalData] -> ShowS
showList :: [ModalData] -> ShowS
Show, ReadPrec [ModalData]
ReadPrec ModalData
Int -> ReadS ModalData
ReadS [ModalData]
(Int -> ReadS ModalData)
-> ReadS [ModalData]
-> ReadPrec ModalData
-> ReadPrec [ModalData]
-> Read ModalData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModalData
readsPrec :: Int -> ReadS ModalData
$creadList :: ReadS [ModalData]
readList :: ReadS [ModalData]
$creadPrec :: ReadPrec ModalData
readPrec :: ReadPrec ModalData
$creadListPrec :: ReadPrec [ModalData]
readListPrec :: ReadPrec [ModalData]
Read, ModalData -> ModalData -> Bool
(ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool) -> Eq ModalData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModalData -> ModalData -> Bool
== :: ModalData -> ModalData -> Bool
$c/= :: ModalData -> ModalData -> Bool
/= :: ModalData -> ModalData -> Bool
Eq, Eq ModalData
Eq ModalData =>
(ModalData -> ModalData -> Ordering)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> Bool)
-> (ModalData -> ModalData -> ModalData)
-> (ModalData -> ModalData -> ModalData)
-> Ord 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
$ccompare :: ModalData -> ModalData -> Ordering
compare :: ModalData -> ModalData -> Ordering
$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
>= :: ModalData -> ModalData -> Bool
$cmax :: ModalData -> ModalData -> ModalData
max :: ModalData -> ModalData -> ModalData
$cmin :: ModalData -> ModalData -> ModalData
min :: ModalData -> ModalData -> ModalData
Ord)

instance FromJSON ModalData where
  parseJSON :: Value -> Parser ModalData
parseJSON =
    String -> (Object -> Parser ModalData) -> Value -> Parser ModalData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ModalData"
      ( \Object
v ->
          Text -> [TextInput] -> ModalData
ModalData (Text -> [TextInput] -> ModalData)
-> Parser Text -> Parser ([TextInput] -> ModalData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"
            Parser ([TextInput] -> ModalData)
-> Parser [TextInput] -> Parser ModalData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
v Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components") Parser [Value]
-> ([Value] -> Parser [TextInput]) -> Parser [TextInput]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([[TextInput]] -> [TextInput]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[TextInput]] -> [TextInput])
-> Parser [[TextInput]] -> Parser [TextInput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser [[TextInput]] -> Parser [TextInput])
-> ([Value] -> Parser [[TextInput]])
-> [Value]
-> Parser [TextInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser [TextInput]) -> [Value] -> Parser [[TextInput]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser [TextInput]
getTextInput)
      )
    where
      getTextInput :: Value -> Parser [TextInput]
      getTextInput :: Value -> Parser [TextInput]
getTextInput = String
-> (Object -> Parser [TextInput]) -> Value -> Parser [TextInput]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModalData.TextInput" ((Object -> Parser [TextInput]) -> Value -> Parser [TextInput])
-> (Object -> Parser [TextInput]) -> Value -> Parser [TextInput]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Int
t <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" :: Parser Int
        case Int
t of
          Int
1 -> Object
o Object -> Key -> Parser [TextInput]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"components"
          Int
_ -> String -> Parser [TextInput]
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser [TextInput]) -> String -> Parser [TextInput]
forall a b. (a -> b) -> a -> b
$ String
"expected action row type (1), got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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 = Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Parser Text -> Parser (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
parseValue Object
o Bool
False = a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> Parser a -> Parser (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
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
(Int -> ResolvedData -> ShowS)
-> (ResolvedData -> String)
-> ([ResolvedData] -> ShowS)
-> Show ResolvedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolvedData -> ShowS
showsPrec :: Int -> ResolvedData -> ShowS
$cshow :: ResolvedData -> String
show :: ResolvedData -> String
$cshowList :: [ResolvedData] -> ShowS
showList :: [ResolvedData] -> ShowS
Show, ReadPrec [ResolvedData]
ReadPrec ResolvedData
Int -> ReadS ResolvedData
ReadS [ResolvedData]
(Int -> ReadS ResolvedData)
-> ReadS [ResolvedData]
-> ReadPrec ResolvedData
-> ReadPrec [ResolvedData]
-> Read ResolvedData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ResolvedData
readsPrec :: Int -> ReadS ResolvedData
$creadList :: ReadS [ResolvedData]
readList :: ReadS [ResolvedData]
$creadPrec :: ReadPrec ResolvedData
readPrec :: ReadPrec ResolvedData
$creadListPrec :: ReadPrec [ResolvedData]
readListPrec :: ReadPrec [ResolvedData]
Read, ResolvedData -> ResolvedData -> Bool
(ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool) -> Eq ResolvedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolvedData -> ResolvedData -> Bool
== :: ResolvedData -> ResolvedData -> Bool
$c/= :: ResolvedData -> ResolvedData -> Bool
/= :: ResolvedData -> ResolvedData -> Bool
Eq, Eq ResolvedData
Eq ResolvedData =>
(ResolvedData -> ResolvedData -> Ordering)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> Bool)
-> (ResolvedData -> ResolvedData -> ResolvedData)
-> (ResolvedData -> ResolvedData -> ResolvedData)
-> Ord 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
$ccompare :: ResolvedData -> ResolvedData -> Ordering
compare :: ResolvedData -> ResolvedData -> Ordering
$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
>= :: ResolvedData -> ResolvedData -> Bool
$cmax :: ResolvedData -> ResolvedData -> ResolvedData
max :: ResolvedData -> ResolvedData -> ResolvedData
$cmin :: ResolvedData -> ResolvedData -> ResolvedData
min :: ResolvedData -> ResolvedData -> ResolvedData
Ord)

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

instance FromJSON ResolvedData where
  parseJSON :: Value -> Parser ResolvedData
parseJSON =
    String
-> (Object -> Parser ResolvedData) -> Value -> Parser ResolvedData
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
            (Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> Maybe Value
 -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> Maybe Value
      -> ResolvedData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"users"
            Parser
  (Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> Maybe Value
   -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value
      -> Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"members"
            Parser
  (Maybe Value
   -> Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
            Parser (Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value)
-> Parser (Maybe Value -> Maybe Value -> ResolvedData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channels"
            Parser (Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value) -> Parser (Maybe Value -> ResolvedData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"messages"
            Parser (Maybe Value -> ResolvedData)
-> Parser (Maybe Value) -> Parser ResolvedData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
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
(Int -> InteractionResponse -> ShowS)
-> (InteractionResponse -> String)
-> ([InteractionResponse] -> ShowS)
-> Show InteractionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionResponse -> ShowS
showsPrec :: Int -> InteractionResponse -> ShowS
$cshow :: InteractionResponse -> String
show :: InteractionResponse -> String
$cshowList :: [InteractionResponse] -> ShowS
showList :: [InteractionResponse] -> ShowS
Show, ReadPrec [InteractionResponse]
ReadPrec InteractionResponse
Int -> ReadS InteractionResponse
ReadS [InteractionResponse]
(Int -> ReadS InteractionResponse)
-> ReadS [InteractionResponse]
-> ReadPrec InteractionResponse
-> ReadPrec [InteractionResponse]
-> Read InteractionResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InteractionResponse
readsPrec :: Int -> ReadS InteractionResponse
$creadList :: ReadS [InteractionResponse]
readList :: ReadS [InteractionResponse]
$creadPrec :: ReadPrec InteractionResponse
readPrec :: ReadPrec InteractionResponse
$creadListPrec :: ReadPrec [InteractionResponse]
readListPrec :: ReadPrec [InteractionResponse]
Read, InteractionResponse -> InteractionResponse -> Bool
(InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> Eq InteractionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionResponse -> InteractionResponse -> Bool
== :: InteractionResponse -> InteractionResponse -> Bool
$c/= :: InteractionResponse -> InteractionResponse -> Bool
/= :: InteractionResponse -> InteractionResponse -> Bool
Eq, Eq InteractionResponse
Eq InteractionResponse =>
(InteractionResponse -> InteractionResponse -> Ordering)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse
    -> InteractionResponse -> InteractionResponse)
-> (InteractionResponse
    -> InteractionResponse -> InteractionResponse)
-> Ord 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
$ccompare :: InteractionResponse -> InteractionResponse -> Ordering
compare :: InteractionResponse -> InteractionResponse -> Ordering
$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
>= :: InteractionResponse -> InteractionResponse -> Bool
$cmax :: InteractionResponse -> InteractionResponse -> InteractionResponse
max :: InteractionResponse -> InteractionResponse -> InteractionResponse
$cmin :: InteractionResponse -> InteractionResponse -> InteractionResponse
min :: InteractionResponse -> InteractionResponse -> InteractionResponse
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", InteractionResponseMessage -> Value
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", InteractionResponseMessage -> Value
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", InteractionResponseAutocomplete -> Value
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", InteractionResponseModalData -> Value
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
(Int -> InteractionResponseAutocomplete -> ShowS)
-> (InteractionResponseAutocomplete -> String)
-> ([InteractionResponseAutocomplete] -> ShowS)
-> Show InteractionResponseAutocomplete
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
showsPrec :: Int -> InteractionResponseAutocomplete -> ShowS
$cshow :: InteractionResponseAutocomplete -> String
show :: InteractionResponseAutocomplete -> String
$cshowList :: [InteractionResponseAutocomplete] -> ShowS
showList :: [InteractionResponseAutocomplete] -> ShowS
Show, ReadPrec [InteractionResponseAutocomplete]
ReadPrec InteractionResponseAutocomplete
Int -> ReadS InteractionResponseAutocomplete
ReadS [InteractionResponseAutocomplete]
(Int -> ReadS InteractionResponseAutocomplete)
-> ReadS [InteractionResponseAutocomplete]
-> ReadPrec InteractionResponseAutocomplete
-> ReadPrec [InteractionResponseAutocomplete]
-> Read InteractionResponseAutocomplete
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InteractionResponseAutocomplete
readsPrec :: Int -> ReadS InteractionResponseAutocomplete
$creadList :: ReadS [InteractionResponseAutocomplete]
readList :: ReadS [InteractionResponseAutocomplete]
$creadPrec :: ReadPrec InteractionResponseAutocomplete
readPrec :: ReadPrec InteractionResponseAutocomplete
$creadListPrec :: ReadPrec [InteractionResponseAutocomplete]
readListPrec :: ReadPrec [InteractionResponseAutocomplete]
Read, InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
(InteractionResponseAutocomplete
 -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> Eq InteractionResponseAutocomplete
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
== :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$c/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
/= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
Eq, Eq InteractionResponseAutocomplete
Eq InteractionResponseAutocomplete =>
(InteractionResponseAutocomplete
 -> InteractionResponseAutocomplete -> Ordering)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete -> Bool)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete)
-> (InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete
    -> InteractionResponseAutocomplete)
-> Ord 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
$ccompare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
compare :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Ordering
$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
>= :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete -> Bool
$cmax :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
max :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
$cmin :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
min :: InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
-> InteractionResponseAutocomplete
Ord)

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

-- | A cut down message structure.
-- The 'Default' instance of this type yields a 'def' value whose fields are all empty.
-- As such, the 'def' value is not a valid response message and needs to be adjusted before being used.
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
(Int -> InteractionResponseMessage -> ShowS)
-> (InteractionResponseMessage -> String)
-> ([InteractionResponseMessage] -> ShowS)
-> Show InteractionResponseMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionResponseMessage -> ShowS
showsPrec :: Int -> InteractionResponseMessage -> ShowS
$cshow :: InteractionResponseMessage -> String
show :: InteractionResponseMessage -> String
$cshowList :: [InteractionResponseMessage] -> ShowS
showList :: [InteractionResponseMessage] -> ShowS
Show, ReadPrec [InteractionResponseMessage]
ReadPrec InteractionResponseMessage
Int -> ReadS InteractionResponseMessage
ReadS [InteractionResponseMessage]
(Int -> ReadS InteractionResponseMessage)
-> ReadS [InteractionResponseMessage]
-> ReadPrec InteractionResponseMessage
-> ReadPrec [InteractionResponseMessage]
-> Read InteractionResponseMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InteractionResponseMessage
readsPrec :: Int -> ReadS InteractionResponseMessage
$creadList :: ReadS [InteractionResponseMessage]
readList :: ReadS [InteractionResponseMessage]
$creadPrec :: ReadPrec InteractionResponseMessage
readPrec :: ReadPrec InteractionResponseMessage
$creadListPrec :: ReadPrec [InteractionResponseMessage]
readListPrec :: ReadPrec [InteractionResponseMessage]
Read, InteractionResponseMessage -> InteractionResponseMessage -> Bool
(InteractionResponseMessage -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> Eq InteractionResponseMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
== :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$c/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
/= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
Eq, Eq InteractionResponseMessage
Eq InteractionResponseMessage =>
(InteractionResponseMessage
 -> InteractionResponseMessage -> Ordering)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> Bool)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> InteractionResponseMessage)
-> (InteractionResponseMessage
    -> InteractionResponseMessage -> InteractionResponseMessage)
-> Ord 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
$ccompare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
compare :: InteractionResponseMessage
-> InteractionResponseMessage -> Ordering
$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
>= :: InteractionResponseMessage -> InteractionResponseMessage -> Bool
$cmax :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
max :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
$cmin :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
min :: InteractionResponseMessage
-> InteractionResponseMessage -> InteractionResponseMessage
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 Maybe Bool
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) Maybe [CreateEmbed]
forall a. Maybe a
Nothing Maybe AllowedMentions
forall a. Maybe a
Nothing Maybe InteractionResponseMessageFlags
forall a. Maybe a
Nothing Maybe [ActionRow]
forall a. Maybe a
Nothing Maybe [Attachment]
forall a. Maybe a
Nothing

instance Default InteractionResponseMessage where
  def :: InteractionResponseMessage
def = Maybe Bool
-> Maybe Text
-> Maybe [CreateEmbed]
-> Maybe AllowedMentions
-> Maybe InteractionResponseMessageFlags
-> Maybe [ActionRow]
-> Maybe [Attachment]
-> InteractionResponseMessage
InteractionResponseMessage Maybe Bool
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [CreateEmbed]
forall a. Maybe a
Nothing Maybe AllowedMentions
forall a. Maybe a
Nothing Maybe InteractionResponseMessageFlags
forall a. Maybe a
Nothing Maybe [ActionRow]
forall a. Maybe a
Nothing Maybe [Attachment]
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
interactionResponseMessageTTS :: InteractionResponseMessage -> Maybe Bool
interactionResponseMessageContent :: InteractionResponseMessage -> Maybe Text
interactionResponseMessageEmbeds :: InteractionResponseMessage -> Maybe [CreateEmbed]
interactionResponseMessageAllowedMentions :: InteractionResponseMessage -> Maybe AllowedMentions
interactionResponseMessageFlags :: InteractionResponseMessage -> Maybe InteractionResponseMessageFlags
interactionResponseMessageComponents :: InteractionResponseMessage -> Maybe [ActionRow]
interactionResponseMessageAttachments :: InteractionResponseMessage -> Maybe [Attachment]
interactionResponseMessageTTS :: Maybe Bool
interactionResponseMessageContent :: Maybe Text
interactionResponseMessageEmbeds :: Maybe [CreateEmbed]
interactionResponseMessageAllowedMentions :: Maybe AllowedMentions
interactionResponseMessageFlags :: Maybe InteractionResponseMessageFlags
interactionResponseMessageComponents :: Maybe [ActionRow]
interactionResponseMessageAttachments :: Maybe [Attachment]
..} =
    [Maybe Pair] -> Value
objectFromMaybes
      [ Key
"tts" Key -> Maybe Bool -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Bool
interactionResponseMessageTTS,
        Key
"content" Key -> Maybe Text -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe Text
interactionResponseMessageContent,
        Key
"embeds" Key -> Maybe [Embed] -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? ((CreateEmbed -> Embed
createEmbed (CreateEmbed -> Embed) -> [CreateEmbed] -> [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([CreateEmbed] -> [Embed]) -> Maybe [CreateEmbed] -> Maybe [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CreateEmbed]
interactionResponseMessageEmbeds),
        Key
"allowed_mentions" Key -> Maybe AllowedMentions -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe AllowedMentions
interactionResponseMessageAllowedMentions,
        Key
"flags" Key -> Maybe InteractionResponseMessageFlags -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe InteractionResponseMessageFlags
interactionResponseMessageFlags,
        Key
"components" Key -> Maybe [ActionRow] -> Maybe Pair
forall a. ToJSON a => Key -> Maybe a -> Maybe Pair
.=? Maybe [ActionRow]
interactionResponseMessageComponents,
        Key
"attachments" Key -> Maybe [Attachment] -> Maybe Pair
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
(Int -> InteractionResponseMessageFlag -> ShowS)
-> (InteractionResponseMessageFlag -> String)
-> ([InteractionResponseMessageFlag] -> ShowS)
-> Show InteractionResponseMessageFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
showsPrec :: Int -> InteractionResponseMessageFlag -> ShowS
$cshow :: InteractionResponseMessageFlag -> String
show :: InteractionResponseMessageFlag -> String
$cshowList :: [InteractionResponseMessageFlag] -> ShowS
showList :: [InteractionResponseMessageFlag] -> ShowS
Show, ReadPrec [InteractionResponseMessageFlag]
ReadPrec InteractionResponseMessageFlag
Int -> ReadS InteractionResponseMessageFlag
ReadS [InteractionResponseMessageFlag]
(Int -> ReadS InteractionResponseMessageFlag)
-> ReadS [InteractionResponseMessageFlag]
-> ReadPrec InteractionResponseMessageFlag
-> ReadPrec [InteractionResponseMessageFlag]
-> Read InteractionResponseMessageFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InteractionResponseMessageFlag
readsPrec :: Int -> ReadS InteractionResponseMessageFlag
$creadList :: ReadS [InteractionResponseMessageFlag]
readList :: ReadS [InteractionResponseMessageFlag]
$creadPrec :: ReadPrec InteractionResponseMessageFlag
readPrec :: ReadPrec InteractionResponseMessageFlag
$creadListPrec :: ReadPrec [InteractionResponseMessageFlag]
readListPrec :: ReadPrec [InteractionResponseMessageFlag]
Read, InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
(InteractionResponseMessageFlag
 -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> Eq InteractionResponseMessageFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
== :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$c/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
/= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
Eq, Eq InteractionResponseMessageFlag
Eq InteractionResponseMessageFlag =>
(InteractionResponseMessageFlag
 -> InteractionResponseMessageFlag -> Ordering)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag -> Bool)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag)
-> (InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag
    -> InteractionResponseMessageFlag)
-> Ord 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
$ccompare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
compare :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Ordering
$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
>= :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> Bool
$cmax :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
max :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
$cmin :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
min :: InteractionResponseMessageFlag
-> InteractionResponseMessageFlag -> InteractionResponseMessageFlag
Ord)

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

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

instance ToJSON InteractionResponseMessageFlags where
  toJSON :: InteractionResponseMessageFlags -> Value
toJSON (InteractionResponseMessageFlags [InteractionResponseMessageFlag]
fs) = Number -> Value
Number (Number -> Value) -> Number -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Number
forall a. Num a => Integer -> a
fromInteger (Integer -> Number) -> Integer -> Number
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 (InteractionResponseMessageFlag -> Int
forall a. Enum a => a -> Int
fromEnum (InteractionResponseMessageFlag -> Int)
-> [InteractionResponseMessageFlag] -> [Int]
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
(Int -> InteractionResponseModalData -> ShowS)
-> (InteractionResponseModalData -> String)
-> ([InteractionResponseModalData] -> ShowS)
-> Show InteractionResponseModalData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionResponseModalData -> ShowS
showsPrec :: Int -> InteractionResponseModalData -> ShowS
$cshow :: InteractionResponseModalData -> String
show :: InteractionResponseModalData -> String
$cshowList :: [InteractionResponseModalData] -> ShowS
showList :: [InteractionResponseModalData] -> ShowS
Show, ReadPrec [InteractionResponseModalData]
ReadPrec InteractionResponseModalData
Int -> ReadS InteractionResponseModalData
ReadS [InteractionResponseModalData]
(Int -> ReadS InteractionResponseModalData)
-> ReadS [InteractionResponseModalData]
-> ReadPrec InteractionResponseModalData
-> ReadPrec [InteractionResponseModalData]
-> Read InteractionResponseModalData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InteractionResponseModalData
readsPrec :: Int -> ReadS InteractionResponseModalData
$creadList :: ReadS [InteractionResponseModalData]
readList :: ReadS [InteractionResponseModalData]
$creadPrec :: ReadPrec InteractionResponseModalData
readPrec :: ReadPrec InteractionResponseModalData
$creadListPrec :: ReadPrec [InteractionResponseModalData]
readListPrec :: ReadPrec [InteractionResponseModalData]
Read, InteractionResponseModalData
-> InteractionResponseModalData -> Bool
(InteractionResponseModalData
 -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> Eq InteractionResponseModalData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
== :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$c/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
/= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
Eq, Eq InteractionResponseModalData
Eq InteractionResponseModalData =>
(InteractionResponseModalData
 -> InteractionResponseModalData -> Ordering)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> Bool)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> InteractionResponseModalData)
-> (InteractionResponseModalData
    -> InteractionResponseModalData -> InteractionResponseModalData)
-> Ord 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
$ccompare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
compare :: InteractionResponseModalData
-> InteractionResponseModalData -> Ordering
$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
>= :: InteractionResponseModalData
-> InteractionResponseModalData -> Bool
$cmax :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
max :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
$cmin :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
min :: InteractionResponseModalData
-> InteractionResponseModalData -> InteractionResponseModalData
Ord)

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