{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Discord.Internal.Types.Interactions
  ( Interaction (..),
    InteractionDataComponent (..),
    InteractionDataApplicationCommand (..),
    InteractionDataApplicationCommandOptions (..),
    InteractionDataApplicationCommandOptionSubcommandOrGroup (..),
    InteractionDataApplicationCommandOptionSubcommand (..),
    InteractionDataApplicationCommandOptionValue (..),
    ApplicationCommandInteractionDataValue (..),
    InternalInteraction (..),
    InteractionToken,
    InteractionType,
    InternalInteractionData (..),
    ResolvedData (..),
    InternalInteractionDataApplicationCommandOption (..),
    InteractionResponse (..),
    interactionResponseBasic,
    InteractionCallbackType (..),
    InteractionCallbackData (..),
    InteractionCallbackAutocomplete,
    InteractionCallbackMessages (..),
    interactionCallbackMessagesBasic,
    InteractionCallbackDataFlags (..),
    InteractionCallbackDataFlag (..),
  )
where

import Control.Applicative (Alternative ((<|>)))
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Bits (Bits (shift, (.|.)))
import Data.Data (Data)
import Data.Maybe (fromJust, fromMaybe)
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.ApplicationCommands
  (
    InternalApplicationCommandOptionChoice,
    ApplicationCommandOptionType (..),
    ApplicationCommandType (..),
  )
import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)
import Discord.Internal.Types.Components (Component, ComponentType (..))
import Discord.Internal.Types.Embed (Embed)
import Discord.Internal.Types.Prelude (ApplicationId, ApplicationCommandId, ChannelId, GuildId, InteractionId, InteractionToken, InteractionType (..), Internals (..), MessageId, Snowflake, UserId, makeTable, toMaybeJSON)
import Discord.Internal.Types.User (GuildMember, User)

import Debug.Trace

data Interaction
  = InteractionComponent
      { Interaction -> InteractionId
interactionId :: InteractionId,
        Interaction -> InteractionId
interactionApplicationId :: ApplicationId,
        Interaction -> Maybe InteractionDataComponent
interactionDataComponent :: Maybe InteractionDataComponent, -- referenced as Data in API
        Interaction -> Maybe InteractionId
interactionGuildId :: Maybe GuildId,
        Interaction -> Maybe InteractionId
interactionChannelId :: Maybe ChannelId,
        Interaction -> Maybe GuildMember
interactionMember :: Maybe GuildMember,
        Interaction -> Maybe User
interactionUser :: Maybe User,
        Interaction -> InteractionToken
interactionToken :: InteractionToken,
        Interaction -> Int
interactionVersion :: Int,
        Interaction -> Message
interactionMessage :: Message
      }
  | InteractionPing
      { interactionId :: InteractionId,
        interactionApplicationId :: ApplicationId,
        interactionToken :: InteractionToken,
        interactionVersion :: Int
      }
  | InteractionApplicationCommand
      { interactionId :: InteractionId,
        interactionApplicationId :: ApplicationId,
        Interaction -> Maybe InteractionDataApplicationCommand
interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API
        interactionGuildId :: Maybe GuildId,
        interactionChannelId :: Maybe ChannelId,
        interactionMember :: Maybe GuildMember,
        interactionUser :: Maybe User,
        interactionToken :: InteractionToken,
        interactionVersion :: Int
      }
  | InteractionApplicationCommandAutocomplete
      { interactionId :: InteractionId,
        interactionApplicationId :: ApplicationId,
        interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API
        interactionGuildId :: Maybe GuildId,
        interactionChannelId :: Maybe ChannelId,
        interactionMember :: Maybe GuildMember,
        interactionUser :: Maybe User,
        interactionToken :: InteractionToken,
        interactionVersion :: Int
      }
  | InteractionUnknown InternalInteraction
  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
showList :: [Interaction] -> ShowS
$cshowList :: [Interaction] -> ShowS
show :: Interaction -> String
$cshow :: Interaction -> String
showsPrec :: Int -> Interaction -> ShowS
$cshowsPrec :: Int -> Interaction -> ShowS
Show, ReadPrec [Interaction]
ReadPrec Interaction
Int -> ReadS Interaction
ReadS [Interaction]
(Int -> ReadS Interaction)
-> ReadS [Interaction]
-> ReadPrec Interaction
-> ReadPrec [Interaction]
-> Read Interaction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Interaction]
$creadListPrec :: ReadPrec [Interaction]
readPrec :: ReadPrec Interaction
$creadPrec :: ReadPrec Interaction
readList :: ReadS [Interaction]
$creadList :: ReadS [Interaction]
readsPrec :: Int -> ReadS Interaction
$creadsPrec :: Int -> ReadS Interaction
Read, Interaction -> Interaction -> Bool
(Interaction -> Interaction -> Bool)
-> (Interaction -> Interaction -> Bool) -> Eq Interaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interaction -> Interaction -> Bool
$c/= :: Interaction -> Interaction -> Bool
== :: Interaction -> Interaction -> Bool
$c== :: Interaction -> Interaction -> Bool
Eq)

data InteractionDataComponent
  = InteractionDataComponentButton
      { -- | Component only, the unique id
        InteractionDataComponent -> InteractionToken
interactionDataComponentCustomId :: T.Text
      }
  | InteractionDataComponentSelectMenu
      { interactionDataComponentCustomId :: T.Text,
        InteractionDataComponent -> [InteractionToken]
interactionDataComponentValues :: [T.Text]
      }
  deriving (Int -> InteractionDataComponent -> ShowS
[InteractionDataComponent] -> ShowS
InteractionDataComponent -> String
(Int -> InteractionDataComponent -> ShowS)
-> (InteractionDataComponent -> String)
-> ([InteractionDataComponent] -> ShowS)
-> Show InteractionDataComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataComponent] -> ShowS
$cshowList :: [InteractionDataComponent] -> ShowS
show :: InteractionDataComponent -> String
$cshow :: InteractionDataComponent -> String
showsPrec :: Int -> InteractionDataComponent -> ShowS
$cshowsPrec :: Int -> InteractionDataComponent -> ShowS
Show, ReadPrec [InteractionDataComponent]
ReadPrec InteractionDataComponent
Int -> ReadS InteractionDataComponent
ReadS [InteractionDataComponent]
(Int -> ReadS InteractionDataComponent)
-> ReadS [InteractionDataComponent]
-> ReadPrec InteractionDataComponent
-> ReadPrec [InteractionDataComponent]
-> Read InteractionDataComponent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataComponent]
$creadListPrec :: ReadPrec [InteractionDataComponent]
readPrec :: ReadPrec InteractionDataComponent
$creadPrec :: ReadPrec InteractionDataComponent
readList :: ReadS [InteractionDataComponent]
$creadList :: ReadS [InteractionDataComponent]
readsPrec :: Int -> ReadS InteractionDataComponent
$creadsPrec :: Int -> ReadS InteractionDataComponent
Read, InteractionDataComponent -> InteractionDataComponent -> Bool
(InteractionDataComponent -> InteractionDataComponent -> Bool)
-> (InteractionDataComponent -> InteractionDataComponent -> Bool)
-> Eq InteractionDataComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c/= :: InteractionDataComponent -> InteractionDataComponent -> Bool
== :: InteractionDataComponent -> InteractionDataComponent -> Bool
$c== :: InteractionDataComponent -> InteractionDataComponent -> Bool
Eq)

data InteractionDataApplicationCommand
  = InteractionDataApplicationCommandUser
      { -- | id of the invoked command
        InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | name of the invoked command
        InteractionDataApplicationCommand -> InteractionToken
interactionDataApplicationCommandName :: T.Text,
        -- | the resolved data in the command
        InteractionDataApplicationCommand -> Maybe ResolvedData
interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        -- | the target of the command
        InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandTargetId :: UserId
      }
  | InteractionDataApplicationCommandMessage
      { -- | Application command only, id of the invoked command
        interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | Application command only, name of the invoked command
        interactionDataApplicationCommandName :: T.Text,
        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        interactionDataApplicationCommandTargetId :: MessageId
      }
  | InteractionDataApplicationCommandChatInput
      { -- | Application command only, id of the invoked command
        interactionDataApplicationCommandId :: ApplicationCommandId,
        -- | Application command only, name of the invoked command
        interactionDataApplicationCommandName :: T.Text,
        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,
        InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommandOptions
interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions
      }
  deriving (Int -> InteractionDataApplicationCommand -> ShowS
[InteractionDataApplicationCommand] -> ShowS
InteractionDataApplicationCommand -> String
(Int -> InteractionDataApplicationCommand -> ShowS)
-> (InteractionDataApplicationCommand -> String)
-> ([InteractionDataApplicationCommand] -> ShowS)
-> Show InteractionDataApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommand] -> ShowS
$cshowList :: [InteractionDataApplicationCommand] -> ShowS
show :: InteractionDataApplicationCommand -> String
$cshow :: InteractionDataApplicationCommand -> String
showsPrec :: Int -> InteractionDataApplicationCommand -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommand -> ShowS
Show, ReadPrec [InteractionDataApplicationCommand]
ReadPrec InteractionDataApplicationCommand
Int -> ReadS InteractionDataApplicationCommand
ReadS [InteractionDataApplicationCommand]
(Int -> ReadS InteractionDataApplicationCommand)
-> ReadS [InteractionDataApplicationCommand]
-> ReadPrec InteractionDataApplicationCommand
-> ReadPrec [InteractionDataApplicationCommand]
-> Read InteractionDataApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommand]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommand]
readPrec :: ReadPrec InteractionDataApplicationCommand
$creadPrec :: ReadPrec InteractionDataApplicationCommand
readList :: ReadS [InteractionDataApplicationCommand]
$creadList :: ReadS [InteractionDataApplicationCommand]
readsPrec :: Int -> ReadS InteractionDataApplicationCommand
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommand
Read, InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
(InteractionDataApplicationCommand
 -> InteractionDataApplicationCommand -> Bool)
-> (InteractionDataApplicationCommand
    -> InteractionDataApplicationCommand -> Bool)
-> Eq InteractionDataApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c/= :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
== :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
$c== :: InteractionDataApplicationCommand
-> InteractionDataApplicationCommand -> Bool
Eq)

data InteractionDataApplicationCommandOptions
  = InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]
  | InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]
  deriving (Int -> InteractionDataApplicationCommandOptions -> ShowS
[InteractionDataApplicationCommandOptions] -> ShowS
InteractionDataApplicationCommandOptions -> String
(Int -> InteractionDataApplicationCommandOptions -> ShowS)
-> (InteractionDataApplicationCommandOptions -> String)
-> ([InteractionDataApplicationCommandOptions] -> ShowS)
-> Show InteractionDataApplicationCommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptions] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptions] -> ShowS
show :: InteractionDataApplicationCommandOptions -> String
$cshow :: InteractionDataApplicationCommandOptions -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptions -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptions -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptions]
ReadPrec InteractionDataApplicationCommandOptions
Int -> ReadS InteractionDataApplicationCommandOptions
ReadS [InteractionDataApplicationCommandOptions]
(Int -> ReadS InteractionDataApplicationCommandOptions)
-> ReadS [InteractionDataApplicationCommandOptions]
-> ReadPrec InteractionDataApplicationCommandOptions
-> ReadPrec [InteractionDataApplicationCommandOptions]
-> Read InteractionDataApplicationCommandOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptions]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptions]
readPrec :: ReadPrec InteractionDataApplicationCommandOptions
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptions
readList :: ReadS [InteractionDataApplicationCommandOptions]
$creadList :: ReadS [InteractionDataApplicationCommandOptions]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptions
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptions
Read, InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
(InteractionDataApplicationCommandOptions
 -> InteractionDataApplicationCommandOptions -> Bool)
-> (InteractionDataApplicationCommandOptions
    -> InteractionDataApplicationCommandOptions -> Bool)
-> Eq InteractionDataApplicationCommandOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c/= :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
== :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
$c== :: InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommandOptions -> Bool
Eq)

data InteractionDataApplicationCommandOptionSubcommandOrGroup
  = InteractionDataApplicationCommandOptionSubcommandGroup
      { InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionToken
interactionDataApplicationCommandOptionSubcommandGroupName :: T.Text,
        InteractionDataApplicationCommandOptionSubcommandOrGroup
-> [InteractionDataApplicationCommandOptionSubcommand]
interactionDataApplicationCommandOptionSubcommandGroupOptions :: [InteractionDataApplicationCommandOptionSubcommand],
        InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Maybe Bool
interactionDataApplicationCommandOptionSubcommandGroupFocused :: Maybe Bool
      }
  | InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand
  deriving (Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
[InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
(Int
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> ShowS)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> String)
-> ([InteractionDataApplicationCommandOptionSubcommandOrGroup]
    -> ShowS)
-> Show InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionSubcommandOrGroup] -> ShowS
show :: InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
$cshow :: InteractionDataApplicationCommandOptionSubcommandOrGroup -> String
showsPrec :: Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
$cshowsPrec :: Int
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
(Int
 -> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> ReadPrec
     InteractionDataApplicationCommandOptionSubcommandOrGroup
-> ReadPrec
     [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> Read InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommandOrGroup]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommandOrGroup
readList :: ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
$creadList :: ReadS [InteractionDataApplicationCommandOptionSubcommandOrGroup]
readsPrec :: Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
$creadsPrec :: Int
-> ReadS InteractionDataApplicationCommandOptionSubcommandOrGroup
Read, InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
(InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> InteractionDataApplicationCommandOptionSubcommandOrGroup
    -> Bool)
-> Eq InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c/= :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
== :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
$c== :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionDataApplicationCommandOptionSubcommandOrGroup -> Bool
Eq)

data InteractionDataApplicationCommandOptionSubcommand = InteractionDataApplicationCommandOptionSubcommand
  { InteractionDataApplicationCommandOptionSubcommand
-> InteractionToken
interactionDataApplicationCommandOptionSubcommandName :: T.Text,
    InteractionDataApplicationCommandOptionSubcommand
-> [InteractionDataApplicationCommandOptionValue]
interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue],
    InteractionDataApplicationCommandOptionSubcommand -> Maybe Bool
interactionDataApplicationCommandOptionSubcommandFocused :: Maybe Bool
  }
  deriving (Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
[InteractionDataApplicationCommandOptionSubcommand] -> ShowS
InteractionDataApplicationCommandOptionSubcommand -> String
(Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS)
-> (InteractionDataApplicationCommandOptionSubcommand -> String)
-> ([InteractionDataApplicationCommandOptionSubcommand] -> ShowS)
-> Show InteractionDataApplicationCommandOptionSubcommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionSubcommand] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionSubcommand] -> ShowS
show :: InteractionDataApplicationCommandOptionSubcommand -> String
$cshow :: InteractionDataApplicationCommandOptionSubcommand -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptionSubcommand -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
ReadPrec InteractionDataApplicationCommandOptionSubcommand
Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
ReadS [InteractionDataApplicationCommandOptionSubcommand]
(Int -> ReadS InteractionDataApplicationCommandOptionSubcommand)
-> ReadS [InteractionDataApplicationCommandOptionSubcommand]
-> ReadPrec InteractionDataApplicationCommandOptionSubcommand
-> ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
-> Read InteractionDataApplicationCommandOptionSubcommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionSubcommand]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommand
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionSubcommand
readList :: ReadS [InteractionDataApplicationCommandOptionSubcommand]
$creadList :: ReadS [InteractionDataApplicationCommandOptionSubcommand]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionSubcommand
Read, InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
(InteractionDataApplicationCommandOptionSubcommand
 -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> (InteractionDataApplicationCommandOptionSubcommand
    -> InteractionDataApplicationCommandOptionSubcommand -> Bool)
-> Eq InteractionDataApplicationCommandOptionSubcommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c/= :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
== :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
$c== :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommand -> Bool
Eq)

data InteractionDataApplicationCommandOptionValue = InteractionDataApplicationCommandOptionValue
  { InteractionDataApplicationCommandOptionValue -> InteractionToken
interactionDataApplicationCommandOptionValueName :: T.Text,
    InteractionDataApplicationCommandOptionValue
-> ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueValue :: ApplicationCommandInteractionDataValue,
    InteractionDataApplicationCommandOptionValue -> Maybe Bool
interactionDataApplicationCommandOptionValueFocused :: Maybe Bool
  }
  deriving (Int -> InteractionDataApplicationCommandOptionValue -> ShowS
[InteractionDataApplicationCommandOptionValue] -> ShowS
InteractionDataApplicationCommandOptionValue -> String
(Int -> InteractionDataApplicationCommandOptionValue -> ShowS)
-> (InteractionDataApplicationCommandOptionValue -> String)
-> ([InteractionDataApplicationCommandOptionValue] -> ShowS)
-> Show InteractionDataApplicationCommandOptionValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionDataApplicationCommandOptionValue] -> ShowS
$cshowList :: [InteractionDataApplicationCommandOptionValue] -> ShowS
show :: InteractionDataApplicationCommandOptionValue -> String
$cshow :: InteractionDataApplicationCommandOptionValue -> String
showsPrec :: Int -> InteractionDataApplicationCommandOptionValue -> ShowS
$cshowsPrec :: Int -> InteractionDataApplicationCommandOptionValue -> ShowS
Show, ReadPrec [InteractionDataApplicationCommandOptionValue]
ReadPrec InteractionDataApplicationCommandOptionValue
Int -> ReadS InteractionDataApplicationCommandOptionValue
ReadS [InteractionDataApplicationCommandOptionValue]
(Int -> ReadS InteractionDataApplicationCommandOptionValue)
-> ReadS [InteractionDataApplicationCommandOptionValue]
-> ReadPrec InteractionDataApplicationCommandOptionValue
-> ReadPrec [InteractionDataApplicationCommandOptionValue]
-> Read InteractionDataApplicationCommandOptionValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionDataApplicationCommandOptionValue]
$creadListPrec :: ReadPrec [InteractionDataApplicationCommandOptionValue]
readPrec :: ReadPrec InteractionDataApplicationCommandOptionValue
$creadPrec :: ReadPrec InteractionDataApplicationCommandOptionValue
readList :: ReadS [InteractionDataApplicationCommandOptionValue]
$creadList :: ReadS [InteractionDataApplicationCommandOptionValue]
readsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionValue
$creadsPrec :: Int -> ReadS InteractionDataApplicationCommandOptionValue
Read, InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
(InteractionDataApplicationCommandOptionValue
 -> InteractionDataApplicationCommandOptionValue -> Bool)
-> (InteractionDataApplicationCommandOptionValue
    -> InteractionDataApplicationCommandOptionValue -> Bool)
-> Eq InteractionDataApplicationCommandOptionValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c/= :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
== :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
$c== :: InteractionDataApplicationCommandOptionValue
-> InteractionDataApplicationCommandOptionValue -> Bool
Eq)

instance Internals InteractionDataApplicationCommandOptionValue InternalInteractionDataApplicationCommandOption where
  toInternal :: InteractionDataApplicationCommandOptionValue
-> InternalInteractionDataApplicationCommandOption
toInternal InteractionDataApplicationCommandOptionValue {Maybe Bool
InteractionToken
ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueFocused :: Maybe Bool
interactionDataApplicationCommandOptionValueValue :: ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueName :: InteractionToken
interactionDataApplicationCommandOptionValueFocused :: InteractionDataApplicationCommandOptionValue -> Maybe Bool
interactionDataApplicationCommandOptionValueValue :: InteractionDataApplicationCommandOptionValue
-> ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueName :: InteractionDataApplicationCommandOptionValue -> InteractionToken
..} = InteractionToken
-> ApplicationCommandOptionType
-> Maybe ApplicationCommandInteractionDataValue
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Bool
-> InternalInteractionDataApplicationCommandOption
InternalInteractionDataApplicationCommandOption InteractionToken
interactionDataApplicationCommandOptionValueName (ApplicationCommandInteractionDataValue
-> ApplicationCommandOptionType
getTypeFromACIDV ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueValue) (ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just ApplicationCommandInteractionDataValue
interactionDataApplicationCommandOptionValueValue) Maybe [InternalInteractionDataApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
interactionDataApplicationCommandOptionValueFocused

  fromInternal :: InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionValue
fromInternal InternalInteractionDataApplicationCommandOption {Maybe Bool
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe ApplicationCommandInteractionDataValue
InteractionToken
ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionFocused :: InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionType :: InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionName :: InternalInteractionDataApplicationCommandOption -> InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionType :: ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionName :: InteractionToken
..}
    | ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType ApplicationCommandOptionType
-> [ApplicationCommandOptionType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand, ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommandGroup] = Maybe InteractionDataApplicationCommandOptionValue
forall a. Maybe a
Nothing
    | Bool
otherwise = do
      ApplicationCommandInteractionDataValue
v <- String
-> Maybe ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. String -> a -> a
trace (String
"this" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ApplicationCommandInteractionDataValue -> String
forall a. Show a => a -> String
show Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionValue) Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionValue
      InteractionDataApplicationCommandOptionValue
-> Maybe InteractionDataApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommandOptionValue
 -> Maybe InteractionDataApplicationCommandOptionValue)
-> InteractionDataApplicationCommandOptionValue
-> Maybe InteractionDataApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ InteractionToken
-> ApplicationCommandInteractionDataValue
-> Maybe Bool
-> InteractionDataApplicationCommandOptionValue
InteractionDataApplicationCommandOptionValue InteractionToken
internalInteractionDataApplicationCommandOptionName ApplicationCommandInteractionDataValue
v Maybe Bool
internalInteractionDataApplicationCommandOptionFocused

instance Internals InteractionDataApplicationCommandOptionSubcommand InternalInteractionDataApplicationCommandOption where
  toInternal :: InteractionDataApplicationCommandOptionSubcommand
-> InternalInteractionDataApplicationCommandOption
toInternal InteractionDataApplicationCommandOptionSubcommand {[InteractionDataApplicationCommandOptionValue]
Maybe Bool
InteractionToken
interactionDataApplicationCommandOptionSubcommandFocused :: Maybe Bool
interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue]
interactionDataApplicationCommandOptionSubcommandName :: InteractionToken
interactionDataApplicationCommandOptionSubcommandFocused :: InteractionDataApplicationCommandOptionSubcommand -> Maybe Bool
interactionDataApplicationCommandOptionSubcommandOptions :: InteractionDataApplicationCommandOptionSubcommand
-> [InteractionDataApplicationCommandOptionValue]
interactionDataApplicationCommandOptionSubcommandName :: InteractionDataApplicationCommandOptionSubcommand
-> InteractionToken
..} =
    InteractionToken
-> ApplicationCommandOptionType
-> Maybe ApplicationCommandInteractionDataValue
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Bool
-> InternalInteractionDataApplicationCommandOption
InternalInteractionDataApplicationCommandOption InteractionToken
interactionDataApplicationCommandOptionSubcommandName ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand Maybe ApplicationCommandInteractionDataValue
forall a. Maybe a
Nothing ([InternalInteractionDataApplicationCommandOption]
-> Maybe [InternalInteractionDataApplicationCommandOption]
forall a. a -> Maybe a
Just ([InternalInteractionDataApplicationCommandOption]
 -> Maybe [InternalInteractionDataApplicationCommandOption])
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InternalInteractionDataApplicationCommandOption]
forall a b. (a -> b) -> a -> b
$ InteractionDataApplicationCommandOptionValue
-> InternalInteractionDataApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommandOptionValue
 -> InternalInteractionDataApplicationCommandOption)
-> [InteractionDataApplicationCommandOptionValue]
-> [InternalInteractionDataApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionDataApplicationCommandOptionValue]
interactionDataApplicationCommandOptionSubcommandOptions) Maybe Bool
interactionDataApplicationCommandOptionSubcommandFocused

  fromInternal :: InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionSubcommand
fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType :: InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand, Maybe Bool
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe ApplicationCommandInteractionDataValue
InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InternalInteractionDataApplicationCommandOption -> InteractionToken
..} = do
    [InternalInteractionDataApplicationCommandOption]
o <- Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionOptions
    [InteractionDataApplicationCommandOptionValue]
o' <- (InternalInteractionDataApplicationCommandOption
 -> Maybe InteractionDataApplicationCommandOptionValue)
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InteractionDataApplicationCommandOptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionValue
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalInteractionDataApplicationCommandOption]
o
    InteractionDataApplicationCommandOptionSubcommand
-> Maybe InteractionDataApplicationCommandOptionSubcommand
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommandOptionSubcommand
 -> Maybe InteractionDataApplicationCommandOptionSubcommand)
-> InteractionDataApplicationCommandOptionSubcommand
-> Maybe InteractionDataApplicationCommandOptionSubcommand
forall a b. (a -> b) -> a -> b
$ InteractionToken
-> [InteractionDataApplicationCommandOptionValue]
-> Maybe Bool
-> InteractionDataApplicationCommandOptionSubcommand
InteractionDataApplicationCommandOptionSubcommand InteractionToken
internalInteractionDataApplicationCommandOptionName [InteractionDataApplicationCommandOptionValue]
o' Maybe Bool
internalInteractionDataApplicationCommandOptionFocused
  fromInternal InternalInteractionDataApplicationCommandOption
_ = Maybe InteractionDataApplicationCommandOptionSubcommand
forall a. Maybe a
Nothing

instance Internals InteractionDataApplicationCommandOptionSubcommandOrGroup InternalInteractionDataApplicationCommandOption where
  toInternal :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InternalInteractionDataApplicationCommandOption
toInternal InteractionDataApplicationCommandOptionSubcommandGroup {[InteractionDataApplicationCommandOptionSubcommand]
Maybe Bool
InteractionToken
interactionDataApplicationCommandOptionSubcommandGroupFocused :: Maybe Bool
interactionDataApplicationCommandOptionSubcommandGroupOptions :: [InteractionDataApplicationCommandOptionSubcommand]
interactionDataApplicationCommandOptionSubcommandGroupName :: InteractionToken
interactionDataApplicationCommandOptionSubcommandGroupFocused :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Maybe Bool
interactionDataApplicationCommandOptionSubcommandGroupOptions :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> [InteractionDataApplicationCommandOptionSubcommand]
interactionDataApplicationCommandOptionSubcommandGroupName :: InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InteractionToken
..} =
    InteractionToken
-> ApplicationCommandOptionType
-> Maybe ApplicationCommandInteractionDataValue
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Bool
-> InternalInteractionDataApplicationCommandOption
InternalInteractionDataApplicationCommandOption InteractionToken
interactionDataApplicationCommandOptionSubcommandGroupName ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand Maybe ApplicationCommandInteractionDataValue
forall a. Maybe a
Nothing ([InternalInteractionDataApplicationCommandOption]
-> Maybe [InternalInteractionDataApplicationCommandOption]
forall a. a -> Maybe a
Just ([InternalInteractionDataApplicationCommandOption]
 -> Maybe [InternalInteractionDataApplicationCommandOption])
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InternalInteractionDataApplicationCommandOption]
forall a b. (a -> b) -> a -> b
$ InteractionDataApplicationCommandOptionSubcommand
-> InternalInteractionDataApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommandOptionSubcommand
 -> InternalInteractionDataApplicationCommandOption)
-> [InteractionDataApplicationCommandOptionSubcommand]
-> [InternalInteractionDataApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionDataApplicationCommandOptionSubcommand]
interactionDataApplicationCommandOptionSubcommandGroupOptions) Maybe Bool
interactionDataApplicationCommandOptionSubcommandGroupFocused
  toInternal (InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand
s) = InteractionDataApplicationCommandOptionSubcommand
-> InternalInteractionDataApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal InteractionDataApplicationCommandOptionSubcommand
s

  fromInternal :: InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType :: InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommandGroup, Maybe Bool
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe ApplicationCommandInteractionDataValue
InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InternalInteractionDataApplicationCommandOption -> InteractionToken
..} = do
    [InternalInteractionDataApplicationCommandOption]
o <- Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionOptions
    [InteractionDataApplicationCommandOptionSubcommand]
o' <- (InternalInteractionDataApplicationCommandOption
 -> Maybe InteractionDataApplicationCommandOptionSubcommand)
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InteractionDataApplicationCommandOptionSubcommand]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionSubcommand
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalInteractionDataApplicationCommandOption]
o
    InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
-> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a b. (a -> b) -> a -> b
$ InteractionToken
-> [InteractionDataApplicationCommandOptionSubcommand]
-> Maybe Bool
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
InteractionDataApplicationCommandOptionSubcommandGroup InteractionToken
internalInteractionDataApplicationCommandOptionName [InteractionDataApplicationCommandOptionSubcommand]
o' Maybe Bool
internalInteractionDataApplicationCommandOptionFocused
  fromInternal i :: InternalInteractionDataApplicationCommandOption
i@InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType :: InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand, Maybe Bool
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe ApplicationCommandInteractionDataValue
InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionName :: InternalInteractionDataApplicationCommandOption -> InteractionToken
..} = InteractionDataApplicationCommandOptionSubcommand
-> InteractionDataApplicationCommandOptionSubcommandOrGroup
InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand (InteractionDataApplicationCommandOptionSubcommand
 -> InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> Maybe InteractionDataApplicationCommandOptionSubcommand
-> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionSubcommand
forall a b. Internals a b => b -> Maybe a
fromInternal InternalInteractionDataApplicationCommandOption
i
  fromInternal InternalInteractionDataApplicationCommandOption
_ = Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a. Maybe a
Nothing

instance Internals InteractionDataApplicationCommandOptions [InternalInteractionDataApplicationCommandOption] where
  toInternal :: InteractionDataApplicationCommandOptions
-> [InternalInteractionDataApplicationCommandOption]
toInternal (InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]
lst) = InteractionDataApplicationCommandOptionSubcommandOrGroup
-> InternalInteractionDataApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommandOptionSubcommandOrGroup
 -> InternalInteractionDataApplicationCommandOption)
-> [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> [InternalInteractionDataApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionDataApplicationCommandOptionSubcommandOrGroup]
lst
  toInternal (InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]
lst) = InteractionDataApplicationCommandOptionValue
-> InternalInteractionDataApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommandOptionValue
 -> InternalInteractionDataApplicationCommandOption)
-> [InteractionDataApplicationCommandOptionValue]
-> [InternalInteractionDataApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionDataApplicationCommandOptionValue]
lst

  fromInternal :: [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionDataApplicationCommandOptions
fromInternal [InternalInteractionDataApplicationCommandOption]
is = ([InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptionsSubcommands ([InteractionDataApplicationCommandOptionSubcommandOrGroup]
 -> InteractionDataApplicationCommandOptions)
-> Maybe [InteractionDataApplicationCommandOptionSubcommandOrGroup]
-> Maybe InteractionDataApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalInteractionDataApplicationCommandOption
 -> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup)
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InteractionDataApplicationCommandOptionSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionSubcommandOrGroup
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalInteractionDataApplicationCommandOption]
is) Maybe InteractionDataApplicationCommandOptions
-> Maybe InteractionDataApplicationCommandOptions
-> Maybe InteractionDataApplicationCommandOptions
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([InteractionDataApplicationCommandOptionValue]
-> InteractionDataApplicationCommandOptions
InteractionDataApplicationCommandOptionsValues ([InteractionDataApplicationCommandOptionValue]
 -> InteractionDataApplicationCommandOptions)
-> Maybe [InteractionDataApplicationCommandOptionValue]
-> Maybe InteractionDataApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalInteractionDataApplicationCommandOption
 -> Maybe InteractionDataApplicationCommandOptionValue)
-> [InternalInteractionDataApplicationCommandOption]
-> Maybe [InteractionDataApplicationCommandOptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalInteractionDataApplicationCommandOption
-> Maybe InteractionDataApplicationCommandOptionValue
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalInteractionDataApplicationCommandOption]
is)

instance Internals InteractionDataApplicationCommand InternalInteractionData where
  toInternal :: InteractionDataApplicationCommand -> InternalInteractionData
toInternal InteractionDataApplicationCommandUser {Maybe ResolvedData
InteractionToken
InteractionId
interactionDataApplicationCommandTargetId :: InteractionId
interactionDataApplicationCommandResolvedData :: Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionToken
interactionDataApplicationCommandId :: InteractionId
interactionDataApplicationCommandTargetId :: InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandResolvedData :: InteractionDataApplicationCommand -> Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionDataApplicationCommand -> InteractionToken
interactionDataApplicationCommandId :: InteractionDataApplicationCommand -> InteractionId
..} = Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData (InteractionId -> Maybe InteractionId
forall a. a -> Maybe a
Just InteractionId
interactionDataApplicationCommandId) (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
interactionDataApplicationCommandName) (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeUser) Maybe ResolvedData
interactionDataApplicationCommandResolvedData Maybe [InternalInteractionDataApplicationCommandOption]
forall a. Maybe a
Nothing Maybe InteractionToken
forall a. Maybe a
Nothing Maybe ComponentType
forall a. Maybe a
Nothing Maybe [InteractionToken]
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing
  toInternal InteractionDataApplicationCommandMessage {Maybe ResolvedData
InteractionToken
InteractionId
interactionDataApplicationCommandTargetId :: InteractionId
interactionDataApplicationCommandResolvedData :: Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionToken
interactionDataApplicationCommandId :: InteractionId
interactionDataApplicationCommandTargetId :: InteractionDataApplicationCommand -> InteractionId
interactionDataApplicationCommandResolvedData :: InteractionDataApplicationCommand -> Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionDataApplicationCommand -> InteractionToken
interactionDataApplicationCommandId :: InteractionDataApplicationCommand -> InteractionId
..} = Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData (InteractionId -> Maybe InteractionId
forall a. a -> Maybe a
Just InteractionId
interactionDataApplicationCommandId) (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
interactionDataApplicationCommandName) (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeMessage) Maybe ResolvedData
interactionDataApplicationCommandResolvedData Maybe [InternalInteractionDataApplicationCommandOption]
forall a. Maybe a
Nothing Maybe InteractionToken
forall a. Maybe a
Nothing Maybe ComponentType
forall a. Maybe a
Nothing Maybe [InteractionToken]
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing
  toInternal InteractionDataApplicationCommandChatInput {Maybe ResolvedData
Maybe InteractionDataApplicationCommandOptions
InteractionToken
InteractionId
interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions
interactionDataApplicationCommandResolvedData :: Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionToken
interactionDataApplicationCommandId :: InteractionId
interactionDataApplicationCommandOptions :: InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommandOptions
interactionDataApplicationCommandResolvedData :: InteractionDataApplicationCommand -> Maybe ResolvedData
interactionDataApplicationCommandName :: InteractionDataApplicationCommand -> InteractionToken
interactionDataApplicationCommandId :: InteractionDataApplicationCommand -> InteractionId
..} = Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData (InteractionId -> Maybe InteractionId
forall a. a -> Maybe a
Just InteractionId
interactionDataApplicationCommandId) (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
interactionDataApplicationCommandName) (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeMessage) Maybe ResolvedData
interactionDataApplicationCommandResolvedData (InteractionDataApplicationCommandOptions
-> [InternalInteractionDataApplicationCommandOption]
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommandOptions
 -> [InternalInteractionDataApplicationCommandOption])
-> Maybe InteractionDataApplicationCommandOptions
-> Maybe [InternalInteractionDataApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionDataApplicationCommandOptions
interactionDataApplicationCommandOptions) Maybe InteractionToken
forall a. Maybe a
Nothing Maybe ComponentType
forall a. Maybe a
Nothing Maybe [InteractionToken]
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing

  fromInternal :: InternalInteractionData -> Maybe InteractionDataApplicationCommand
fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
internalInteractionDataApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeUser, Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ComponentType
Maybe ResolvedData
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataComponentType :: Maybe ComponentType
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
..} = do
    InteractionId
aid <- Maybe InteractionId
internalInteractionDataApplicationCommandId
    InteractionToken
name <- Maybe InteractionToken
internalInteractionDataApplicationCommandName
    InteractionId
tid <- Maybe InteractionId
internalInteractionDataTargetId
    InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommand
 -> Maybe InteractionDataApplicationCommand)
-> InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> InteractionId
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandUser InteractionId
aid InteractionToken
name Maybe ResolvedData
internalInteractionDataResolved InteractionId
tid
  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
internalInteractionDataApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeMessage, Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ComponentType
Maybe ResolvedData
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataComponentType :: Maybe ComponentType
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
..} = do
    InteractionId
aid <- Maybe InteractionId
internalInteractionDataApplicationCommandId
    InteractionToken
name <- Maybe InteractionToken
internalInteractionDataApplicationCommandName
    InteractionId
tid <- Maybe InteractionId
internalInteractionDataTargetId
    InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommand
 -> Maybe InteractionDataApplicationCommand)
-> InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> InteractionId
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandMessage InteractionId
aid InteractionToken
name Maybe ResolvedData
internalInteractionDataResolved InteractionId
tid
  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
internalInteractionDataApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeChatInput, Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ComponentType
Maybe ResolvedData
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataComponentType :: Maybe ComponentType
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
..} = do
    InteractionId
aid <- Maybe InteractionId
internalInteractionDataApplicationCommandId
    InteractionToken
name <- Maybe InteractionToken
internalInteractionDataApplicationCommandName
    InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionDataApplicationCommand
 -> Maybe InteractionDataApplicationCommand)
-> InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionToken
-> Maybe ResolvedData
-> Maybe InteractionDataApplicationCommandOptions
-> InteractionDataApplicationCommand
InteractionDataApplicationCommandChatInput InteractionId
aid InteractionToken
name Maybe ResolvedData
internalInteractionDataResolved (Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataOptions Maybe [InternalInteractionDataApplicationCommandOption]
-> ([InternalInteractionDataApplicationCommandOption]
    -> Maybe InteractionDataApplicationCommandOptions)
-> Maybe InteractionDataApplicationCommandOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionDataApplicationCommandOptions
forall a b. Internals a b => b -> Maybe a
fromInternal)
  fromInternal InternalInteractionData
_ = Maybe InteractionDataApplicationCommand
forall a. Maybe a
Nothing

instance Internals InteractionDataComponent InternalInteractionData where
  toInternal :: InteractionDataComponent -> InternalInteractionData
toInternal InteractionDataComponentButton {InteractionToken
interactionDataComponentCustomId :: InteractionToken
interactionDataComponentCustomId :: InteractionDataComponent -> InteractionToken
..} = Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData Maybe InteractionId
forall a. Maybe a
Nothing Maybe InteractionToken
forall a. Maybe a
Nothing Maybe ApplicationCommandType
forall a. Maybe a
Nothing Maybe ResolvedData
forall a. Maybe a
Nothing Maybe [InternalInteractionDataApplicationCommandOption]
forall a. Maybe a
Nothing (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
interactionDataComponentCustomId) (ComponentType -> Maybe ComponentType
forall a. a -> Maybe a
Just ComponentType
ComponentTypeButton) Maybe [InteractionToken]
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing
  toInternal InteractionDataComponentSelectMenu {[InteractionToken]
InteractionToken
interactionDataComponentValues :: [InteractionToken]
interactionDataComponentCustomId :: InteractionToken
interactionDataComponentValues :: InteractionDataComponent -> [InteractionToken]
interactionDataComponentCustomId :: InteractionDataComponent -> InteractionToken
..} = Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData Maybe InteractionId
forall a. Maybe a
Nothing Maybe InteractionToken
forall a. Maybe a
Nothing Maybe ApplicationCommandType
forall a. Maybe a
Nothing Maybe ResolvedData
forall a. Maybe a
Nothing Maybe [InternalInteractionDataApplicationCommandOption]
forall a. Maybe a
Nothing (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
interactionDataComponentCustomId) (ComponentType -> Maybe ComponentType
forall a. a -> Maybe a
Just ComponentType
ComponentTypeSelectMenu) ([InteractionToken] -> Maybe [InteractionToken]
forall a. a -> Maybe a
Just [InteractionToken]
interactionDataComponentValues) Maybe InteractionId
forall a. Maybe a
Nothing

  fromInternal :: InternalInteractionData -> Maybe InteractionDataComponent
fromInternal InternalInteractionData {internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataComponentType = Just ComponentType
ComponentTypeButton, Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ApplicationCommandType
Maybe ResolvedData
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
..} = InteractionToken -> InteractionDataComponent
InteractionDataComponentButton (InteractionToken -> InteractionDataComponent)
-> Maybe InteractionToken -> Maybe InteractionDataComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
internalInteractionDataCustomId
  fromInternal InternalInteractionData {internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataComponentType = Just ComponentType
ComponentTypeSelectMenu, Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ApplicationCommandType
Maybe ResolvedData
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
..} = InteractionToken -> [InteractionToken] -> InteractionDataComponent
InteractionDataComponentSelectMenu (InteractionToken
 -> [InteractionToken] -> InteractionDataComponent)
-> Maybe InteractionToken
-> Maybe ([InteractionToken] -> InteractionDataComponent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
internalInteractionDataCustomId Maybe ([InteractionToken] -> InteractionDataComponent)
-> Maybe [InteractionToken] -> Maybe InteractionDataComponent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [InteractionToken]
internalInteractionDataValues
  fromInternal InternalInteractionData
_ = Maybe InteractionDataComponent
forall a. Maybe a
Nothing

instance Internals Interaction InternalInteraction where
  toInternal :: Interaction -> InternalInteraction
toInternal InteractionPing {Int
InteractionToken
InteractionId
interactionVersion :: Int
interactionToken :: InteractionToken
interactionApplicationId :: InteractionId
interactionId :: InteractionId
interactionVersion :: Interaction -> Int
interactionToken :: Interaction -> InteractionToken
interactionApplicationId :: Interaction -> InteractionId
interactionId :: Interaction -> InteractionId
..} = InteractionId
-> InteractionId
-> InteractionType
-> Maybe InternalInteractionData
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Maybe Message
-> InternalInteraction
InternalInteraction InteractionId
interactionId InteractionId
interactionApplicationId InteractionType
InteractionTypePing Maybe InternalInteractionData
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing Maybe InteractionId
forall a. Maybe a
Nothing Maybe GuildMember
forall a. Maybe a
Nothing Maybe User
forall a. Maybe a
Nothing InteractionToken
interactionToken Int
interactionVersion Maybe Message
forall a. Maybe a
Nothing
  toInternal InteractionComponent {Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe InteractionDataComponent
InteractionToken
InteractionId
Message
interactionMessage :: Message
interactionVersion :: Int
interactionToken :: InteractionToken
interactionUser :: Maybe User
interactionMember :: Maybe GuildMember
interactionChannelId :: Maybe InteractionId
interactionGuildId :: Maybe InteractionId
interactionDataComponent :: Maybe InteractionDataComponent
interactionApplicationId :: InteractionId
interactionId :: InteractionId
interactionMessage :: Interaction -> Message
interactionVersion :: Interaction -> Int
interactionToken :: Interaction -> InteractionToken
interactionUser :: Interaction -> Maybe User
interactionMember :: Interaction -> Maybe GuildMember
interactionChannelId :: Interaction -> Maybe InteractionId
interactionGuildId :: Interaction -> Maybe InteractionId
interactionDataComponent :: Interaction -> Maybe InteractionDataComponent
interactionApplicationId :: Interaction -> InteractionId
interactionId :: Interaction -> InteractionId
..} = InteractionId
-> InteractionId
-> InteractionType
-> Maybe InternalInteractionData
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Maybe Message
-> InternalInteraction
InternalInteraction InteractionId
interactionId InteractionId
interactionApplicationId InteractionType
InteractionTypeMessageComponent (InteractionDataComponent -> InternalInteractionData
forall a b. Internals a b => a -> b
toInternal (InteractionDataComponent -> InternalInteractionData)
-> Maybe InteractionDataComponent -> Maybe InternalInteractionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionDataComponent
interactionDataComponent) Maybe InteractionId
interactionGuildId Maybe InteractionId
interactionChannelId Maybe GuildMember
interactionMember Maybe User
interactionUser InteractionToken
interactionToken Int
interactionVersion (Message -> Maybe Message
forall a. a -> Maybe a
Just Message
interactionMessage)
  toInternal InteractionApplicationCommand {Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe InteractionDataApplicationCommand
InteractionToken
InteractionId
interactionVersion :: Int
interactionToken :: InteractionToken
interactionUser :: Maybe User
interactionMember :: Maybe GuildMember
interactionChannelId :: Maybe InteractionId
interactionGuildId :: Maybe InteractionId
interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand
interactionApplicationId :: InteractionId
interactionId :: InteractionId
interactionDataApplicationCommand :: Interaction -> Maybe InteractionDataApplicationCommand
interactionVersion :: Interaction -> Int
interactionToken :: Interaction -> InteractionToken
interactionUser :: Interaction -> Maybe User
interactionMember :: Interaction -> Maybe GuildMember
interactionChannelId :: Interaction -> Maybe InteractionId
interactionGuildId :: Interaction -> Maybe InteractionId
interactionApplicationId :: Interaction -> InteractionId
interactionId :: Interaction -> InteractionId
..} = InteractionId
-> InteractionId
-> InteractionType
-> Maybe InternalInteractionData
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Maybe Message
-> InternalInteraction
InternalInteraction InteractionId
interactionId InteractionId
interactionApplicationId InteractionType
InteractionTypeApplicationCommand (InteractionDataApplicationCommand -> InternalInteractionData
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommand -> InternalInteractionData)
-> Maybe InteractionDataApplicationCommand
-> Maybe InternalInteractionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionDataApplicationCommand
interactionDataApplicationCommand) Maybe InteractionId
interactionGuildId Maybe InteractionId
interactionChannelId Maybe GuildMember
interactionMember Maybe User
interactionUser InteractionToken
interactionToken Int
interactionVersion Maybe Message
forall a. Maybe a
Nothing
  toInternal InteractionApplicationCommandAutocomplete {Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe InteractionDataApplicationCommand
InteractionToken
InteractionId
interactionVersion :: Int
interactionToken :: InteractionToken
interactionUser :: Maybe User
interactionMember :: Maybe GuildMember
interactionChannelId :: Maybe InteractionId
interactionGuildId :: Maybe InteractionId
interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand
interactionApplicationId :: InteractionId
interactionId :: InteractionId
interactionDataApplicationCommand :: Interaction -> Maybe InteractionDataApplicationCommand
interactionVersion :: Interaction -> Int
interactionToken :: Interaction -> InteractionToken
interactionUser :: Interaction -> Maybe User
interactionMember :: Interaction -> Maybe GuildMember
interactionChannelId :: Interaction -> Maybe InteractionId
interactionGuildId :: Interaction -> Maybe InteractionId
interactionApplicationId :: Interaction -> InteractionId
interactionId :: Interaction -> InteractionId
..} = InteractionId
-> InteractionId
-> InteractionType
-> Maybe InternalInteractionData
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Maybe Message
-> InternalInteraction
InternalInteraction InteractionId
interactionId InteractionId
interactionApplicationId InteractionType
InteractionTypeApplicationCommandAutocomplete (InteractionDataApplicationCommand -> InternalInteractionData
forall a b. Internals a b => a -> b
toInternal (InteractionDataApplicationCommand -> InternalInteractionData)
-> Maybe InteractionDataApplicationCommand
-> Maybe InternalInteractionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionDataApplicationCommand
interactionDataApplicationCommand) Maybe InteractionId
interactionGuildId Maybe InteractionId
interactionChannelId Maybe GuildMember
interactionMember Maybe User
interactionUser InteractionToken
interactionToken Int
interactionVersion Maybe Message
forall a. Maybe a
Nothing
  toInternal (InteractionUnknown InternalInteraction
i) = InternalInteraction
i

  fromInternal :: InternalInteraction -> Maybe Interaction
fromInternal InternalInteraction {internalInteractionType :: InternalInteraction -> InteractionType
internalInteractionType = InteractionType
InteractionTypePing, Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe Message
Maybe InternalInteractionData
InteractionToken
InteractionId
internalInteractionMessage :: InternalInteraction -> Maybe Message
internalInteractionVersion :: InternalInteraction -> Int
internalInteractionToken :: InternalInteraction -> InteractionToken
internalInteractionUser :: InternalInteraction -> Maybe User
internalInteractionMember :: InternalInteraction -> Maybe GuildMember
internalInteractionChannelId :: InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: InternalInteraction -> Maybe InteractionId
internalInteractionData :: InternalInteraction -> Maybe InternalInteractionData
internalInteractionApplicationId :: InternalInteraction -> InteractionId
internalInteractionId :: InternalInteraction -> InteractionId
internalInteractionMessage :: Maybe Message
internalInteractionVersion :: Int
internalInteractionToken :: InteractionToken
internalInteractionUser :: Maybe User
internalInteractionMember :: Maybe GuildMember
internalInteractionChannelId :: Maybe InteractionId
internalInteractionGuildId :: Maybe InteractionId
internalInteractionData :: Maybe InternalInteractionData
internalInteractionApplicationId :: InteractionId
internalInteractionId :: InteractionId
..} = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId -> InteractionToken -> Int -> Interaction
InteractionPing InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId InteractionToken
internalInteractionToken Int
internalInteractionVersion
  fromInternal i :: InternalInteraction
i@InternalInteraction {internalInteractionType :: InternalInteraction -> InteractionType
internalInteractionType = InteractionType
InteractionTypeMessageComponent, Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe Message
Maybe InternalInteractionData
InteractionToken
InteractionId
internalInteractionMessage :: Maybe Message
internalInteractionVersion :: Int
internalInteractionToken :: InteractionToken
internalInteractionUser :: Maybe User
internalInteractionMember :: Maybe GuildMember
internalInteractionChannelId :: Maybe InteractionId
internalInteractionGuildId :: Maybe InteractionId
internalInteractionData :: Maybe InternalInteractionData
internalInteractionApplicationId :: InteractionId
internalInteractionId :: InteractionId
internalInteractionMessage :: InternalInteraction -> Maybe Message
internalInteractionVersion :: InternalInteraction -> Int
internalInteractionToken :: InternalInteraction -> InteractionToken
internalInteractionUser :: InternalInteraction -> Maybe User
internalInteractionMember :: InternalInteraction -> Maybe GuildMember
internalInteractionChannelId :: InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: InternalInteraction -> Maybe InteractionId
internalInteractionData :: InternalInteraction -> Maybe InternalInteractionData
internalInteractionApplicationId :: InternalInteraction -> InteractionId
internalInteractionId :: InternalInteraction -> InteractionId
..} = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ Interaction -> Maybe Interaction -> Interaction
forall a. a -> Maybe a -> a
fromMaybe (InternalInteraction -> Interaction
InteractionUnknown InternalInteraction
i) (Maybe Interaction -> Interaction)
-> Maybe Interaction -> Interaction
forall a b. (a -> b) -> a -> b
$ Maybe Message
internalInteractionMessage Maybe Message
-> (Message -> Maybe Interaction) -> Maybe Interaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> (Message -> Interaction) -> Message -> Maybe Interaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionId
-> InteractionId
-> Maybe InteractionDataComponent
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Message
-> Interaction
InteractionComponent InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId (Maybe InternalInteractionData
internalInteractionData Maybe InternalInteractionData
-> (InternalInteractionData -> Maybe InteractionDataComponent)
-> Maybe InteractionDataComponent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InternalInteractionData -> Maybe InteractionDataComponent
forall a b. Internals a b => b -> Maybe a
fromInternal) Maybe InteractionId
internalInteractionGuildId Maybe InteractionId
internalInteractionChannelId Maybe GuildMember
internalInteractionMember Maybe User
internalInteractionUser InteractionToken
internalInteractionToken Int
internalInteractionVersion
  fromInternal i :: InternalInteraction
i@InternalInteraction {internalInteractionType :: InternalInteraction -> InteractionType
internalInteractionType=InteractionType
InteractionTypeApplicationCommandAutocomplete,Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe Message
Maybe InternalInteractionData
InteractionToken
InteractionId
internalInteractionMessage :: Maybe Message
internalInteractionVersion :: Int
internalInteractionToken :: InteractionToken
internalInteractionUser :: Maybe User
internalInteractionMember :: Maybe GuildMember
internalInteractionChannelId :: Maybe InteractionId
internalInteractionGuildId :: Maybe InteractionId
internalInteractionData :: Maybe InternalInteractionData
internalInteractionApplicationId :: InteractionId
internalInteractionId :: InteractionId
internalInteractionMessage :: InternalInteraction -> Maybe Message
internalInteractionVersion :: InternalInteraction -> Int
internalInteractionToken :: InternalInteraction -> InteractionToken
internalInteractionUser :: InternalInteraction -> Maybe User
internalInteractionMember :: InternalInteraction -> Maybe GuildMember
internalInteractionChannelId :: InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: InternalInteraction -> Maybe InteractionId
internalInteractionData :: InternalInteraction -> Maybe InternalInteractionData
internalInteractionApplicationId :: InternalInteraction -> InteractionId
internalInteractionId :: InternalInteraction -> InteractionId
..} = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ Interaction -> Maybe Interaction -> Interaction
forall a. a -> Maybe a -> a
fromMaybe (InternalInteraction -> Interaction
InteractionUnknown InternalInteraction
i) (Maybe Interaction -> Interaction)
-> Maybe Interaction -> Interaction
forall a b. (a -> b) -> a -> b
$ Maybe InternalInteractionData -> Maybe Interaction
process Maybe InternalInteractionData
internalInteractionData
    where process :: Maybe InternalInteractionData -> Maybe Interaction
process Maybe InternalInteractionData
Nothing = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId
-> Maybe InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Interaction
InteractionApplicationCommandAutocomplete InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId Maybe InteractionDataApplicationCommand
forall a. Maybe a
Nothing Maybe InteractionId
internalInteractionGuildId Maybe InteractionId
internalInteractionChannelId Maybe GuildMember
internalInteractionMember Maybe User
internalInteractionUser InteractionToken
internalInteractionToken Int
internalInteractionVersion
          process (Just InternalInteractionData
d) = InternalInteractionData -> Maybe InteractionDataApplicationCommand
forall a b. Internals a b => b -> Maybe a
fromInternal InternalInteractionData
d Maybe InteractionDataApplicationCommand
-> (InteractionDataApplicationCommand -> Maybe Interaction)
-> Maybe Interaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InteractionDataApplicationCommand
d' -> Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId
-> Maybe InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Interaction
InteractionApplicationCommandAutocomplete InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId (InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall a. a -> Maybe a
Just InteractionDataApplicationCommand
d') Maybe InteractionId
internalInteractionGuildId Maybe InteractionId
internalInteractionChannelId Maybe GuildMember
internalInteractionMember Maybe User
internalInteractionUser InteractionToken
internalInteractionToken Int
internalInteractionVersion
  fromInternal i :: InternalInteraction
i@InternalInteraction {internalInteractionType :: InternalInteraction -> InteractionType
internalInteractionType=InteractionType
InteractionTypeApplicationCommand,Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe Message
Maybe InternalInteractionData
InteractionToken
InteractionId
internalInteractionMessage :: Maybe Message
internalInteractionVersion :: Int
internalInteractionToken :: InteractionToken
internalInteractionUser :: Maybe User
internalInteractionMember :: Maybe GuildMember
internalInteractionChannelId :: Maybe InteractionId
internalInteractionGuildId :: Maybe InteractionId
internalInteractionData :: Maybe InternalInteractionData
internalInteractionApplicationId :: InteractionId
internalInteractionId :: InteractionId
internalInteractionMessage :: InternalInteraction -> Maybe Message
internalInteractionVersion :: InternalInteraction -> Int
internalInteractionToken :: InternalInteraction -> InteractionToken
internalInteractionUser :: InternalInteraction -> Maybe User
internalInteractionMember :: InternalInteraction -> Maybe GuildMember
internalInteractionChannelId :: InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: InternalInteraction -> Maybe InteractionId
internalInteractionData :: InternalInteraction -> Maybe InternalInteractionData
internalInteractionApplicationId :: InternalInteraction -> InteractionId
internalInteractionId :: InternalInteraction -> InteractionId
..} = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ Interaction -> Maybe Interaction -> Interaction
forall a. a -> Maybe a -> a
fromMaybe (InternalInteraction -> Interaction
InteractionUnknown InternalInteraction
i) (Maybe Interaction -> Interaction)
-> Maybe Interaction -> Interaction
forall a b. (a -> b) -> a -> b
$ Maybe InternalInteractionData -> Maybe Interaction
process Maybe InternalInteractionData
internalInteractionData
    where process :: Maybe InternalInteractionData -> Maybe Interaction
process Maybe InternalInteractionData
Nothing = Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId
-> Maybe InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Interaction
InteractionApplicationCommand InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId Maybe InteractionDataApplicationCommand
forall a. Maybe a
Nothing Maybe InteractionId
internalInteractionGuildId Maybe InteractionId
internalInteractionChannelId Maybe GuildMember
internalInteractionMember Maybe User
internalInteractionUser InteractionToken
internalInteractionToken Int
internalInteractionVersion
          process (Just InternalInteractionData
d) = InternalInteractionData -> Maybe InteractionDataApplicationCommand
forall a b. Internals a b => b -> Maybe a
fromInternal InternalInteractionData
d Maybe InteractionDataApplicationCommand
-> (InteractionDataApplicationCommand -> Maybe Interaction)
-> Maybe Interaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InteractionDataApplicationCommand
d' -> Interaction -> Maybe Interaction
forall a. a -> Maybe a
Just (Interaction -> Maybe Interaction)
-> Interaction -> Maybe Interaction
forall a b. (a -> b) -> a -> b
$ InteractionId
-> InteractionId
-> Maybe InteractionDataApplicationCommand
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Interaction
InteractionApplicationCommand InteractionId
internalInteractionId InteractionId
internalInteractionApplicationId (InteractionDataApplicationCommand
-> Maybe InteractionDataApplicationCommand
forall a. a -> Maybe a
Just InteractionDataApplicationCommand
d') Maybe InteractionId
internalInteractionGuildId Maybe InteractionId
internalInteractionChannelId Maybe GuildMember
internalInteractionMember Maybe User
internalInteractionUser InteractionToken
internalInteractionToken Int
internalInteractionVersion
    -- Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId (internalInteractionType == InteractionTypeApplicationCommandAutocomplete) (internalInteractionData >>= fromInternal) internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion

-- instance Internals Interaction InternalInteraction where

-- application command id
-- application command name
-- application command type -- this should be defined in the constructor!
-- resolved data -- this should be formalised and integrated, instead of being
--  left as values
-- options -- only present if type is subcommand or subcommand group

-- | This is the data that is recieved when an interaction occurs.
--
-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-structure
data InternalInteraction = InternalInteraction
  { InternalInteraction -> InteractionId
internalInteractionId :: InteractionId,
    InternalInteraction -> InteractionId
internalInteractionApplicationId :: ApplicationId,
    InternalInteraction -> InteractionType
internalInteractionType :: InteractionType, -- referenced as Type in API
    InternalInteraction -> Maybe InternalInteractionData
internalInteractionData :: Maybe InternalInteractionData, -- referenced as Data in API
    InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: Maybe GuildId,
    InternalInteraction -> Maybe InteractionId
internalInteractionChannelId :: Maybe ChannelId,
    InternalInteraction -> Maybe GuildMember
internalInteractionMember :: Maybe GuildMember,
    InternalInteraction -> Maybe User
internalInteractionUser :: Maybe User,
    InternalInteraction -> InteractionToken
internalInteractionToken :: InteractionToken,
    InternalInteraction -> Int
internalInteractionVersion :: Int,
    InternalInteraction -> Maybe Message
internalInteractionMessage :: Maybe Message
  }
  deriving (Int -> InternalInteraction -> ShowS
[InternalInteraction] -> ShowS
InternalInteraction -> String
(Int -> InternalInteraction -> ShowS)
-> (InternalInteraction -> String)
-> ([InternalInteraction] -> ShowS)
-> Show InternalInteraction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalInteraction] -> ShowS
$cshowList :: [InternalInteraction] -> ShowS
show :: InternalInteraction -> String
$cshow :: InternalInteraction -> String
showsPrec :: Int -> InternalInteraction -> ShowS
$cshowsPrec :: Int -> InternalInteraction -> ShowS
Show, ReadPrec [InternalInteraction]
ReadPrec InternalInteraction
Int -> ReadS InternalInteraction
ReadS [InternalInteraction]
(Int -> ReadS InternalInteraction)
-> ReadS [InternalInteraction]
-> ReadPrec InternalInteraction
-> ReadPrec [InternalInteraction]
-> Read InternalInteraction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalInteraction]
$creadListPrec :: ReadPrec [InternalInteraction]
readPrec :: ReadPrec InternalInteraction
$creadPrec :: ReadPrec InternalInteraction
readList :: ReadS [InternalInteraction]
$creadList :: ReadS [InternalInteraction]
readsPrec :: Int -> ReadS InternalInteraction
$creadsPrec :: Int -> ReadS InternalInteraction
Read, InternalInteraction -> InternalInteraction -> Bool
(InternalInteraction -> InternalInteraction -> Bool)
-> (InternalInteraction -> InternalInteraction -> Bool)
-> Eq InternalInteraction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalInteraction -> InternalInteraction -> Bool
$c/= :: InternalInteraction -> InternalInteraction -> Bool
== :: InternalInteraction -> InternalInteraction -> Bool
$c== :: InternalInteraction -> InternalInteraction -> Bool
Eq)

instance ToJSON InternalInteraction where
  toJSON :: InternalInteraction -> Value
toJSON InternalInteraction {Int
Maybe InteractionId
Maybe GuildMember
Maybe User
Maybe Message
Maybe InternalInteractionData
InteractionToken
InteractionType
InteractionId
internalInteractionMessage :: Maybe Message
internalInteractionVersion :: Int
internalInteractionToken :: InteractionToken
internalInteractionUser :: Maybe User
internalInteractionMember :: Maybe GuildMember
internalInteractionChannelId :: Maybe InteractionId
internalInteractionGuildId :: Maybe InteractionId
internalInteractionData :: Maybe InternalInteractionData
internalInteractionType :: InteractionType
internalInteractionApplicationId :: InteractionId
internalInteractionId :: InteractionId
internalInteractionMessage :: InternalInteraction -> Maybe Message
internalInteractionVersion :: InternalInteraction -> Int
internalInteractionToken :: InternalInteraction -> InteractionToken
internalInteractionUser :: InternalInteraction -> Maybe User
internalInteractionMember :: InternalInteraction -> Maybe GuildMember
internalInteractionChannelId :: InternalInteraction -> Maybe InteractionId
internalInteractionGuildId :: InternalInteraction -> Maybe InteractionId
internalInteractionData :: InternalInteraction -> Maybe InternalInteractionData
internalInteractionApplicationId :: InternalInteraction -> InteractionId
internalInteractionId :: InternalInteraction -> InteractionId
internalInteractionType :: InternalInteraction -> InteractionType
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", InteractionId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionId
internalInteractionId),
              (Key
"application_id", InteractionId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionId
internalInteractionApplicationId),
              (Key
"type", InteractionType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionType
internalInteractionType),
              (Key
"data", InternalInteractionData -> Value
forall a. ToJSON a => a -> Value
toJSON (InternalInteractionData -> Value)
-> Maybe InternalInteractionData -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InternalInteractionData
internalInteractionData),
              (Key
"guild_id", InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionId -> Value) -> Maybe InteractionId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionId
internalInteractionGuildId),
              (Key
"channel_id", InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionId -> Value) -> Maybe InteractionId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionId
internalInteractionChannelId),
              (Key
"member", GuildMember -> Value
forall a. ToJSON a => a -> Value
toJSON (GuildMember -> Value) -> Maybe GuildMember -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GuildMember
internalInteractionMember),
              (Key
"user", User -> Value
forall a. ToJSON a => a -> Value
toJSON (User -> Value) -> Maybe User -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe User
internalInteractionUser),
              (Key
"token", InteractionToken -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionToken
internalInteractionToken),
              (Key
"version", Int -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Int
internalInteractionVersion),
              (Key
"message", Message -> Value
forall a. ToJSON a => a -> Value
toJSON (Message -> Value) -> Maybe Message -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
internalInteractionMessage)
            ]
      ]

instance FromJSON InternalInteraction where
  parseJSON :: Value -> Parser InternalInteraction
parseJSON =
    String
-> (Object -> Parser InternalInteraction)
-> Value
-> Parser InternalInteraction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InternalInteraction"
      ( \Object
v ->
          InteractionId
-> InteractionId
-> InteractionType
-> Maybe InternalInteractionData
-> Maybe InteractionId
-> Maybe InteractionId
-> Maybe GuildMember
-> Maybe User
-> InteractionToken
-> Int
-> Maybe Message
-> InternalInteraction
InternalInteraction
            (InteractionId
 -> InteractionId
 -> InteractionType
 -> Maybe InternalInteractionData
 -> Maybe InteractionId
 -> Maybe InteractionId
 -> Maybe GuildMember
 -> Maybe User
 -> InteractionToken
 -> Int
 -> Maybe Message
 -> InternalInteraction)
-> Parser InteractionId
-> Parser
     (InteractionId
      -> InteractionType
      -> Maybe InternalInteractionData
      -> Maybe InteractionId
      -> Maybe InteractionId
      -> Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (InteractionId
   -> InteractionType
   -> Maybe InternalInteractionData
   -> Maybe InteractionId
   -> Maybe InteractionId
   -> Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser InteractionId
-> Parser
     (InteractionType
      -> Maybe InternalInteractionData
      -> Maybe InteractionId
      -> Maybe InteractionId
      -> Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
            Parser
  (InteractionType
   -> Maybe InternalInteractionData
   -> Maybe InteractionId
   -> Maybe InteractionId
   -> Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser InteractionType
-> Parser
     (Maybe InternalInteractionData
      -> Maybe InteractionId
      -> Maybe InteractionId
      -> Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser
  (Maybe InternalInteractionData
   -> Maybe InteractionId
   -> Maybe InteractionId
   -> Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser (Maybe InternalInteractionData)
-> Parser
     (Maybe InteractionId
      -> Maybe InteractionId
      -> Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InternalInteractionData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data"
            Parser
  (Maybe InteractionId
   -> Maybe InteractionId
   -> Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionId
      -> Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
            Parser
  (Maybe InteractionId
   -> Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe GuildMember
      -> Maybe User
      -> InteractionToken
      -> Int
      -> Maybe Message
      -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_id"
            Parser
  (Maybe GuildMember
   -> Maybe User
   -> InteractionToken
   -> Int
   -> Maybe Message
   -> InternalInteraction)
-> Parser (Maybe GuildMember)
-> Parser
     (Maybe User
      -> InteractionToken -> Int -> Maybe Message -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe GuildMember)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"member"
            Parser
  (Maybe User
   -> InteractionToken -> Int -> Maybe Message -> InternalInteraction)
-> Parser (Maybe User)
-> Parser
     (InteractionToken -> Int -> Maybe Message -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
            Parser
  (InteractionToken -> Int -> Maybe Message -> InternalInteraction)
-> Parser InteractionToken
-> Parser (Int -> Maybe Message -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
            Parser (Int -> Maybe Message -> InternalInteraction)
-> Parser Int -> Parser (Maybe Message -> InternalInteraction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
            Parser (Maybe Message -> InternalInteraction)
-> Parser (Maybe Message) -> Parser InternalInteraction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Message)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message"
      )

-- | This is received if the interaction was a component or application command.
--
-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-data-structure
data InternalInteractionData = InternalInteractionData
  { -- | Application command only, id of the invoked command
    InternalInteractionData -> Maybe InteractionId
internalInteractionDataApplicationCommandId :: Maybe ApplicationCommandId,
    -- | Application command only, name of the invoked command
    InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandName :: Maybe T.Text,
    -- | Application command only, the type of the invoked command
    InternalInteractionData -> Maybe ApplicationCommandType
internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType,
    -- | Application command only, converted users, roles, channels
    InternalInteractionData -> Maybe ResolvedData
internalInteractionDataResolved :: Maybe ResolvedData,
    -- | Application command only, params and values
    InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption],
    -- | Component only, the unique id
    InternalInteractionData -> Maybe InteractionToken
internalInteractionDataCustomId :: Maybe T.Text,
    -- | Component only, the type of the component
    InternalInteractionData -> Maybe ComponentType
internalInteractionDataComponentType :: Maybe ComponentType,
    -- | Component only, the selected options if component is the select type
    InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataValues :: Maybe [T.Text],
    -- | This is the id of the user or message being targetted by a user command
    -- or a message command
    InternalInteractionData -> Maybe InteractionId
internalInteractionDataTargetId :: Maybe Snowflake
  }
  deriving (Int -> InternalInteractionData -> ShowS
[InternalInteractionData] -> ShowS
InternalInteractionData -> String
(Int -> InternalInteractionData -> ShowS)
-> (InternalInteractionData -> String)
-> ([InternalInteractionData] -> ShowS)
-> Show InternalInteractionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalInteractionData] -> ShowS
$cshowList :: [InternalInteractionData] -> ShowS
show :: InternalInteractionData -> String
$cshow :: InternalInteractionData -> String
showsPrec :: Int -> InternalInteractionData -> ShowS
$cshowsPrec :: Int -> InternalInteractionData -> ShowS
Show, ReadPrec [InternalInteractionData]
ReadPrec InternalInteractionData
Int -> ReadS InternalInteractionData
ReadS [InternalInteractionData]
(Int -> ReadS InternalInteractionData)
-> ReadS [InternalInteractionData]
-> ReadPrec InternalInteractionData
-> ReadPrec [InternalInteractionData]
-> Read InternalInteractionData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalInteractionData]
$creadListPrec :: ReadPrec [InternalInteractionData]
readPrec :: ReadPrec InternalInteractionData
$creadPrec :: ReadPrec InternalInteractionData
readList :: ReadS [InternalInteractionData]
$creadList :: ReadS [InternalInteractionData]
readsPrec :: Int -> ReadS InternalInteractionData
$creadsPrec :: Int -> ReadS InternalInteractionData
Read, InternalInteractionData -> InternalInteractionData -> Bool
(InternalInteractionData -> InternalInteractionData -> Bool)
-> (InternalInteractionData -> InternalInteractionData -> Bool)
-> Eq InternalInteractionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalInteractionData -> InternalInteractionData -> Bool
$c/= :: InternalInteractionData -> InternalInteractionData -> Bool
== :: InternalInteractionData -> InternalInteractionData -> Bool
$c== :: InternalInteractionData -> InternalInteractionData -> Bool
Eq)

instance ToJSON InternalInteractionData where
  toJSON :: InternalInteractionData -> Value
toJSON InternalInteractionData {Maybe [InteractionToken]
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe InteractionToken
Maybe InteractionId
Maybe ApplicationCommandType
Maybe ComponentType
Maybe ResolvedData
internalInteractionDataTargetId :: Maybe InteractionId
internalInteractionDataValues :: Maybe [InteractionToken]
internalInteractionDataComponentType :: Maybe ComponentType
internalInteractionDataCustomId :: Maybe InteractionToken
internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: Maybe ResolvedData
internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType
internalInteractionDataApplicationCommandName :: Maybe InteractionToken
internalInteractionDataApplicationCommandId :: Maybe InteractionId
internalInteractionDataTargetId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataValues :: InternalInteractionData -> Maybe [InteractionToken]
internalInteractionDataComponentType :: InternalInteractionData -> Maybe ComponentType
internalInteractionDataCustomId :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataOptions :: InternalInteractionData
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataResolved :: InternalInteractionData -> Maybe ResolvedData
internalInteractionDataApplicationCommandName :: InternalInteractionData -> Maybe InteractionToken
internalInteractionDataApplicationCommandId :: InternalInteractionData -> Maybe InteractionId
internalInteractionDataApplicationCommandType :: InternalInteractionData -> Maybe ApplicationCommandType
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionId -> Value) -> Maybe InteractionId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionId
internalInteractionDataApplicationCommandId),
              (Key
"name", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionToken -> Value)
-> Maybe InteractionToken -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
internalInteractionDataApplicationCommandName),
              (Key
"type", ApplicationCommandType -> Value
forall a. ToJSON a => a -> Value
toJSON (ApplicationCommandType -> Value)
-> Maybe ApplicationCommandType -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApplicationCommandType
internalInteractionDataApplicationCommandType),
              (Key
"resolved", ResolvedData -> Value
forall a. ToJSON a => a -> Value
toJSON (ResolvedData -> Value) -> Maybe ResolvedData -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ResolvedData
internalInteractionDataResolved),
              (Key
"options", [InternalInteractionDataApplicationCommandOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalInteractionDataApplicationCommandOption] -> Value)
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataOptions),
              (Key
"custom_id", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionToken -> Value)
-> Maybe InteractionToken -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
internalInteractionDataCustomId),
              (Key
"component_type", ComponentType -> Value
forall a. ToJSON a => a -> Value
toJSON (ComponentType -> Value) -> Maybe ComponentType -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ComponentType
internalInteractionDataComponentType),
              (Key
"values", [InteractionToken] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InteractionToken] -> Value)
-> Maybe [InteractionToken] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InteractionToken]
internalInteractionDataValues),
              (Key
"target_id", InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionId -> Value) -> Maybe InteractionId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionId
internalInteractionDataTargetId)
            ]
      ]

instance FromJSON InternalInteractionData where
  parseJSON :: Value -> Parser InternalInteractionData
parseJSON =
    String
-> (Object -> Parser InternalInteractionData)
-> Value
-> Parser InternalInteractionData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InternalInteractionData"
      ( \Object
v ->
          Maybe InteractionId
-> Maybe InteractionToken
-> Maybe ApplicationCommandType
-> Maybe ResolvedData
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe InteractionToken
-> Maybe ComponentType
-> Maybe [InteractionToken]
-> Maybe InteractionId
-> InternalInteractionData
InternalInteractionData
            (Maybe InteractionId
 -> Maybe InteractionToken
 -> Maybe ApplicationCommandType
 -> Maybe ResolvedData
 -> Maybe [InternalInteractionDataApplicationCommandOption]
 -> Maybe InteractionToken
 -> Maybe ComponentType
 -> Maybe [InteractionToken]
 -> Maybe InteractionId
 -> InternalInteractionData)
-> Parser (Maybe InteractionId)
-> Parser
     (Maybe InteractionToken
      -> Maybe ApplicationCommandType
      -> Maybe ResolvedData
      -> Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe InteractionToken
      -> Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
            Parser
  (Maybe InteractionToken
   -> Maybe ApplicationCommandType
   -> Maybe ResolvedData
   -> Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe InteractionToken
   -> Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe InteractionToken)
-> Parser
     (Maybe ApplicationCommandType
      -> Maybe ResolvedData
      -> Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe InteractionToken
      -> Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InteractionToken)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
            Parser
  (Maybe ApplicationCommandType
   -> Maybe ResolvedData
   -> Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe InteractionToken
   -> Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe ApplicationCommandType)
-> Parser
     (Maybe ResolvedData
      -> Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe InteractionToken
      -> Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ApplicationCommandType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
            Parser
  (Maybe ResolvedData
   -> Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe InteractionToken
   -> Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe ResolvedData)
-> Parser
     (Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe InteractionToken
      -> Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ResolvedData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolved"
            Parser
  (Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe InteractionToken
   -> Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe [InternalInteractionDataApplicationCommandOption])
-> Parser
     (Maybe InteractionToken
      -> Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object
-> Key
-> Parser (Maybe [InternalInteractionDataApplicationCommandOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Parser
  (Maybe InteractionToken
   -> Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe InteractionToken)
-> Parser
     (Maybe ComponentType
      -> Maybe [InteractionToken]
      -> Maybe InteractionId
      -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InteractionToken)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_id"
            Parser
  (Maybe ComponentType
   -> Maybe [InteractionToken]
   -> Maybe InteractionId
   -> InternalInteractionData)
-> Parser (Maybe ComponentType)
-> Parser
     (Maybe [InteractionToken]
      -> Maybe InteractionId -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ComponentType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"component_type"
            Parser
  (Maybe [InteractionToken]
   -> Maybe InteractionId -> InternalInteractionData)
-> Parser (Maybe [InteractionToken])
-> Parser (Maybe InteractionId -> InternalInteractionData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [InteractionToken])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"values"
            Parser (Maybe InteractionId -> InternalInteractionData)
-> Parser (Maybe InteractionId) -> Parser InternalInteractionData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe InteractionId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_id"
      )

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

instance ToJSON ResolvedData where
  toJSON :: ResolvedData -> Value
toJSON ResolvedData {Maybe Value
resolvedDataChannels :: Maybe Value
resolvedDataRoles :: Maybe Value
resolvedDataMembers :: Maybe Value
resolvedDataUsers :: Maybe Value
resolvedDataChannels :: ResolvedData -> Maybe Value
resolvedDataRoles :: ResolvedData -> Maybe Value
resolvedDataMembers :: ResolvedData -> Maybe Value
resolvedDataUsers :: ResolvedData -> Maybe Value
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"users", Maybe Value
resolvedDataUsers),
              (Key
"members", Maybe Value
resolvedDataMembers),
              (Key
"roles", Maybe Value
resolvedDataRoles),
              (Key
"channels", Maybe Value
resolvedDataChannels)
            ]
      ]

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 -> ResolvedData
ResolvedData
            (Maybe Value
 -> Maybe Value -> Maybe Value -> Maybe Value -> ResolvedData)
-> Parser (Maybe Value)
-> Parser
     (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 -> ResolvedData)
-> Parser (Maybe Value)
-> Parser (Maybe Value -> Maybe Value -> ResolvedData)
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 -> ResolvedData)
-> Parser (Maybe Value) -> Parser (Maybe Value -> ResolvedData)
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 -> ResolvedData)
-> Parser (Maybe Value) -> Parser ResolvedData
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"
      )

-- | The application command payload for an interaction.
data InternalInteractionDataApplicationCommandOption = InternalInteractionDataApplicationCommandOption
  { InternalInteractionDataApplicationCommandOption -> InteractionToken
internalInteractionDataApplicationCommandOptionName :: T.Text,
    InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType :: ApplicationCommandOptionType,
    -- | The value itself. Mutually exclusive with options. Docs are wrong that it's only numbers and strings.
    InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue,
    -- | Only present in group subcommands and subcommands. Mutually exclusive with value.
    InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption],
    -- | Whether this is the field that the user is currently typing in.
    InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
  }
  deriving (Int -> InternalInteractionDataApplicationCommandOption -> ShowS
[InternalInteractionDataApplicationCommandOption] -> ShowS
InternalInteractionDataApplicationCommandOption -> String
(Int -> InternalInteractionDataApplicationCommandOption -> ShowS)
-> (InternalInteractionDataApplicationCommandOption -> String)
-> ([InternalInteractionDataApplicationCommandOption] -> ShowS)
-> Show InternalInteractionDataApplicationCommandOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalInteractionDataApplicationCommandOption] -> ShowS
$cshowList :: [InternalInteractionDataApplicationCommandOption] -> ShowS
show :: InternalInteractionDataApplicationCommandOption -> String
$cshow :: InternalInteractionDataApplicationCommandOption -> String
showsPrec :: Int -> InternalInteractionDataApplicationCommandOption -> ShowS
$cshowsPrec :: Int -> InternalInteractionDataApplicationCommandOption -> ShowS
Show, ReadPrec [InternalInteractionDataApplicationCommandOption]
ReadPrec InternalInteractionDataApplicationCommandOption
Int -> ReadS InternalInteractionDataApplicationCommandOption
ReadS [InternalInteractionDataApplicationCommandOption]
(Int -> ReadS InternalInteractionDataApplicationCommandOption)
-> ReadS [InternalInteractionDataApplicationCommandOption]
-> ReadPrec InternalInteractionDataApplicationCommandOption
-> ReadPrec [InternalInteractionDataApplicationCommandOption]
-> Read InternalInteractionDataApplicationCommandOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalInteractionDataApplicationCommandOption]
$creadListPrec :: ReadPrec [InternalInteractionDataApplicationCommandOption]
readPrec :: ReadPrec InternalInteractionDataApplicationCommandOption
$creadPrec :: ReadPrec InternalInteractionDataApplicationCommandOption
readList :: ReadS [InternalInteractionDataApplicationCommandOption]
$creadList :: ReadS [InternalInteractionDataApplicationCommandOption]
readsPrec :: Int -> ReadS InternalInteractionDataApplicationCommandOption
$creadsPrec :: Int -> ReadS InternalInteractionDataApplicationCommandOption
Read, InternalInteractionDataApplicationCommandOption
-> InternalInteractionDataApplicationCommandOption -> Bool
(InternalInteractionDataApplicationCommandOption
 -> InternalInteractionDataApplicationCommandOption -> Bool)
-> (InternalInteractionDataApplicationCommandOption
    -> InternalInteractionDataApplicationCommandOption -> Bool)
-> Eq InternalInteractionDataApplicationCommandOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalInteractionDataApplicationCommandOption
-> InternalInteractionDataApplicationCommandOption -> Bool
$c/= :: InternalInteractionDataApplicationCommandOption
-> InternalInteractionDataApplicationCommandOption -> Bool
== :: InternalInteractionDataApplicationCommandOption
-> InternalInteractionDataApplicationCommandOption -> Bool
$c== :: InternalInteractionDataApplicationCommandOption
-> InternalInteractionDataApplicationCommandOption -> Bool
Eq)

instance ToJSON InternalInteractionDataApplicationCommandOption where
  toJSON :: InternalInteractionDataApplicationCommandOption -> Value
toJSON InternalInteractionDataApplicationCommandOption {Maybe Bool
Maybe [InternalInteractionDataApplicationCommandOption]
Maybe ApplicationCommandInteractionDataValue
InteractionToken
ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionType :: ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionName :: InteractionToken
internalInteractionDataApplicationCommandOptionFocused :: InternalInteractionDataApplicationCommandOption -> Maybe Bool
internalInteractionDataApplicationCommandOptionOptions :: InternalInteractionDataApplicationCommandOption
-> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionValue :: InternalInteractionDataApplicationCommandOption
-> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionType :: InternalInteractionDataApplicationCommandOption
-> ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionName :: InternalInteractionDataApplicationCommandOption -> InteractionToken
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", InteractionToken -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionToken
internalInteractionDataApplicationCommandOptionName),
              (Key
"type", ApplicationCommandOptionType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandOptionType
internalInteractionDataApplicationCommandOptionType),
              (Key
"value", ApplicationCommandInteractionDataValue -> Value
forall a. ToJSON a => a -> Value
toJSON (ApplicationCommandInteractionDataValue -> Value)
-> Maybe ApplicationCommandInteractionDataValue -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApplicationCommandInteractionDataValue
internalInteractionDataApplicationCommandOptionValue),
              (Key
"options", [InternalInteractionDataApplicationCommandOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalInteractionDataApplicationCommandOption] -> Value)
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalInteractionDataApplicationCommandOption]
internalInteractionDataApplicationCommandOptionOptions),
              (Key
"focused", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
internalInteractionDataApplicationCommandOptionFocused)
            ]
      ]

instance FromJSON InternalInteractionDataApplicationCommandOption where
  parseJSON :: Value -> Parser InternalInteractionDataApplicationCommandOption
parseJSON =
    String
-> (Object
    -> Parser InternalInteractionDataApplicationCommandOption)
-> Value
-> Parser InternalInteractionDataApplicationCommandOption
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InternalInteractionDataApplicationCommandOption"
      ( \Object
v ->
          InteractionToken
-> ApplicationCommandOptionType
-> Maybe ApplicationCommandInteractionDataValue
-> Maybe [InternalInteractionDataApplicationCommandOption]
-> Maybe Bool
-> InternalInteractionDataApplicationCommandOption
InternalInteractionDataApplicationCommandOption
            (InteractionToken
 -> ApplicationCommandOptionType
 -> Maybe ApplicationCommandInteractionDataValue
 -> Maybe [InternalInteractionDataApplicationCommandOption]
 -> Maybe Bool
 -> InternalInteractionDataApplicationCommandOption)
-> Parser InteractionToken
-> Parser
     (ApplicationCommandOptionType
      -> Maybe ApplicationCommandInteractionDataValue
      -> Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe Bool
      -> InternalInteractionDataApplicationCommandOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser InteractionToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser
  (ApplicationCommandOptionType
   -> Maybe ApplicationCommandInteractionDataValue
   -> Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe Bool
   -> InternalInteractionDataApplicationCommandOption)
-> Parser ApplicationCommandOptionType
-> Parser
     (Maybe ApplicationCommandInteractionDataValue
      -> Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe Bool
      -> InternalInteractionDataApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser ApplicationCommandOptionType
forall a. FromJSON a => Object -> Parser a
typeParser Object
v
            Parser
  (Maybe ApplicationCommandInteractionDataValue
   -> Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe Bool
   -> InternalInteractionDataApplicationCommandOption)
-> Parser (Maybe ApplicationCommandInteractionDataValue)
-> Parser
     (Maybe [InternalInteractionDataApplicationCommandOption]
      -> Maybe Bool -> InternalInteractionDataApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object -> Parser ApplicationCommandOptionType
forall a. FromJSON a => Object -> Parser a
typeParser Object
v Parser ApplicationCommandOptionType
-> (ApplicationCommandOptionType
    -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ApplicationCommandOptionType
t -> Object
v Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value" Parser (Maybe Value)
-> (Maybe Value
    -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ApplicationCommandOptionType
-> Maybe Value
-> Parser (Maybe ApplicationCommandInteractionDataValue)
valueParser ApplicationCommandOptionType
t)
            Parser
  (Maybe [InternalInteractionDataApplicationCommandOption]
   -> Maybe Bool -> InternalInteractionDataApplicationCommandOption)
-> Parser (Maybe [InternalInteractionDataApplicationCommandOption])
-> Parser
     (Maybe Bool -> InternalInteractionDataApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object
-> Key
-> Parser (Maybe [InternalInteractionDataApplicationCommandOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Parser
  (Maybe Bool -> InternalInteractionDataApplicationCommandOption)
-> Parser (Maybe Bool)
-> Parser InternalInteractionDataApplicationCommandOption
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"
      )
    where
      typeParser :: Object -> Parser a
typeParser Object
v = Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      valueParser :: ApplicationCommandOptionType
-> Maybe Value
-> Parser (Maybe ApplicationCommandInteractionDataValue)
valueParser ApplicationCommandOptionType
t (Just Value
v) = ApplicationCommandOptionType
-> Value -> Parser (Maybe ApplicationCommandInteractionDataValue)
parseJSONACIDV ApplicationCommandOptionType
t Value
v
      valueParser ApplicationCommandOptionType
_ Maybe Value
Nothing = Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ApplicationCommandInteractionDataValue
forall a. Maybe a
Nothing

-- | 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 = InteractionResponse
  { InteractionResponse -> InteractionCallbackType
interactionResponseType :: InteractionCallbackType,
    InteractionResponse -> Maybe InteractionCallbackData
interactionResponseData :: Maybe InteractionCallbackData
  }
  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
showList :: [InteractionResponse] -> ShowS
$cshowList :: [InteractionResponse] -> ShowS
show :: InteractionResponse -> String
$cshow :: InteractionResponse -> String
showsPrec :: Int -> InteractionResponse -> ShowS
$cshowsPrec :: Int -> InteractionResponse -> ShowS
Show, ReadPrec [InteractionResponse]
ReadPrec InteractionResponse
Int -> ReadS InteractionResponse
ReadS [InteractionResponse]
(Int -> ReadS InteractionResponse)
-> ReadS [InteractionResponse]
-> ReadPrec InteractionResponse
-> ReadPrec [InteractionResponse]
-> Read InteractionResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionResponse]
$creadListPrec :: ReadPrec [InteractionResponse]
readPrec :: ReadPrec InteractionResponse
$creadPrec :: ReadPrec InteractionResponse
readList :: ReadS [InteractionResponse]
$creadList :: ReadS [InteractionResponse]
readsPrec :: Int -> ReadS InteractionResponse
$creadsPrec :: Int -> ReadS InteractionResponse
Read, InteractionResponse -> InteractionResponse -> Bool
(InteractionResponse -> InteractionResponse -> Bool)
-> (InteractionResponse -> InteractionResponse -> Bool)
-> Eq InteractionResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionResponse -> InteractionResponse -> Bool
$c/= :: InteractionResponse -> InteractionResponse -> Bool
== :: InteractionResponse -> InteractionResponse -> Bool
$c== :: InteractionResponse -> InteractionResponse -> Bool
Eq)

interactionResponseBasic :: T.Text -> InteractionResponse
interactionResponseBasic :: InteractionToken -> InteractionResponse
interactionResponseBasic InteractionToken
t = InteractionCallbackType
-> Maybe InteractionCallbackData -> InteractionResponse
InteractionResponse InteractionCallbackType
InteractionCallbackTypeChannelMessageWithSource (InteractionCallbackData -> Maybe InteractionCallbackData
forall a. a -> Maybe a
Just (InteractionCallbackData -> Maybe InteractionCallbackData)
-> (InteractionCallbackMessages -> InteractionCallbackData)
-> InteractionCallbackMessages
-> Maybe InteractionCallbackData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionCallbackMessages -> InteractionCallbackData
InteractionCallbackDataMessages (InteractionCallbackMessages -> Maybe InteractionCallbackData)
-> InteractionCallbackMessages -> Maybe InteractionCallbackData
forall a b. (a -> b) -> a -> b
$ InteractionToken -> InteractionCallbackMessages
interactionCallbackMessagesBasic InteractionToken
t)

instance ToJSON InteractionResponse where
  toJSON :: InteractionResponse -> Value
toJSON InteractionResponse {Maybe InteractionCallbackData
InteractionCallbackType
interactionResponseData :: Maybe InteractionCallbackData
interactionResponseType :: InteractionCallbackType
interactionResponseData :: InteractionResponse -> Maybe InteractionCallbackData
interactionResponseType :: InteractionResponse -> InteractionCallbackType
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", InteractionCallbackType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON InteractionCallbackType
interactionResponseType),
              (Key
"data", InteractionCallbackData -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionCallbackData -> Value)
-> Maybe InteractionCallbackData -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionCallbackData
interactionResponseData)
            ]
      ]

-- | What's the type of the response?
data InteractionCallbackType
  = -- | Responds to a PING.
    InteractionCallbackTypePong
  | -- | Respond with a message to the interaction
    InteractionCallbackTypeChannelMessageWithSource
  | -- | Respond with a message to the interaction, after a delay. Sending this
    -- back means the interaction token lasts for 15 minutes.
    InteractionCallbackTypeDeferredChannelMessageWithSource
  | -- | For components, edit the original message later.
    InteractionCallbackTypeDeferredUpdateMessage
  | -- | For components, edit the original message.
    InteractionCallbackTypeUpdateMessage
  | -- | Respond to an autocomplete interaction with suggested choices.
    InteractionCallbackTypeApplicationCommandAutocompleteResult
  deriving (Int -> InteractionCallbackType -> ShowS
[InteractionCallbackType] -> ShowS
InteractionCallbackType -> String
(Int -> InteractionCallbackType -> ShowS)
-> (InteractionCallbackType -> String)
-> ([InteractionCallbackType] -> ShowS)
-> Show InteractionCallbackType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackType] -> ShowS
$cshowList :: [InteractionCallbackType] -> ShowS
show :: InteractionCallbackType -> String
$cshow :: InteractionCallbackType -> String
showsPrec :: Int -> InteractionCallbackType -> ShowS
$cshowsPrec :: Int -> InteractionCallbackType -> ShowS
Show, ReadPrec [InteractionCallbackType]
ReadPrec InteractionCallbackType
Int -> ReadS InteractionCallbackType
ReadS [InteractionCallbackType]
(Int -> ReadS InteractionCallbackType)
-> ReadS [InteractionCallbackType]
-> ReadPrec InteractionCallbackType
-> ReadPrec [InteractionCallbackType]
-> Read InteractionCallbackType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionCallbackType]
$creadListPrec :: ReadPrec [InteractionCallbackType]
readPrec :: ReadPrec InteractionCallbackType
$creadPrec :: ReadPrec InteractionCallbackType
readList :: ReadS [InteractionCallbackType]
$creadList :: ReadS [InteractionCallbackType]
readsPrec :: Int -> ReadS InteractionCallbackType
$creadsPrec :: Int -> ReadS InteractionCallbackType
Read, InteractionCallbackType -> InteractionCallbackType -> Bool
(InteractionCallbackType -> InteractionCallbackType -> Bool)
-> (InteractionCallbackType -> InteractionCallbackType -> Bool)
-> Eq InteractionCallbackType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionCallbackType -> InteractionCallbackType -> Bool
$c/= :: InteractionCallbackType -> InteractionCallbackType -> Bool
== :: InteractionCallbackType -> InteractionCallbackType -> Bool
$c== :: InteractionCallbackType -> InteractionCallbackType -> Bool
Eq, Typeable InteractionCallbackType
DataType
Constr
Typeable InteractionCallbackType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InteractionCallbackType
    -> c InteractionCallbackType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InteractionCallbackType)
-> (InteractionCallbackType -> Constr)
-> (InteractionCallbackType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InteractionCallbackType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InteractionCallbackType))
-> ((forall b. Data b => b -> b)
    -> InteractionCallbackType -> InteractionCallbackType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InteractionCallbackType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> InteractionCallbackType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InteractionCallbackType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> InteractionCallbackType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InteractionCallbackType -> m InteractionCallbackType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InteractionCallbackType -> m InteractionCallbackType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InteractionCallbackType -> m InteractionCallbackType)
-> Data InteractionCallbackType
InteractionCallbackType -> DataType
InteractionCallbackType -> Constr
(forall b. Data b => b -> b)
-> InteractionCallbackType -> InteractionCallbackType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InteractionCallbackType
-> c InteractionCallbackType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InteractionCallbackType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InteractionCallbackType -> u
forall u.
(forall d. Data d => d -> u) -> InteractionCallbackType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InteractionCallbackType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InteractionCallbackType
-> c InteractionCallbackType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InteractionCallbackType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InteractionCallbackType)
$cInteractionCallbackTypeApplicationCommandAutocompleteResult :: Constr
$cInteractionCallbackTypeUpdateMessage :: Constr
$cInteractionCallbackTypeDeferredUpdateMessage :: Constr
$cInteractionCallbackTypeDeferredChannelMessageWithSource :: Constr
$cInteractionCallbackTypeChannelMessageWithSource :: Constr
$cInteractionCallbackTypePong :: Constr
$tInteractionCallbackType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
gmapMp :: (forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
gmapM :: (forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InteractionCallbackType -> m InteractionCallbackType
gmapQi :: Int -> (forall d. Data d => d -> u) -> InteractionCallbackType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InteractionCallbackType -> u
gmapQ :: (forall d. Data d => d -> u) -> InteractionCallbackType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InteractionCallbackType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> InteractionCallbackType
-> r
gmapT :: (forall b. Data b => b -> b)
-> InteractionCallbackType -> InteractionCallbackType
$cgmapT :: (forall b. Data b => b -> b)
-> InteractionCallbackType -> InteractionCallbackType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InteractionCallbackType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InteractionCallbackType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InteractionCallbackType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InteractionCallbackType)
dataTypeOf :: InteractionCallbackType -> DataType
$cdataTypeOf :: InteractionCallbackType -> DataType
toConstr :: InteractionCallbackType -> Constr
$ctoConstr :: InteractionCallbackType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InteractionCallbackType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InteractionCallbackType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InteractionCallbackType
-> c InteractionCallbackType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InteractionCallbackType
-> c InteractionCallbackType
$cp1Data :: Typeable InteractionCallbackType
Data)

instance Enum InteractionCallbackType where
  fromEnum :: InteractionCallbackType -> Int
fromEnum InteractionCallbackType
InteractionCallbackTypePong = Int
1
  fromEnum InteractionCallbackType
InteractionCallbackTypeChannelMessageWithSource = Int
4
  fromEnum InteractionCallbackType
InteractionCallbackTypeDeferredChannelMessageWithSource = Int
5
  fromEnum InteractionCallbackType
InteractionCallbackTypeDeferredUpdateMessage = Int
6
  fromEnum InteractionCallbackType
InteractionCallbackTypeUpdateMessage = Int
7
  fromEnum InteractionCallbackType
InteractionCallbackTypeApplicationCommandAutocompleteResult = Int
8
  toEnum :: Int -> InteractionCallbackType
toEnum Int
a = Maybe InteractionCallbackType -> InteractionCallbackType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InteractionCallbackType -> InteractionCallbackType)
-> Maybe InteractionCallbackType -> InteractionCallbackType
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, InteractionCallbackType)]
-> Maybe InteractionCallbackType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, InteractionCallbackType)]
table
    where
      table :: [(Int, InteractionCallbackType)]
table = InteractionCallbackType -> [(Int, InteractionCallbackType)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable InteractionCallbackType
InteractionCallbackTypePong

instance ToJSON InteractionCallbackType where
  toJSON :: InteractionCallbackType -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value)
-> (InteractionCallbackType -> Int)
-> InteractionCallbackType
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionCallbackType -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Convenience wrapper for two separate types of callback.
data InteractionCallbackData
  = InteractionCallbackDataMessages InteractionCallbackMessages
  | InteractionCallbackDataAutocomplete InteractionCallbackAutocomplete
  deriving (Int -> InteractionCallbackData -> ShowS
[InteractionCallbackData] -> ShowS
InteractionCallbackData -> String
(Int -> InteractionCallbackData -> ShowS)
-> (InteractionCallbackData -> String)
-> ([InteractionCallbackData] -> ShowS)
-> Show InteractionCallbackData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackData] -> ShowS
$cshowList :: [InteractionCallbackData] -> ShowS
show :: InteractionCallbackData -> String
$cshow :: InteractionCallbackData -> String
showsPrec :: Int -> InteractionCallbackData -> ShowS
$cshowsPrec :: Int -> InteractionCallbackData -> ShowS
Show, ReadPrec [InteractionCallbackData]
ReadPrec InteractionCallbackData
Int -> ReadS InteractionCallbackData
ReadS [InteractionCallbackData]
(Int -> ReadS InteractionCallbackData)
-> ReadS [InteractionCallbackData]
-> ReadPrec InteractionCallbackData
-> ReadPrec [InteractionCallbackData]
-> Read InteractionCallbackData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionCallbackData]
$creadListPrec :: ReadPrec [InteractionCallbackData]
readPrec :: ReadPrec InteractionCallbackData
$creadPrec :: ReadPrec InteractionCallbackData
readList :: ReadS [InteractionCallbackData]
$creadList :: ReadS [InteractionCallbackData]
readsPrec :: Int -> ReadS InteractionCallbackData
$creadsPrec :: Int -> ReadS InteractionCallbackData
Read, InteractionCallbackData -> InteractionCallbackData -> Bool
(InteractionCallbackData -> InteractionCallbackData -> Bool)
-> (InteractionCallbackData -> InteractionCallbackData -> Bool)
-> Eq InteractionCallbackData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionCallbackData -> InteractionCallbackData -> Bool
$c/= :: InteractionCallbackData -> InteractionCallbackData -> Bool
== :: InteractionCallbackData -> InteractionCallbackData -> Bool
$c== :: InteractionCallbackData -> InteractionCallbackData -> Bool
Eq)

instance ToJSON InteractionCallbackData where
  toJSON :: InteractionCallbackData -> Value
toJSON (InteractionCallbackDataMessages InteractionCallbackMessages
icdm) = InteractionCallbackMessages -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionCallbackMessages
icdm
  toJSON (InteractionCallbackDataAutocomplete InteractionCallbackAutocomplete
icda) = InteractionCallbackAutocomplete -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionCallbackAutocomplete
icda

type InteractionCallbackAutocomplete = [InternalApplicationCommandOptionChoice]

-- | A cut down message structure.
data InteractionCallbackMessages = InteractionCallbackMessages
  { InteractionCallbackMessages -> Maybe Bool
interactionCallbackMessagesTTS :: Maybe Bool,
    InteractionCallbackMessages -> Maybe InteractionToken
interactionCallbackMessagesContent :: Maybe T.Text,
    InteractionCallbackMessages -> Maybe [Embed]
interactionCallbackMessagesEmbeds :: Maybe [Embed],
    InteractionCallbackMessages -> Maybe AllowedMentions
interactionCallbackMessagesAllowedMentions :: Maybe AllowedMentions,
    InteractionCallbackMessages -> Maybe InteractionCallbackDataFlags
interactionCallbackMessagesFlags :: Maybe InteractionCallbackDataFlags,
    InteractionCallbackMessages -> Maybe [Component]
interactionCallbackMessagesComponents :: Maybe [Component],
    InteractionCallbackMessages -> Maybe [Attachment]
interactionCallbackMessagesAttachments :: Maybe [Attachment]
  }
  deriving (Int -> InteractionCallbackMessages -> ShowS
[InteractionCallbackMessages] -> ShowS
InteractionCallbackMessages -> String
(Int -> InteractionCallbackMessages -> ShowS)
-> (InteractionCallbackMessages -> String)
-> ([InteractionCallbackMessages] -> ShowS)
-> Show InteractionCallbackMessages
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackMessages] -> ShowS
$cshowList :: [InteractionCallbackMessages] -> ShowS
show :: InteractionCallbackMessages -> String
$cshow :: InteractionCallbackMessages -> String
showsPrec :: Int -> InteractionCallbackMessages -> ShowS
$cshowsPrec :: Int -> InteractionCallbackMessages -> ShowS
Show, ReadPrec [InteractionCallbackMessages]
ReadPrec InteractionCallbackMessages
Int -> ReadS InteractionCallbackMessages
ReadS [InteractionCallbackMessages]
(Int -> ReadS InteractionCallbackMessages)
-> ReadS [InteractionCallbackMessages]
-> ReadPrec InteractionCallbackMessages
-> ReadPrec [InteractionCallbackMessages]
-> Read InteractionCallbackMessages
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionCallbackMessages]
$creadListPrec :: ReadPrec [InteractionCallbackMessages]
readPrec :: ReadPrec InteractionCallbackMessages
$creadPrec :: ReadPrec InteractionCallbackMessages
readList :: ReadS [InteractionCallbackMessages]
$creadList :: ReadS [InteractionCallbackMessages]
readsPrec :: Int -> ReadS InteractionCallbackMessages
$creadsPrec :: Int -> ReadS InteractionCallbackMessages
Read, InteractionCallbackMessages -> InteractionCallbackMessages -> Bool
(InteractionCallbackMessages
 -> InteractionCallbackMessages -> Bool)
-> (InteractionCallbackMessages
    -> InteractionCallbackMessages -> Bool)
-> Eq InteractionCallbackMessages
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionCallbackMessages -> InteractionCallbackMessages -> Bool
$c/= :: InteractionCallbackMessages -> InteractionCallbackMessages -> Bool
== :: InteractionCallbackMessages -> InteractionCallbackMessages -> Bool
$c== :: InteractionCallbackMessages -> InteractionCallbackMessages -> Bool
Eq)

interactionCallbackMessagesBasic :: T.Text -> InteractionCallbackMessages
interactionCallbackMessagesBasic :: InteractionToken -> InteractionCallbackMessages
interactionCallbackMessagesBasic InteractionToken
t = Maybe Bool
-> Maybe InteractionToken
-> Maybe [Embed]
-> Maybe AllowedMentions
-> Maybe InteractionCallbackDataFlags
-> Maybe [Component]
-> Maybe [Attachment]
-> InteractionCallbackMessages
InteractionCallbackMessages Maybe Bool
forall a. Maybe a
Nothing (InteractionToken -> Maybe InteractionToken
forall a. a -> Maybe a
Just InteractionToken
t) Maybe [Embed]
forall a. Maybe a
Nothing Maybe AllowedMentions
forall a. Maybe a
Nothing Maybe InteractionCallbackDataFlags
forall a. Maybe a
Nothing Maybe [Component]
forall a. Maybe a
Nothing Maybe [Attachment]
forall a. Maybe a
Nothing

instance ToJSON InteractionCallbackMessages where
  toJSON :: InteractionCallbackMessages -> Value
toJSON InteractionCallbackMessages {Maybe Bool
Maybe [Embed]
Maybe [Component]
Maybe [Attachment]
Maybe InteractionToken
Maybe AllowedMentions
Maybe InteractionCallbackDataFlags
interactionCallbackMessagesAttachments :: Maybe [Attachment]
interactionCallbackMessagesComponents :: Maybe [Component]
interactionCallbackMessagesFlags :: Maybe InteractionCallbackDataFlags
interactionCallbackMessagesAllowedMentions :: Maybe AllowedMentions
interactionCallbackMessagesEmbeds :: Maybe [Embed]
interactionCallbackMessagesContent :: Maybe InteractionToken
interactionCallbackMessagesTTS :: Maybe Bool
interactionCallbackMessagesAttachments :: InteractionCallbackMessages -> Maybe [Attachment]
interactionCallbackMessagesComponents :: InteractionCallbackMessages -> Maybe [Component]
interactionCallbackMessagesFlags :: InteractionCallbackMessages -> Maybe InteractionCallbackDataFlags
interactionCallbackMessagesAllowedMentions :: InteractionCallbackMessages -> Maybe AllowedMentions
interactionCallbackMessagesEmbeds :: InteractionCallbackMessages -> Maybe [Embed]
interactionCallbackMessagesContent :: InteractionCallbackMessages -> Maybe InteractionToken
interactionCallbackMessagesTTS :: InteractionCallbackMessages -> Maybe Bool
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"tts", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
interactionCallbackMessagesTTS),
              (Key
"content", InteractionToken -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionToken -> Value)
-> Maybe InteractionToken -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionToken
interactionCallbackMessagesContent),
              (Key
"embeds", [Embed] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Embed] -> Value) -> Maybe [Embed] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Embed]
interactionCallbackMessagesEmbeds),
              (Key
"allowed_mentions", AllowedMentions -> Value
forall a. ToJSON a => a -> Value
toJSON (AllowedMentions -> Value) -> Maybe AllowedMentions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AllowedMentions
interactionCallbackMessagesAllowedMentions),
              (Key
"flags", InteractionCallbackDataFlags -> Value
forall a. ToJSON a => a -> Value
toJSON (InteractionCallbackDataFlags -> Value)
-> Maybe InteractionCallbackDataFlags -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InteractionCallbackDataFlags
interactionCallbackMessagesFlags),
              (Key
"components", [Component] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Component] -> Value) -> Maybe [Component] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Component]
interactionCallbackMessagesComponents),
              (Key
"attachments", [Attachment] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Attachment] -> Value) -> Maybe [Attachment] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Attachment]
interactionCallbackMessagesAttachments)
            ]
      ]

-- | 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 InteractionCallbackDataFlag = InteractionCallbackDataFlagEphermeral
  deriving (Int -> InteractionCallbackDataFlag -> ShowS
[InteractionCallbackDataFlag] -> ShowS
InteractionCallbackDataFlag -> String
(Int -> InteractionCallbackDataFlag -> ShowS)
-> (InteractionCallbackDataFlag -> String)
-> ([InteractionCallbackDataFlag] -> ShowS)
-> Show InteractionCallbackDataFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackDataFlag] -> ShowS
$cshowList :: [InteractionCallbackDataFlag] -> ShowS
show :: InteractionCallbackDataFlag -> String
$cshow :: InteractionCallbackDataFlag -> String
showsPrec :: Int -> InteractionCallbackDataFlag -> ShowS
$cshowsPrec :: Int -> InteractionCallbackDataFlag -> ShowS
Show, ReadPrec [InteractionCallbackDataFlag]
ReadPrec InteractionCallbackDataFlag
Int -> ReadS InteractionCallbackDataFlag
ReadS [InteractionCallbackDataFlag]
(Int -> ReadS InteractionCallbackDataFlag)
-> ReadS [InteractionCallbackDataFlag]
-> ReadPrec InteractionCallbackDataFlag
-> ReadPrec [InteractionCallbackDataFlag]
-> Read InteractionCallbackDataFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionCallbackDataFlag]
$creadListPrec :: ReadPrec [InteractionCallbackDataFlag]
readPrec :: ReadPrec InteractionCallbackDataFlag
$creadPrec :: ReadPrec InteractionCallbackDataFlag
readList :: ReadS [InteractionCallbackDataFlag]
$creadList :: ReadS [InteractionCallbackDataFlag]
readsPrec :: Int -> ReadS InteractionCallbackDataFlag
$creadsPrec :: Int -> ReadS InteractionCallbackDataFlag
Read, InteractionCallbackDataFlag -> InteractionCallbackDataFlag -> Bool
(InteractionCallbackDataFlag
 -> InteractionCallbackDataFlag -> Bool)
-> (InteractionCallbackDataFlag
    -> InteractionCallbackDataFlag -> Bool)
-> Eq InteractionCallbackDataFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionCallbackDataFlag -> InteractionCallbackDataFlag -> Bool
$c/= :: InteractionCallbackDataFlag -> InteractionCallbackDataFlag -> Bool
== :: InteractionCallbackDataFlag -> InteractionCallbackDataFlag -> Bool
$c== :: InteractionCallbackDataFlag -> InteractionCallbackDataFlag -> Bool
Eq)

newtype InteractionCallbackDataFlags = InteractionCallbackDataFlags [InteractionCallbackDataFlag]
  deriving (Int -> InteractionCallbackDataFlags -> ShowS
[InteractionCallbackDataFlags] -> ShowS
InteractionCallbackDataFlags -> String
(Int -> InteractionCallbackDataFlags -> ShowS)
-> (InteractionCallbackDataFlags -> String)
-> ([InteractionCallbackDataFlags] -> ShowS)
-> Show InteractionCallbackDataFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InteractionCallbackDataFlags] -> ShowS
$cshowList :: [InteractionCallbackDataFlags] -> ShowS
show :: InteractionCallbackDataFlags -> String
$cshow :: InteractionCallbackDataFlags -> String
showsPrec :: Int -> InteractionCallbackDataFlags -> ShowS
$cshowsPrec :: Int -> InteractionCallbackDataFlags -> ShowS
Show, ReadPrec [InteractionCallbackDataFlags]
ReadPrec InteractionCallbackDataFlags
Int -> ReadS InteractionCallbackDataFlags
ReadS [InteractionCallbackDataFlags]
(Int -> ReadS InteractionCallbackDataFlags)
-> ReadS [InteractionCallbackDataFlags]
-> ReadPrec InteractionCallbackDataFlags
-> ReadPrec [InteractionCallbackDataFlags]
-> Read InteractionCallbackDataFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InteractionCallbackDataFlags]
$creadListPrec :: ReadPrec [InteractionCallbackDataFlags]
readPrec :: ReadPrec InteractionCallbackDataFlags
$creadPrec :: ReadPrec InteractionCallbackDataFlags
readList :: ReadS [InteractionCallbackDataFlags]
$creadList :: ReadS [InteractionCallbackDataFlags]
readsPrec :: Int -> ReadS InteractionCallbackDataFlags
$creadsPrec :: Int -> ReadS InteractionCallbackDataFlags
Read, InteractionCallbackDataFlags
-> InteractionCallbackDataFlags -> Bool
(InteractionCallbackDataFlags
 -> InteractionCallbackDataFlags -> Bool)
-> (InteractionCallbackDataFlags
    -> InteractionCallbackDataFlags -> Bool)
-> Eq InteractionCallbackDataFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionCallbackDataFlags
-> InteractionCallbackDataFlags -> Bool
$c/= :: InteractionCallbackDataFlags
-> InteractionCallbackDataFlags -> Bool
== :: InteractionCallbackDataFlags
-> InteractionCallbackDataFlags -> Bool
$c== :: InteractionCallbackDataFlags
-> InteractionCallbackDataFlags -> Bool
Eq)

instance Enum InteractionCallbackDataFlag where
  fromEnum :: InteractionCallbackDataFlag -> Int
fromEnum InteractionCallbackDataFlag
InteractionCallbackDataFlagEphermeral = Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
6
  toEnum :: Int -> InteractionCallbackDataFlag
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 = InteractionCallbackDataFlag
InteractionCallbackDataFlagEphermeral
    | Bool
otherwise = String -> InteractionCallbackDataFlag
forall a. HasCallStack => String -> a
error (String -> InteractionCallbackDataFlag)
-> String -> InteractionCallbackDataFlag
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 InteractionCallbackDataFlags where
  toJSON :: InteractionCallbackDataFlags -> Value
toJSON (InteractionCallbackDataFlags [InteractionCallbackDataFlag]
fs) = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Integer -> Scientific
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 (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 (InteractionCallbackDataFlag -> Int
forall a. Enum a => a -> Int
fromEnum (InteractionCallbackDataFlag -> Int)
-> [InteractionCallbackDataFlag] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InteractionCallbackDataFlag]
fs)

data ApplicationCommandInteractionDataValue
  = ApplicationCommandInteractionDataValueString T.Text
  | ApplicationCommandInteractionDataValueInteger Integer
  | ApplicationCommandInteractionDataValueBoolean Bool
  | ApplicationCommandInteractionDataValueUser Snowflake
  | ApplicationCommandInteractionDataValueChannel Snowflake
  | ApplicationCommandInteractionDataValueRole Snowflake
  | ApplicationCommandInteractionDataValueMentionable Snowflake
  | ApplicationCommandInteractionDataValueNumber Scientific
  deriving (Int -> ApplicationCommandInteractionDataValue -> ShowS
[ApplicationCommandInteractionDataValue] -> ShowS
ApplicationCommandInteractionDataValue -> String
(Int -> ApplicationCommandInteractionDataValue -> ShowS)
-> (ApplicationCommandInteractionDataValue -> String)
-> ([ApplicationCommandInteractionDataValue] -> ShowS)
-> Show ApplicationCommandInteractionDataValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandInteractionDataValue] -> ShowS
$cshowList :: [ApplicationCommandInteractionDataValue] -> ShowS
show :: ApplicationCommandInteractionDataValue -> String
$cshow :: ApplicationCommandInteractionDataValue -> String
showsPrec :: Int -> ApplicationCommandInteractionDataValue -> ShowS
$cshowsPrec :: Int -> ApplicationCommandInteractionDataValue -> ShowS
Show, ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
(ApplicationCommandInteractionDataValue
 -> ApplicationCommandInteractionDataValue -> Bool)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Bool)
-> Eq ApplicationCommandInteractionDataValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c/= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
== :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c== :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
Eq, Eq ApplicationCommandInteractionDataValue
Eq ApplicationCommandInteractionDataValue
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Ordering)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Bool)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Bool)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Bool)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue -> Bool)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue)
-> (ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue
    -> ApplicationCommandInteractionDataValue)
-> Ord ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Ordering
ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
$cmin :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
max :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
$cmax :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue
>= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c>= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
> :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c> :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
<= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c<= :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
< :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
$c< :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Bool
compare :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Ordering
$ccompare :: ApplicationCommandInteractionDataValue
-> ApplicationCommandInteractionDataValue -> Ordering
$cp1Ord :: Eq ApplicationCommandInteractionDataValue
Ord, ReadPrec [ApplicationCommandInteractionDataValue]
ReadPrec ApplicationCommandInteractionDataValue
Int -> ReadS ApplicationCommandInteractionDataValue
ReadS [ApplicationCommandInteractionDataValue]
(Int -> ReadS ApplicationCommandInteractionDataValue)
-> ReadS [ApplicationCommandInteractionDataValue]
-> ReadPrec ApplicationCommandInteractionDataValue
-> ReadPrec [ApplicationCommandInteractionDataValue]
-> Read ApplicationCommandInteractionDataValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandInteractionDataValue]
$creadListPrec :: ReadPrec [ApplicationCommandInteractionDataValue]
readPrec :: ReadPrec ApplicationCommandInteractionDataValue
$creadPrec :: ReadPrec ApplicationCommandInteractionDataValue
readList :: ReadS [ApplicationCommandInteractionDataValue]
$creadList :: ReadS [ApplicationCommandInteractionDataValue]
readsPrec :: Int -> ReadS ApplicationCommandInteractionDataValue
$creadsPrec :: Int -> ReadS ApplicationCommandInteractionDataValue
Read)

getTypeFromACIDV :: ApplicationCommandInteractionDataValue -> ApplicationCommandOptionType
getTypeFromACIDV :: ApplicationCommandInteractionDataValue
-> ApplicationCommandOptionType
getTypeFromACIDV ApplicationCommandInteractionDataValue
acidv = case ApplicationCommandInteractionDataValue
acidv of
  ApplicationCommandInteractionDataValueString InteractionToken
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeString
  ApplicationCommandInteractionDataValueInteger Integer
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger
  ApplicationCommandInteractionDataValueBoolean Bool
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeBoolean
  ApplicationCommandInteractionDataValueUser InteractionId
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeUser
  ApplicationCommandInteractionDataValueChannel InteractionId
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeChannel
  ApplicationCommandInteractionDataValueRole InteractionId
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeRole
  ApplicationCommandInteractionDataValueMentionable InteractionId
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeMentionable
  ApplicationCommandInteractionDataValueNumber Scientific
_ -> ApplicationCommandOptionType
ApplicationCommandOptionTypeNumber

instance ToJSON ApplicationCommandInteractionDataValue where
  toJSON :: ApplicationCommandInteractionDataValue -> Value
toJSON (ApplicationCommandInteractionDataValueString InteractionToken
t) = InteractionToken -> Value
String InteractionToken
t
  toJSON (ApplicationCommandInteractionDataValueNumber Scientific
t) = Scientific -> Value
Number Scientific
t
  toJSON (ApplicationCommandInteractionDataValueInteger Integer
t) = Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
t
  toJSON (ApplicationCommandInteractionDataValueBoolean Bool
t) = Bool -> Value
Bool Bool
t
  toJSON (ApplicationCommandInteractionDataValueUser InteractionId
t) = InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionId
t
  toJSON (ApplicationCommandInteractionDataValueChannel InteractionId
t) = InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionId
t
  toJSON (ApplicationCommandInteractionDataValueRole InteractionId
t) = InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionId
t
  toJSON (ApplicationCommandInteractionDataValueMentionable InteractionId
t) = InteractionId -> Value
forall a. ToJSON a => a -> Value
toJSON InteractionId
t

parseJSONACIDV :: ApplicationCommandOptionType -> Value -> Parser (Maybe ApplicationCommandInteractionDataValue)
parseJSONACIDV :: ApplicationCommandOptionType
-> Value -> Parser (Maybe ApplicationCommandInteractionDataValue)
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeString (String InteractionToken
t) = Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ApplicationCommandInteractionDataValue
 -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall a b. (a -> b) -> a -> b
$ ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall (m :: * -> *) a. Monad m => a -> m a
return (InteractionToken -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueString InteractionToken
t)
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger Value
n = ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just (ApplicationCommandInteractionDataValue
 -> Maybe ApplicationCommandInteractionDataValue)
-> (Integer -> ApplicationCommandInteractionDataValue)
-> Integer
-> Maybe ApplicationCommandInteractionDataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueInteger (Integer -> Maybe ApplicationCommandInteractionDataValue)
-> Parser Integer
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
n
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeNumber (Number Scientific
t) = Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ApplicationCommandInteractionDataValue
 -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall a b. (a -> b) -> a -> b
$ ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueNumber Scientific
t)
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeBoolean (Bool Bool
t) = Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ApplicationCommandInteractionDataValue
 -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> Maybe ApplicationCommandInteractionDataValue
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall a b. (a -> b) -> a -> b
$ ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueBoolean Bool
t)
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeUser Value
t = ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just (ApplicationCommandInteractionDataValue
 -> Maybe ApplicationCommandInteractionDataValue)
-> (InteractionId -> ApplicationCommandInteractionDataValue)
-> InteractionId
-> Maybe ApplicationCommandInteractionDataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionId -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueUser (InteractionId -> Maybe ApplicationCommandInteractionDataValue)
-> Parser InteractionId
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InteractionId
forall a. FromJSON a => Value -> Parser a
parseJSON Value
t
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeChannel Value
t = ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just (ApplicationCommandInteractionDataValue
 -> Maybe ApplicationCommandInteractionDataValue)
-> (InteractionId -> ApplicationCommandInteractionDataValue)
-> InteractionId
-> Maybe ApplicationCommandInteractionDataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionId -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueChannel (InteractionId -> Maybe ApplicationCommandInteractionDataValue)
-> Parser InteractionId
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InteractionId
forall a. FromJSON a => Value -> Parser a
parseJSON Value
t
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeRole Value
t = ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just (ApplicationCommandInteractionDataValue
 -> Maybe ApplicationCommandInteractionDataValue)
-> (InteractionId -> ApplicationCommandInteractionDataValue)
-> InteractionId
-> Maybe ApplicationCommandInteractionDataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionId -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueRole (InteractionId -> Maybe ApplicationCommandInteractionDataValue)
-> Parser InteractionId
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InteractionId
forall a. FromJSON a => Value -> Parser a
parseJSON Value
t
parseJSONACIDV ApplicationCommandOptionType
ApplicationCommandOptionTypeMentionable Value
t = ApplicationCommandInteractionDataValue
-> Maybe ApplicationCommandInteractionDataValue
forall a. a -> Maybe a
Just (ApplicationCommandInteractionDataValue
 -> Maybe ApplicationCommandInteractionDataValue)
-> (InteractionId -> ApplicationCommandInteractionDataValue)
-> InteractionId
-> Maybe ApplicationCommandInteractionDataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractionId -> ApplicationCommandInteractionDataValue
ApplicationCommandInteractionDataValueMentionable (InteractionId -> Maybe ApplicationCommandInteractionDataValue)
-> Parser InteractionId
-> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser InteractionId
forall a. FromJSON a => Value -> Parser a
parseJSON Value
t
parseJSONACIDV ApplicationCommandOptionType
t Value
v = String -> Parser (Maybe ApplicationCommandInteractionDataValue)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Maybe ApplicationCommandInteractionDataValue))
-> String -> Parser (Maybe ApplicationCommandInteractionDataValue)
forall a b. (a -> b) -> a -> b
$ String
"could not parse type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ApplicationCommandOptionType -> String
forall a. Show a => a -> String
show ApplicationCommandOptionType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v