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

module Discord.Internal.Types.ApplicationCommands
  ( ApplicationCommand (..),
    ApplicationCommandOptionSubcommandOrGroup (..),
    ApplicationCommandOptionSubcommand (..),
    ApplicationCommandOptionValue (..),
    InternalApplicationCommand (..),
    CreateApplicationCommand (..),
    createApplicationCommandChatInput,
    createApplicationCommandUser,
    createApplicationCommandMessage,
    EditApplicationCommand (..),
    ApplicationCommandType (..),
    InternalApplicationCommandOption (..),
    ApplicationCommandOptionType (..),
    InternalApplicationCommandOptionChoice,
    Choice (..),
    ApplicationCommandChannelType (..),
    GuildApplicationCommandPermissions (..),
    ApplicationCommandPermissions (..),
    ApplicationCommandPermissionType (..),
    StringNumberValue (..),
  )
where

import Control.Applicative
import Data.Aeson
import Data.Char (isLower)
import Data.Data (Data)
import Data.Default (Default (..))
import Data.Maybe (fromJust, fromMaybe)
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, Internals (..), Snowflake, makeTable, toMaybeJSON)

data ApplicationCommand
  = ApplicationCommandUser
      { ApplicationCommand -> ApplicationCommandId
applicationCommandId :: ApplicationCommandId,
        ApplicationCommand -> ApplicationCommandId
applicationCommandApplicationId :: ApplicationId,
        ApplicationCommand -> Maybe ApplicationCommandId
applicationCommandGuildId :: Maybe GuildId,
        ApplicationCommand -> Text
applicationCommandName :: T.Text,
        ApplicationCommand -> Maybe Bool
applicationCommandDefaultPermission :: Maybe Bool,
        ApplicationCommand -> ApplicationCommandId
applicationCommandVersion :: Snowflake
      }
  | ApplicationCommandMessage
      { applicationCommandId :: ApplicationCommandId,
        applicationCommandApplicationId :: ApplicationId,
        applicationCommandGuildId :: Maybe GuildId,
        applicationCommandName :: T.Text,
        applicationCommandDefaultPermission :: Maybe Bool,
        applicationCommandVersion :: Snowflake
      }
  | ApplicationCommandChatInput
      { applicationCommandId :: ApplicationCommandId,
        applicationCommandApplicationId :: ApplicationId,
        applicationCommandGuildId :: Maybe GuildId,
        applicationCommandName :: T.Text,
        ApplicationCommand -> Text
applicationCommandDescription :: T.Text,
        ApplicationCommand -> Maybe ApplicationCommandOptions
applicationCommandOptions :: Maybe ApplicationCommandOptions,
        applicationCommandDefaultPermission :: Maybe Bool,
        applicationCommandVersion :: Snowflake
      }
  | ApplicationCommandUnknown InternalApplicationCommand
  deriving (Int -> ApplicationCommand -> ShowS
[ApplicationCommand] -> ShowS
ApplicationCommand -> String
(Int -> ApplicationCommand -> ShowS)
-> (ApplicationCommand -> String)
-> ([ApplicationCommand] -> ShowS)
-> Show ApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommand] -> ShowS
$cshowList :: [ApplicationCommand] -> ShowS
show :: ApplicationCommand -> String
$cshow :: ApplicationCommand -> String
showsPrec :: Int -> ApplicationCommand -> ShowS
$cshowsPrec :: Int -> ApplicationCommand -> ShowS
Show, ApplicationCommand -> ApplicationCommand -> Bool
(ApplicationCommand -> ApplicationCommand -> Bool)
-> (ApplicationCommand -> ApplicationCommand -> Bool)
-> Eq ApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommand -> ApplicationCommand -> Bool
$c/= :: ApplicationCommand -> ApplicationCommand -> Bool
== :: ApplicationCommand -> ApplicationCommand -> Bool
$c== :: ApplicationCommand -> ApplicationCommand -> Bool
Eq, ReadPrec [ApplicationCommand]
ReadPrec ApplicationCommand
Int -> ReadS ApplicationCommand
ReadS [ApplicationCommand]
(Int -> ReadS ApplicationCommand)
-> ReadS [ApplicationCommand]
-> ReadPrec ApplicationCommand
-> ReadPrec [ApplicationCommand]
-> Read ApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommand]
$creadListPrec :: ReadPrec [ApplicationCommand]
readPrec :: ReadPrec ApplicationCommand
$creadPrec :: ReadPrec ApplicationCommand
readList :: ReadS [ApplicationCommand]
$creadList :: ReadS [ApplicationCommand]
readsPrec :: Int -> ReadS ApplicationCommand
$creadsPrec :: Int -> ReadS ApplicationCommand
Read)

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

data ApplicationCommandOptionSubcommandOrGroup
  = ApplicationCommandOptionSubcommandGroup
      { ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupName :: T.Text,
        ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupDescription :: T.Text,
        ApplicationCommandOptionSubcommandOrGroup
-> [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]
      }
  | ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand
  deriving (Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
[ApplicationCommandOptionSubcommandOrGroup] -> ShowS
ApplicationCommandOptionSubcommandOrGroup -> String
(Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS)
-> (ApplicationCommandOptionSubcommandOrGroup -> String)
-> ([ApplicationCommandOptionSubcommandOrGroup] -> ShowS)
-> Show ApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionSubcommandOrGroup] -> ShowS
$cshowList :: [ApplicationCommandOptionSubcommandOrGroup] -> ShowS
show :: ApplicationCommandOptionSubcommandOrGroup -> String
$cshow :: ApplicationCommandOptionSubcommandOrGroup -> String
showsPrec :: Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionSubcommandOrGroup -> ShowS
Show, ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
(ApplicationCommandOptionSubcommandOrGroup
 -> ApplicationCommandOptionSubcommandOrGroup -> Bool)
-> (ApplicationCommandOptionSubcommandOrGroup
    -> ApplicationCommandOptionSubcommandOrGroup -> Bool)
-> Eq ApplicationCommandOptionSubcommandOrGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
$c/= :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
== :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
$c== :: ApplicationCommandOptionSubcommandOrGroup
-> ApplicationCommandOptionSubcommandOrGroup -> Bool
Eq, ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
ReadPrec ApplicationCommandOptionSubcommandOrGroup
Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
ReadS [ApplicationCommandOptionSubcommandOrGroup]
(Int -> ReadS ApplicationCommandOptionSubcommandOrGroup)
-> ReadS [ApplicationCommandOptionSubcommandOrGroup]
-> ReadPrec ApplicationCommandOptionSubcommandOrGroup
-> ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
-> Read ApplicationCommandOptionSubcommandOrGroup
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
$creadListPrec :: ReadPrec [ApplicationCommandOptionSubcommandOrGroup]
readPrec :: ReadPrec ApplicationCommandOptionSubcommandOrGroup
$creadPrec :: ReadPrec ApplicationCommandOptionSubcommandOrGroup
readList :: ReadS [ApplicationCommandOptionSubcommandOrGroup]
$creadList :: ReadS [ApplicationCommandOptionSubcommandOrGroup]
readsPrec :: Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
$creadsPrec :: Int -> ReadS ApplicationCommandOptionSubcommandOrGroup
Read)

data ApplicationCommandOptionSubcommand = ApplicationCommandOptionSubcommand
  { ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandName :: T.Text,
    ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandDescription :: T.Text,
    ApplicationCommandOptionSubcommand
-> [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]
  }
  deriving (Int -> ApplicationCommandOptionSubcommand -> ShowS
[ApplicationCommandOptionSubcommand] -> ShowS
ApplicationCommandOptionSubcommand -> String
(Int -> ApplicationCommandOptionSubcommand -> ShowS)
-> (ApplicationCommandOptionSubcommand -> String)
-> ([ApplicationCommandOptionSubcommand] -> ShowS)
-> Show ApplicationCommandOptionSubcommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionSubcommand] -> ShowS
$cshowList :: [ApplicationCommandOptionSubcommand] -> ShowS
show :: ApplicationCommandOptionSubcommand -> String
$cshow :: ApplicationCommandOptionSubcommand -> String
showsPrec :: Int -> ApplicationCommandOptionSubcommand -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionSubcommand -> ShowS
Show, ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
(ApplicationCommandOptionSubcommand
 -> ApplicationCommandOptionSubcommand -> Bool)
-> (ApplicationCommandOptionSubcommand
    -> ApplicationCommandOptionSubcommand -> Bool)
-> Eq ApplicationCommandOptionSubcommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
$c/= :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
== :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
$c== :: ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommand -> Bool
Eq, ReadPrec [ApplicationCommandOptionSubcommand]
ReadPrec ApplicationCommandOptionSubcommand
Int -> ReadS ApplicationCommandOptionSubcommand
ReadS [ApplicationCommandOptionSubcommand]
(Int -> ReadS ApplicationCommandOptionSubcommand)
-> ReadS [ApplicationCommandOptionSubcommand]
-> ReadPrec ApplicationCommandOptionSubcommand
-> ReadPrec [ApplicationCommandOptionSubcommand]
-> Read ApplicationCommandOptionSubcommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionSubcommand]
$creadListPrec :: ReadPrec [ApplicationCommandOptionSubcommand]
readPrec :: ReadPrec ApplicationCommandOptionSubcommand
$creadPrec :: ReadPrec ApplicationCommandOptionSubcommand
readList :: ReadS [ApplicationCommandOptionSubcommand]
$creadList :: ReadS [ApplicationCommandOptionSubcommand]
readsPrec :: Int -> ReadS ApplicationCommandOptionSubcommand
$creadsPrec :: Int -> ReadS ApplicationCommandOptionSubcommand
Read)

data ApplicationCommandOptionValue
  = ApplicationCommandOptionValueString
      { ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: T.Text,
        ApplicationCommandOptionValue -> Text
applicationCommandOptionValueDescription :: T.Text,
        ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueRequired :: Maybe Bool,
        ApplicationCommandOptionValue -> Maybe [Choice Text]
applicationCommandOptionValueStringChoices :: Maybe [Choice T.Text],
        ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueAutocomplete :: Maybe Bool
      }
  | ApplicationCommandOptionValueInteger
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool,
        ApplicationCommandOptionValue -> Maybe [Choice Integer]
applicationCommandOptionValueIntegerChoices :: Maybe [Choice Integer],
        ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMinVal :: Maybe Integer,
        ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMaxVal :: Maybe Integer,
        applicationCommandOptionValueAutocomplete :: Maybe Bool
      }
  | ApplicationCommandOptionValueBoolean
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool
      }
  | ApplicationCommandOptionValueUser
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool
      }
  | ApplicationCommandOptionValueChannel
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool,
        ApplicationCommandOptionValue
-> Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]
      }
  | ApplicationCommandOptionValueRole
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool
      }
  | ApplicationCommandOptionValueMentionable
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool
      }
  | ApplicationCommandOptionValueNumber
      { applicationCommandOptionValueName :: T.Text,
        applicationCommandOptionValueDescription :: T.Text,
        applicationCommandOptionValueRequired :: Maybe Bool,
        ApplicationCommandOptionValue -> Maybe [Choice Scientific]
applicationCommandOptionValueNumberChoices :: Maybe [Choice Scientific],
        ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMinVal :: Maybe Scientific,
        ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMaxVal :: Maybe Scientific,
        applicationCommandOptionValueAutocomplete :: Maybe Bool
      }
  deriving (Int -> ApplicationCommandOptionValue -> ShowS
[ApplicationCommandOptionValue] -> ShowS
ApplicationCommandOptionValue -> String
(Int -> ApplicationCommandOptionValue -> ShowS)
-> (ApplicationCommandOptionValue -> String)
-> ([ApplicationCommandOptionValue] -> ShowS)
-> Show ApplicationCommandOptionValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionValue] -> ShowS
$cshowList :: [ApplicationCommandOptionValue] -> ShowS
show :: ApplicationCommandOptionValue -> String
$cshow :: ApplicationCommandOptionValue -> String
showsPrec :: Int -> ApplicationCommandOptionValue -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionValue -> ShowS
Show, ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
(ApplicationCommandOptionValue
 -> ApplicationCommandOptionValue -> Bool)
-> (ApplicationCommandOptionValue
    -> ApplicationCommandOptionValue -> Bool)
-> Eq ApplicationCommandOptionValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
$c/= :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
== :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
$c== :: ApplicationCommandOptionValue
-> ApplicationCommandOptionValue -> Bool
Eq, ReadPrec [ApplicationCommandOptionValue]
ReadPrec ApplicationCommandOptionValue
Int -> ReadS ApplicationCommandOptionValue
ReadS [ApplicationCommandOptionValue]
(Int -> ReadS ApplicationCommandOptionValue)
-> ReadS [ApplicationCommandOptionValue]
-> ReadPrec ApplicationCommandOptionValue
-> ReadPrec [ApplicationCommandOptionValue]
-> Read ApplicationCommandOptionValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionValue]
$creadListPrec :: ReadPrec [ApplicationCommandOptionValue]
readPrec :: ReadPrec ApplicationCommandOptionValue
$creadPrec :: ReadPrec ApplicationCommandOptionValue
readList :: ReadS [ApplicationCommandOptionValue]
$creadList :: ReadS [ApplicationCommandOptionValue]
readsPrec :: Int -> ReadS ApplicationCommandOptionValue
$creadsPrec :: Int -> ReadS ApplicationCommandOptionValue
Read)

instance Internals ApplicationCommandOptionValue InternalApplicationCommandOption where
  toInternal :: ApplicationCommandOptionValue -> InternalApplicationCommandOption
toInternal ApplicationCommandOptionValueNumber {Maybe Bool
Maybe [Choice Scientific]
Maybe Scientific
Text
applicationCommandOptionValueAutocomplete :: Maybe Bool
applicationCommandOptionValueNumberMaxVal :: Maybe Scientific
applicationCommandOptionValueNumberMinVal :: Maybe Scientific
applicationCommandOptionValueNumberChoices :: Maybe [Choice Scientific]
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueNumberMaxVal :: ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberMinVal :: ApplicationCommandOptionValue -> Maybe Scientific
applicationCommandOptionValueNumberChoices :: ApplicationCommandOptionValue -> Maybe [Choice Scientific]
applicationCommandOptionValueAutocomplete :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeNumber Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired (((Scientific -> StringNumberValue
StringNumberValueNumber (Scientific -> StringNumberValue)
-> Choice Scientific -> InternalApplicationCommandOptionChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Choice Scientific -> InternalApplicationCommandOptionChoice)
-> [Choice Scientific] -> [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Choice Scientific] -> [InternalApplicationCommandOptionChoice])
-> Maybe [Choice Scientific]
-> Maybe [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Choice Scientific]
applicationCommandOptionValueNumberChoices) Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
applicationCommandOptionValueNumberMinVal Maybe Scientific
applicationCommandOptionValueNumberMaxVal Maybe Bool
applicationCommandOptionValueAutocomplete
  toInternal ApplicationCommandOptionValueInteger {Maybe Bool
Maybe Integer
Maybe [Choice Integer]
Text
applicationCommandOptionValueAutocomplete :: Maybe Bool
applicationCommandOptionValueIntegerMaxVal :: Maybe Integer
applicationCommandOptionValueIntegerMinVal :: Maybe Integer
applicationCommandOptionValueIntegerChoices :: Maybe [Choice Integer]
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueIntegerMaxVal :: ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerMinVal :: ApplicationCommandOptionValue -> Maybe Integer
applicationCommandOptionValueIntegerChoices :: ApplicationCommandOptionValue -> Maybe [Choice Integer]
applicationCommandOptionValueAutocomplete :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired (((Integer -> StringNumberValue
StringNumberValueInteger (Integer -> StringNumberValue)
-> Choice Integer -> InternalApplicationCommandOptionChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Choice Integer -> InternalApplicationCommandOptionChoice)
-> [Choice Integer] -> [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Choice Integer] -> [InternalApplicationCommandOptionChoice])
-> Maybe [Choice Integer]
-> Maybe [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Choice Integer]
applicationCommandOptionValueIntegerChoices) Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Maybe Integer -> Maybe Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
applicationCommandOptionValueIntegerMinVal) (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Maybe Integer -> Maybe Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
applicationCommandOptionValueIntegerMaxVal) Maybe Bool
applicationCommandOptionValueAutocomplete
  toInternal ApplicationCommandOptionValueString {Maybe Bool
Maybe [Choice Text]
Text
applicationCommandOptionValueAutocomplete :: Maybe Bool
applicationCommandOptionValueStringChoices :: Maybe [Choice Text]
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueAutocomplete :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueStringChoices :: ApplicationCommandOptionValue -> Maybe [Choice Text]
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired (((Text -> StringNumberValue
StringNumberValueString (Text -> StringNumberValue)
-> Choice Text -> InternalApplicationCommandOptionChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Choice Text -> InternalApplicationCommandOptionChoice)
-> [Choice Text] -> [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Choice Text] -> [InternalApplicationCommandOptionChoice])
-> Maybe [Choice Text]
-> Maybe [InternalApplicationCommandOptionChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Choice Text]
applicationCommandOptionValueStringChoices) Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
applicationCommandOptionValueAutocomplete
  toInternal ApplicationCommandOptionValueChannel {Maybe Bool
Maybe [ApplicationCommandChannelType]
Text
applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueChannelTypes :: ApplicationCommandOptionValue
-> Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeChannel Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
applicationCommandOptionValueChannelTypes Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  toInternal ApplicationCommandOptionValueBoolean {Maybe Bool
Text
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeBoolean Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  toInternal ApplicationCommandOptionValueUser {Maybe Bool
Text
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeUser Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  toInternal ApplicationCommandOptionValueRole {Maybe Bool
Text
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeRole Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
  toInternal ApplicationCommandOptionValueMentionable {Maybe Bool
Text
applicationCommandOptionValueRequired :: Maybe Bool
applicationCommandOptionValueDescription :: Text
applicationCommandOptionValueName :: Text
applicationCommandOptionValueRequired :: ApplicationCommandOptionValue -> Maybe Bool
applicationCommandOptionValueDescription :: ApplicationCommandOptionValue -> Text
applicationCommandOptionValueName :: ApplicationCommandOptionValue -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeMentionable Text
applicationCommandOptionValueName Text
applicationCommandOptionValueDescription Maybe Bool
applicationCommandOptionValueRequired Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

  fromInternal :: InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionValue
fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeNumber, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
..} = do
    [Choice Scientific]
cs <- Maybe [Choice Scientific]
-> ([InternalApplicationCommandOptionChoice]
    -> Maybe [Choice Scientific])
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [Choice Scientific]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Choice Scientific] -> Maybe [Choice Scientific]
forall a. a -> Maybe a
Just []) ((InternalApplicationCommandOptionChoice
 -> Maybe (Choice Scientific))
-> [InternalApplicationCommandOptionChoice]
-> Maybe [Choice Scientific]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOptionChoice -> Maybe (Choice Scientific)
extractChoices) Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionChoices
    ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe Bool
-> Maybe [Choice Scientific]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueNumber Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired ([Choice Scientific] -> Maybe [Choice Scientific]
forall a. [a] -> Maybe [a]
fromResult [Choice Scientific]
cs) Maybe Scientific
internalApplicationCommandOptionMinVal Maybe Scientific
internalApplicationCommandOptionMaxVal Maybe Bool
internalApplicationCommandOptionAutocomplete
    where
      extractChoices :: InternalApplicationCommandOptionChoice -> Maybe (Choice Scientific)
extractChoices (Choice Text
s (StringNumberValueNumber Scientific
n)) = Choice Scientific -> Maybe (Choice Scientific)
forall a. a -> Maybe a
Just (Text -> Scientific -> Choice Scientific
forall a. Text -> a -> Choice a
Choice Text
s Scientific
n)
      extractChoices InternalApplicationCommandOptionChoice
_ = Maybe (Choice Scientific)
forall a. Maybe a
Nothing
      fromResult :: [a] -> Maybe [a]
fromResult [] = Maybe [a]
forall a. Maybe a
Nothing
      fromResult [a]
is = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
is
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = do
    [Choice Integer]
cs <- Maybe [Choice Integer]
-> ([InternalApplicationCommandOptionChoice]
    -> Maybe [Choice Integer])
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [Choice Integer]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Choice Integer] -> Maybe [Choice Integer]
forall a. a -> Maybe a
Just []) ((InternalApplicationCommandOptionChoice -> Maybe (Choice Integer))
-> [InternalApplicationCommandOptionChoice]
-> Maybe [Choice Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOptionChoice -> Maybe (Choice Integer)
extractChoices) Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionChoices
    ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe Bool
-> Maybe [Choice Integer]
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueInteger Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired ([Choice Integer] -> Maybe [Choice Integer]
forall a. [a] -> Maybe [a]
fromResult [Choice Integer]
cs) (Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Scientific -> Integer) -> Maybe Scientific -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
internalApplicationCommandOptionMinVal) (Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Scientific -> Integer) -> Maybe Scientific -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
internalApplicationCommandOptionMaxVal) Maybe Bool
internalApplicationCommandOptionAutocomplete
    where
      extractChoices :: InternalApplicationCommandOptionChoice -> Maybe (Choice Integer)
extractChoices (Choice Text
s (StringNumberValueInteger Integer
n)) = Choice Integer -> Maybe (Choice Integer)
forall a. a -> Maybe a
Just (Text -> Integer -> Choice Integer
forall a. Text -> a -> Choice a
Choice Text
s Integer
n)
      extractChoices InternalApplicationCommandOptionChoice
_ = Maybe (Choice Integer)
forall a. Maybe a
Nothing
      fromResult :: [a] -> Maybe [a]
fromResult [] = Maybe [a]
forall a. Maybe a
Nothing
      fromResult [a]
is = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
is
  -- note with the above: the bounds are rounded for simplicity but ideally they wouldn't be
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeString, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = do
    [Choice Text]
cs <- Maybe [Choice Text]
-> ([InternalApplicationCommandOptionChoice]
    -> Maybe [Choice Text])
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [Choice Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Choice Text] -> Maybe [Choice Text]
forall a. a -> Maybe a
Just []) ((InternalApplicationCommandOptionChoice -> Maybe (Choice Text))
-> [InternalApplicationCommandOptionChoice] -> Maybe [Choice Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOptionChoice -> Maybe (Choice Text)
extractChoices) Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionChoices
    ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe Bool
-> Maybe [Choice Text]
-> Maybe Bool
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueString Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired ([Choice Text] -> Maybe [Choice Text]
forall a. [a] -> Maybe [a]
fromResult [Choice Text]
cs) Maybe Bool
internalApplicationCommandOptionAutocomplete
    where
      extractChoices :: InternalApplicationCommandOptionChoice -> Maybe (Choice Text)
extractChoices (Choice Text
s (StringNumberValueString Text
n)) = Choice Text -> Maybe (Choice Text)
forall a. a -> Maybe a
Just (Text -> Text -> Choice Text
forall a. Text -> a -> Choice a
Choice Text
s Text
n)
      extractChoices InternalApplicationCommandOptionChoice
_ = Maybe (Choice Text)
forall a. Maybe a
Nothing
      fromResult :: [a] -> Maybe [a]
fromResult [] = Maybe [a]
forall a. Maybe a
Nothing
      fromResult [a]
is = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
is
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeBoolean, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a. a -> Maybe a
Just (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueBoolean Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeUser, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a. a -> Maybe a
Just (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueUser Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeRole, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a. a -> Maybe a
Just (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueRole Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeMentionable, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a. a -> Maybe a
Just (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Bool -> ApplicationCommandOptionValue
ApplicationCommandOptionValueMentionable Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeChannel, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a. a -> Maybe a
Just (ApplicationCommandOptionValue
 -> Maybe ApplicationCommandOptionValue)
-> ApplicationCommandOptionValue
-> Maybe ApplicationCommandOptionValue
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe Bool
-> Maybe [ApplicationCommandChannelType]
-> ApplicationCommandOptionValue
ApplicationCommandOptionValueChannel Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription Maybe Bool
internalApplicationCommandOptionRequired Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionChannelTypes
  fromInternal InternalApplicationCommandOption
_ = Maybe ApplicationCommandOptionValue
forall a. Maybe a
Nothing

instance Internals ApplicationCommandOptionSubcommand InternalApplicationCommandOption where
  toInternal :: ApplicationCommandOptionSubcommand
-> InternalApplicationCommandOption
toInternal ApplicationCommandOptionSubcommand {[ApplicationCommandOptionValue]
Text
applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandDescription :: Text
applicationCommandOptionSubcommandName :: Text
applicationCommandOptionSubcommandOptions :: ApplicationCommandOptionSubcommand
-> [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandDescription :: ApplicationCommandOptionSubcommand -> Text
applicationCommandOptionSubcommandName :: ApplicationCommandOptionSubcommand -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand Text
applicationCommandOptionSubcommandName Text
applicationCommandOptionSubcommandDescription Maybe Bool
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing ([InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall a. a -> Maybe a
Just ([InternalApplicationCommandOption]
 -> Maybe [InternalApplicationCommandOption])
-> [InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall a b. (a -> b) -> a -> b
$ ApplicationCommandOptionValue -> InternalApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (ApplicationCommandOptionValue -> InternalApplicationCommandOption)
-> [ApplicationCommandOptionValue]
-> [InternalApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ApplicationCommandOptionValue]
applicationCommandOptionSubcommandOptions) Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

  fromInternal :: InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionSubcommand
fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = do
    [ApplicationCommandOptionValue]
os <- Maybe [ApplicationCommandOptionValue]
-> ([InternalApplicationCommandOption]
    -> Maybe [ApplicationCommandOptionValue])
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionValue]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ApplicationCommandOptionValue]
-> Maybe [ApplicationCommandOptionValue]
forall a. a -> Maybe a
Just []) ((InternalApplicationCommandOption
 -> Maybe ApplicationCommandOptionValue)
-> [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionValue
forall a b. Internals a b => b -> Maybe a
fromInternal) Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionOptions
    ApplicationCommandOptionSubcommand
-> Maybe ApplicationCommandOptionSubcommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionSubcommand
 -> Maybe ApplicationCommandOptionSubcommand)
-> ApplicationCommandOptionSubcommand
-> Maybe ApplicationCommandOptionSubcommand
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> [ApplicationCommandOptionValue]
-> ApplicationCommandOptionSubcommand
ApplicationCommandOptionSubcommand Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription [ApplicationCommandOptionValue]
os
  fromInternal InternalApplicationCommandOption
_ = Maybe ApplicationCommandOptionSubcommand
forall a. Maybe a
Nothing

instance Internals ApplicationCommandOptionSubcommandOrGroup InternalApplicationCommandOption where
  toInternal :: ApplicationCommandOptionSubcommandOrGroup
-> InternalApplicationCommandOption
toInternal (ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand
s) = ApplicationCommandOptionSubcommand
-> InternalApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal ApplicationCommandOptionSubcommand
s
  toInternal ApplicationCommandOptionSubcommandGroup {[ApplicationCommandOptionSubcommand]
Text
applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupDescription :: Text
applicationCommandOptionSubcommandGroupName :: Text
applicationCommandOptionSubcommandGroupOptions :: ApplicationCommandOptionSubcommandOrGroup
-> [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupDescription :: ApplicationCommandOptionSubcommandOrGroup -> Text
applicationCommandOptionSubcommandGroupName :: ApplicationCommandOptionSubcommandOrGroup -> Text
..} = ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommandGroup Text
applicationCommandOptionSubcommandGroupName Text
applicationCommandOptionSubcommandGroupDescription Maybe Bool
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOptionChoice]
forall a. Maybe a
Nothing ([InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall a. a -> Maybe a
Just ([InternalApplicationCommandOption]
 -> Maybe [InternalApplicationCommandOption])
-> [InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall a b. (a -> b) -> a -> b
$ ApplicationCommandOptionSubcommand
-> InternalApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (ApplicationCommandOptionSubcommand
 -> InternalApplicationCommandOption)
-> [ApplicationCommandOptionSubcommand]
-> [InternalApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ApplicationCommandOptionSubcommand]
applicationCommandOptionSubcommandGroupOptions) Maybe [ApplicationCommandChannelType]
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Scientific
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

  fromInternal :: InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionSubcommandOrGroup
fromInternal io :: InternalApplicationCommandOption
io@InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = ApplicationCommandOptionSubcommand
-> ApplicationCommandOptionSubcommandOrGroup
ApplicationCommandOptionSubcommandOrGroupSubcommand (ApplicationCommandOptionSubcommand
 -> ApplicationCommandOptionSubcommandOrGroup)
-> Maybe ApplicationCommandOptionSubcommand
-> Maybe ApplicationCommandOptionSubcommandOrGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionSubcommand
forall a b. Internals a b => b -> Maybe a
fromInternal InternalApplicationCommandOption
io
  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType = ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommandGroup, Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
..} = do
    [ApplicationCommandOptionSubcommand]
os <- Maybe [ApplicationCommandOptionSubcommand]
-> ([InternalApplicationCommandOption]
    -> Maybe [ApplicationCommandOptionSubcommand])
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionSubcommand]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ApplicationCommandOptionSubcommand]
-> Maybe [ApplicationCommandOptionSubcommand]
forall a. a -> Maybe a
Just []) ((InternalApplicationCommandOption
 -> Maybe ApplicationCommandOptionSubcommand)
-> [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionSubcommand]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionSubcommand
forall a b. Internals a b => b -> Maybe a
fromInternal) Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionOptions
    ApplicationCommandOptionSubcommandOrGroup
-> Maybe ApplicationCommandOptionSubcommandOrGroup
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionSubcommandOrGroup
 -> Maybe ApplicationCommandOptionSubcommandOrGroup)
-> ApplicationCommandOptionSubcommandOrGroup
-> Maybe ApplicationCommandOptionSubcommandOrGroup
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> [ApplicationCommandOptionSubcommand]
-> ApplicationCommandOptionSubcommandOrGroup
ApplicationCommandOptionSubcommandGroup Text
internalApplicationCommandOptionName Text
internalApplicationCommandOptionDescription [ApplicationCommandOptionSubcommand]
os
  fromInternal InternalApplicationCommandOption
_ = Maybe ApplicationCommandOptionSubcommandOrGroup
forall a. Maybe a
Nothing

instance Internals ApplicationCommandOptions [InternalApplicationCommandOption] where
  toInternal :: ApplicationCommandOptions -> [InternalApplicationCommandOption]
toInternal (ApplicationCommandOptionsSubcommands [ApplicationCommandOptionSubcommandOrGroup]
is) = ApplicationCommandOptionSubcommandOrGroup
-> InternalApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (ApplicationCommandOptionSubcommandOrGroup
 -> InternalApplicationCommandOption)
-> [ApplicationCommandOptionSubcommandOrGroup]
-> [InternalApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ApplicationCommandOptionSubcommandOrGroup]
is
  toInternal (ApplicationCommandOptionsValues [ApplicationCommandOptionValue]
is) = ApplicationCommandOptionValue -> InternalApplicationCommandOption
forall a b. Internals a b => a -> b
toInternal (ApplicationCommandOptionValue -> InternalApplicationCommandOption)
-> [ApplicationCommandOptionValue]
-> [InternalApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ApplicationCommandOptionValue]
is

  fromInternal :: [InternalApplicationCommandOption]
-> Maybe ApplicationCommandOptions
fromInternal [InternalApplicationCommandOption]
is = ([ApplicationCommandOptionSubcommandOrGroup]
-> ApplicationCommandOptions
ApplicationCommandOptionsSubcommands ([ApplicationCommandOptionSubcommandOrGroup]
 -> ApplicationCommandOptions)
-> Maybe [ApplicationCommandOptionSubcommandOrGroup]
-> Maybe ApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalApplicationCommandOption
 -> Maybe ApplicationCommandOptionSubcommandOrGroup)
-> [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionSubcommandOrGroup]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionSubcommandOrGroup
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalApplicationCommandOption]
is) Maybe ApplicationCommandOptions
-> Maybe ApplicationCommandOptions
-> Maybe ApplicationCommandOptions
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([ApplicationCommandOptionValue] -> ApplicationCommandOptions
ApplicationCommandOptionsValues ([ApplicationCommandOptionValue] -> ApplicationCommandOptions)
-> Maybe [ApplicationCommandOptionValue]
-> Maybe ApplicationCommandOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InternalApplicationCommandOption
 -> Maybe ApplicationCommandOptionValue)
-> [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandOptionValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InternalApplicationCommandOption
-> Maybe ApplicationCommandOptionValue
forall a b. Internals a b => b -> Maybe a
fromInternal [InternalApplicationCommandOption]
is)

instance Internals ApplicationCommand InternalApplicationCommand where
  toInternal :: ApplicationCommand -> InternalApplicationCommand
toInternal ApplicationCommandUser {Maybe Bool
Maybe ApplicationCommandId
Text
ApplicationCommandId
applicationCommandVersion :: ApplicationCommandId
applicationCommandDefaultPermission :: Maybe Bool
applicationCommandName :: Text
applicationCommandGuildId :: Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommandId
applicationCommandId :: ApplicationCommandId
applicationCommandVersion :: ApplicationCommand -> ApplicationCommandId
applicationCommandDefaultPermission :: ApplicationCommand -> Maybe Bool
applicationCommandName :: ApplicationCommand -> Text
applicationCommandGuildId :: ApplicationCommand -> Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommand -> ApplicationCommandId
applicationCommandId :: ApplicationCommand -> ApplicationCommandId
..} = ApplicationCommandId
-> Maybe ApplicationCommandType
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> ApplicationCommandId
-> InternalApplicationCommand
InternalApplicationCommand ApplicationCommandId
applicationCommandId (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeUser) ApplicationCommandId
applicationCommandApplicationId Maybe ApplicationCommandId
applicationCommandGuildId Text
applicationCommandName Text
"" Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
applicationCommandDefaultPermission ApplicationCommandId
applicationCommandVersion
  toInternal ApplicationCommandMessage {Maybe Bool
Maybe ApplicationCommandId
Text
ApplicationCommandId
applicationCommandVersion :: ApplicationCommandId
applicationCommandDefaultPermission :: Maybe Bool
applicationCommandName :: Text
applicationCommandGuildId :: Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommandId
applicationCommandId :: ApplicationCommandId
applicationCommandVersion :: ApplicationCommand -> ApplicationCommandId
applicationCommandDefaultPermission :: ApplicationCommand -> Maybe Bool
applicationCommandName :: ApplicationCommand -> Text
applicationCommandGuildId :: ApplicationCommand -> Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommand -> ApplicationCommandId
applicationCommandId :: ApplicationCommand -> ApplicationCommandId
..} = ApplicationCommandId
-> Maybe ApplicationCommandType
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> ApplicationCommandId
-> InternalApplicationCommand
InternalApplicationCommand ApplicationCommandId
applicationCommandId (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeMessage) ApplicationCommandId
applicationCommandApplicationId Maybe ApplicationCommandId
applicationCommandGuildId Text
applicationCommandName Text
"" Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
applicationCommandDefaultPermission ApplicationCommandId
applicationCommandVersion
  toInternal ApplicationCommandChatInput {Maybe Bool
Maybe ApplicationCommandId
Maybe ApplicationCommandOptions
Text
ApplicationCommandId
applicationCommandVersion :: ApplicationCommandId
applicationCommandDefaultPermission :: Maybe Bool
applicationCommandOptions :: Maybe ApplicationCommandOptions
applicationCommandDescription :: Text
applicationCommandName :: Text
applicationCommandGuildId :: Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommandId
applicationCommandId :: ApplicationCommandId
applicationCommandOptions :: ApplicationCommand -> Maybe ApplicationCommandOptions
applicationCommandDescription :: ApplicationCommand -> Text
applicationCommandVersion :: ApplicationCommand -> ApplicationCommandId
applicationCommandDefaultPermission :: ApplicationCommand -> Maybe Bool
applicationCommandName :: ApplicationCommand -> Text
applicationCommandGuildId :: ApplicationCommand -> Maybe ApplicationCommandId
applicationCommandApplicationId :: ApplicationCommand -> ApplicationCommandId
applicationCommandId :: ApplicationCommand -> ApplicationCommandId
..} = ApplicationCommandId
-> Maybe ApplicationCommandType
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> ApplicationCommandId
-> InternalApplicationCommand
InternalApplicationCommand ApplicationCommandId
applicationCommandId (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeChatInput) ApplicationCommandId
applicationCommandApplicationId Maybe ApplicationCommandId
applicationCommandGuildId Text
applicationCommandName Text
applicationCommandDescription (ApplicationCommandOptions -> [InternalApplicationCommandOption]
forall a b. Internals a b => a -> b
toInternal (ApplicationCommandOptions -> [InternalApplicationCommandOption])
-> Maybe ApplicationCommandOptions
-> Maybe [InternalApplicationCommandOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ApplicationCommandOptions
applicationCommandOptions) Maybe Bool
applicationCommandDefaultPermission ApplicationCommandId
applicationCommandVersion
  toInternal (ApplicationCommandUnknown InternalApplicationCommand
ai) = InternalApplicationCommand
ai

  fromInternal :: InternalApplicationCommand -> Maybe ApplicationCommand
fromInternal InternalApplicationCommand {internalApplicationCommandType :: InternalApplicationCommand -> Maybe ApplicationCommandType
internalApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeUser, Maybe Bool
Maybe [InternalApplicationCommandOption]
Maybe ApplicationCommandId
Text
ApplicationCommandId
internalApplicationCommandVersion :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandDefaultPermission :: InternalApplicationCommand -> Maybe Bool
internalApplicationCommandOptions :: InternalApplicationCommand
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: InternalApplicationCommand -> Text
internalApplicationCommandName :: InternalApplicationCommand -> Text
internalApplicationCommandGuildId :: InternalApplicationCommand -> Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandId :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandVersion :: ApplicationCommandId
internalApplicationCommandDefaultPermission :: Maybe Bool
internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: Text
internalApplicationCommandName :: Text
internalApplicationCommandGuildId :: Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: ApplicationCommandId
internalApplicationCommandId :: ApplicationCommandId
..} = ApplicationCommand -> Maybe ApplicationCommand
forall a. a -> Maybe a
Just (ApplicationCommand -> Maybe ApplicationCommand)
-> ApplicationCommand -> Maybe ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Maybe Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandUser ApplicationCommandId
internalApplicationCommandId ApplicationCommandId
internalApplicationCommandApplicationId Maybe ApplicationCommandId
internalApplicationCommandGuildId Text
internalApplicationCommandName Maybe Bool
internalApplicationCommandDefaultPermission ApplicationCommandId
internalApplicationCommandVersion
  fromInternal InternalApplicationCommand {internalApplicationCommandType :: InternalApplicationCommand -> Maybe ApplicationCommandType
internalApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeMessage, Maybe Bool
Maybe [InternalApplicationCommandOption]
Maybe ApplicationCommandId
Text
ApplicationCommandId
internalApplicationCommandVersion :: ApplicationCommandId
internalApplicationCommandDefaultPermission :: Maybe Bool
internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: Text
internalApplicationCommandName :: Text
internalApplicationCommandGuildId :: Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: ApplicationCommandId
internalApplicationCommandId :: ApplicationCommandId
internalApplicationCommandVersion :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandDefaultPermission :: InternalApplicationCommand -> Maybe Bool
internalApplicationCommandOptions :: InternalApplicationCommand
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: InternalApplicationCommand -> Text
internalApplicationCommandName :: InternalApplicationCommand -> Text
internalApplicationCommandGuildId :: InternalApplicationCommand -> Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandId :: InternalApplicationCommand -> ApplicationCommandId
..} = ApplicationCommand -> Maybe ApplicationCommand
forall a. a -> Maybe a
Just (ApplicationCommand -> Maybe ApplicationCommand)
-> ApplicationCommand -> Maybe ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Maybe Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandMessage ApplicationCommandId
internalApplicationCommandId ApplicationCommandId
internalApplicationCommandApplicationId Maybe ApplicationCommandId
internalApplicationCommandGuildId Text
internalApplicationCommandName Maybe Bool
internalApplicationCommandDefaultPermission ApplicationCommandId
internalApplicationCommandVersion
  fromInternal a :: InternalApplicationCommand
a@InternalApplicationCommand {internalApplicationCommandType :: InternalApplicationCommand -> Maybe ApplicationCommandType
internalApplicationCommandType = Just ApplicationCommandType
ApplicationCommandTypeChatInput, Maybe Bool
Maybe [InternalApplicationCommandOption]
Maybe ApplicationCommandId
Text
ApplicationCommandId
internalApplicationCommandVersion :: ApplicationCommandId
internalApplicationCommandDefaultPermission :: Maybe Bool
internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: Text
internalApplicationCommandName :: Text
internalApplicationCommandGuildId :: Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: ApplicationCommandId
internalApplicationCommandId :: ApplicationCommandId
internalApplicationCommandVersion :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandDefaultPermission :: InternalApplicationCommand -> Maybe Bool
internalApplicationCommandOptions :: InternalApplicationCommand
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandDescription :: InternalApplicationCommand -> Text
internalApplicationCommandName :: InternalApplicationCommand -> Text
internalApplicationCommandGuildId :: InternalApplicationCommand -> Maybe ApplicationCommandId
internalApplicationCommandApplicationId :: InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandId :: InternalApplicationCommand -> ApplicationCommandId
..} = ApplicationCommand -> Maybe ApplicationCommand
forall a. a -> Maybe a
Just (ApplicationCommand -> Maybe ApplicationCommand)
-> ApplicationCommand -> Maybe ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommand
-> Maybe ApplicationCommand -> ApplicationCommand
forall a. a -> Maybe a -> a
fromMaybe (InternalApplicationCommand -> ApplicationCommand
ApplicationCommandUnknown InternalApplicationCommand
a) (Maybe ApplicationCommand -> ApplicationCommand)
-> Maybe ApplicationCommand -> ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ((Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptions Maybe [InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [InternalApplicationCommandOption]
-> Maybe [InternalApplicationCommandOption]
forall a. a -> Maybe a
Just []) Maybe [InternalApplicationCommandOption]
-> ([InternalApplicationCommandOption]
    -> Maybe ApplicationCommandOptions)
-> Maybe ApplicationCommandOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [InternalApplicationCommandOption]
-> Maybe ApplicationCommandOptions
forall a b. Internals a b => b -> Maybe a
fromInternal) Maybe ApplicationCommandOptions
-> (ApplicationCommandOptions -> Maybe ApplicationCommand)
-> Maybe ApplicationCommand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ApplicationCommandOptions
iOptions -> ApplicationCommand -> Maybe ApplicationCommand
forall a. a -> Maybe a
Just (ApplicationCommand -> Maybe ApplicationCommand)
-> ApplicationCommand -> Maybe ApplicationCommand
forall a b. (a -> b) -> a -> b
$ ApplicationCommandId
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe ApplicationCommandOptions
-> Maybe Bool
-> ApplicationCommandId
-> ApplicationCommand
ApplicationCommandChatInput ApplicationCommandId
internalApplicationCommandId ApplicationCommandId
internalApplicationCommandApplicationId Maybe ApplicationCommandId
internalApplicationCommandGuildId Text
internalApplicationCommandName Text
internalApplicationCommandDescription (ApplicationCommandOptions -> Maybe ApplicationCommandOptions
forall a. a -> Maybe a
Just ApplicationCommandOptions
iOptions) Maybe Bool
internalApplicationCommandDefaultPermission ApplicationCommandId
internalApplicationCommandVersion
  fromInternal InternalApplicationCommand
a = InternalApplicationCommand -> Maybe ApplicationCommand
forall a b. Internals a b => b -> Maybe a
fromInternal (InternalApplicationCommand
a {internalApplicationCommandType :: Maybe ApplicationCommandType
internalApplicationCommandType = ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeChatInput})

-- Just $ ApplicationCommandMessage internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion

-- | What type of application command. Represents slash commands, right clicking
-- a user, and right clicking a message respectively.
data ApplicationCommandType
  = -- | Slash commands
    ApplicationCommandTypeChatInput
  | -- | User commands
    ApplicationCommandTypeUser
  | -- | Message commands
    ApplicationCommandTypeMessage
  deriving (Int -> ApplicationCommandType -> ShowS
[ApplicationCommandType] -> ShowS
ApplicationCommandType -> String
(Int -> ApplicationCommandType -> ShowS)
-> (ApplicationCommandType -> String)
-> ([ApplicationCommandType] -> ShowS)
-> Show ApplicationCommandType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandType] -> ShowS
$cshowList :: [ApplicationCommandType] -> ShowS
show :: ApplicationCommandType -> String
$cshow :: ApplicationCommandType -> String
showsPrec :: Int -> ApplicationCommandType -> ShowS
$cshowsPrec :: Int -> ApplicationCommandType -> ShowS
Show, ReadPrec [ApplicationCommandType]
ReadPrec ApplicationCommandType
Int -> ReadS ApplicationCommandType
ReadS [ApplicationCommandType]
(Int -> ReadS ApplicationCommandType)
-> ReadS [ApplicationCommandType]
-> ReadPrec ApplicationCommandType
-> ReadPrec [ApplicationCommandType]
-> Read ApplicationCommandType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandType]
$creadListPrec :: ReadPrec [ApplicationCommandType]
readPrec :: ReadPrec ApplicationCommandType
$creadPrec :: ReadPrec ApplicationCommandType
readList :: ReadS [ApplicationCommandType]
$creadList :: ReadS [ApplicationCommandType]
readsPrec :: Int -> ReadS ApplicationCommandType
$creadsPrec :: Int -> ReadS ApplicationCommandType
Read, Typeable ApplicationCommandType
DataType
Constr
Typeable ApplicationCommandType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ApplicationCommandType
    -> c ApplicationCommandType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ApplicationCommandType)
-> (ApplicationCommandType -> Constr)
-> (ApplicationCommandType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ApplicationCommandType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApplicationCommandType))
-> ((forall b. Data b => b -> b)
    -> ApplicationCommandType -> ApplicationCommandType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ApplicationCommandType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ApplicationCommandType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandType -> m ApplicationCommandType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandType -> m ApplicationCommandType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandType -> m ApplicationCommandType)
-> Data ApplicationCommandType
ApplicationCommandType -> DataType
ApplicationCommandType -> Constr
(forall b. Data b => b -> b)
-> ApplicationCommandType -> ApplicationCommandType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandType
-> c ApplicationCommandType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandType
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) -> ApplicationCommandType -> u
forall u.
(forall d. Data d => d -> u) -> ApplicationCommandType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandType
-> c ApplicationCommandType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApplicationCommandType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandType)
$cApplicationCommandTypeMessage :: Constr
$cApplicationCommandTypeUser :: Constr
$cApplicationCommandTypeChatInput :: Constr
$tApplicationCommandType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
gmapMp :: (forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
gmapM :: (forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandType -> m ApplicationCommandType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ApplicationCommandType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ApplicationCommandType -> u
gmapQ :: (forall d. Data d => d -> u) -> ApplicationCommandType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplicationCommandType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandType
-> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandType -> ApplicationCommandType
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandType -> ApplicationCommandType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ApplicationCommandType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApplicationCommandType)
dataTypeOf :: ApplicationCommandType -> DataType
$cdataTypeOf :: ApplicationCommandType -> DataType
toConstr :: ApplicationCommandType -> Constr
$ctoConstr :: ApplicationCommandType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandType
-> c ApplicationCommandType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandType
-> c ApplicationCommandType
$cp1Data :: Typeable ApplicationCommandType
Data, ApplicationCommandType -> ApplicationCommandType -> Bool
(ApplicationCommandType -> ApplicationCommandType -> Bool)
-> (ApplicationCommandType -> ApplicationCommandType -> Bool)
-> Eq ApplicationCommandType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandType -> ApplicationCommandType -> Bool
$c/= :: ApplicationCommandType -> ApplicationCommandType -> Bool
== :: ApplicationCommandType -> ApplicationCommandType -> Bool
$c== :: ApplicationCommandType -> ApplicationCommandType -> Bool
Eq)

instance Enum ApplicationCommandType where
  fromEnum :: ApplicationCommandType -> Int
fromEnum ApplicationCommandType
ApplicationCommandTypeChatInput = Int
1
  fromEnum ApplicationCommandType
ApplicationCommandTypeUser = Int
2
  fromEnum ApplicationCommandType
ApplicationCommandTypeMessage = Int
3
  toEnum :: Int -> ApplicationCommandType
toEnum Int
a = Maybe ApplicationCommandType -> ApplicationCommandType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ApplicationCommandType -> ApplicationCommandType)
-> Maybe ApplicationCommandType -> ApplicationCommandType
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, ApplicationCommandType)] -> Maybe ApplicationCommandType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, ApplicationCommandType)]
table
    where
      table :: [(Int, ApplicationCommandType)]
table = ApplicationCommandType -> [(Int, ApplicationCommandType)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable ApplicationCommandType
ApplicationCommandTypeChatInput

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

instance FromJSON ApplicationCommandType where
  parseJSON :: Value -> Parser ApplicationCommandType
parseJSON = String
-> (Scientific -> Parser ApplicationCommandType)
-> Value
-> Parser ApplicationCommandType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ApplicationCommandType" (ApplicationCommandType -> Parser ApplicationCommandType
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandType -> Parser ApplicationCommandType)
-> (Scientific -> ApplicationCommandType)
-> Scientific
-> Parser ApplicationCommandType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplicationCommandType
forall a. Enum a => Int -> a
toEnum (Int -> ApplicationCommandType)
-> (Scientific -> Int) -> Scientific -> ApplicationCommandType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round)

-- | Data type to be used when creating application commands. The specification
-- is below.
--
-- If a command of the same type and and name is sent to the server, it will
-- overwrite any command that already exists in the same scope (guild vs
-- global).
--
-- The description has to be empty for non-slash command application
-- commands, as do the options. The options need to be `Nothing` for non-slash
-- commands, too. If one of the options is a subcommand or subcommand group,
-- the base command will no longer be usable.
--
-- A subcommand group can have subcommands within it. This is the maximum amount
-- of command nesting permitted.
--
-- https://discord.com/developers/docs/interactions/application-commands#create-global-application-command
data CreateApplicationCommand = CreateApplicationCommand
  { -- | The application command name (1-32 chars).
    CreateApplicationCommand -> Text
createApplicationCommandName :: T.Text,
    -- | The application command description (1-100 chars). Has to be empty for
    -- non-slash commands.
    CreateApplicationCommand -> Text
createApplicationCommandDescription :: T.Text,
    -- | What options the application (max length 25). Has to be `Nothing` for
    -- non-slash commands.
    CreateApplicationCommand
-> Maybe [InternalApplicationCommandOption]
createApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],
    -- | Whether the command is enabled by default when the application is added
    -- to a guild. Defaults to true if not present
    CreateApplicationCommand -> Maybe Bool
createApplicationCommandDefaultPermission :: Maybe Bool,
    -- | What the type of the command is. If `Nothing`, defaults to slash
    -- commands.
    CreateApplicationCommand -> Maybe ApplicationCommandType
createApplicationCommandType :: Maybe ApplicationCommandType
  }
  deriving (Int -> CreateApplicationCommand -> ShowS
[CreateApplicationCommand] -> ShowS
CreateApplicationCommand -> String
(Int -> CreateApplicationCommand -> ShowS)
-> (CreateApplicationCommand -> String)
-> ([CreateApplicationCommand] -> ShowS)
-> Show CreateApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApplicationCommand] -> ShowS
$cshowList :: [CreateApplicationCommand] -> ShowS
show :: CreateApplicationCommand -> String
$cshow :: CreateApplicationCommand -> String
showsPrec :: Int -> CreateApplicationCommand -> ShowS
$cshowsPrec :: Int -> CreateApplicationCommand -> ShowS
Show, CreateApplicationCommand -> CreateApplicationCommand -> Bool
(CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> (CreateApplicationCommand -> CreateApplicationCommand -> Bool)
-> Eq CreateApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
$c/= :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
$c== :: CreateApplicationCommand -> CreateApplicationCommand -> Bool
Eq, ReadPrec [CreateApplicationCommand]
ReadPrec CreateApplicationCommand
Int -> ReadS CreateApplicationCommand
ReadS [CreateApplicationCommand]
(Int -> ReadS CreateApplicationCommand)
-> ReadS [CreateApplicationCommand]
-> ReadPrec CreateApplicationCommand
-> ReadPrec [CreateApplicationCommand]
-> Read CreateApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApplicationCommand]
$creadListPrec :: ReadPrec [CreateApplicationCommand]
readPrec :: ReadPrec CreateApplicationCommand
$creadPrec :: ReadPrec CreateApplicationCommand
readList :: ReadS [CreateApplicationCommand]
$creadList :: ReadS [CreateApplicationCommand]
readsPrec :: Int -> ReadS CreateApplicationCommand
$creadsPrec :: Int -> ReadS CreateApplicationCommand
Read)

instance ToJSON CreateApplicationCommand where
  toJSON :: CreateApplicationCommand -> Value
toJSON CreateApplicationCommand {Maybe Bool
Maybe [InternalApplicationCommandOption]
Maybe ApplicationCommandType
Text
createApplicationCommandType :: Maybe ApplicationCommandType
createApplicationCommandDefaultPermission :: Maybe Bool
createApplicationCommandOptions :: Maybe [InternalApplicationCommandOption]
createApplicationCommandDescription :: Text
createApplicationCommandName :: Text
createApplicationCommandType :: CreateApplicationCommand -> Maybe ApplicationCommandType
createApplicationCommandDefaultPermission :: CreateApplicationCommand -> Maybe Bool
createApplicationCommandOptions :: CreateApplicationCommand
-> Maybe [InternalApplicationCommandOption]
createApplicationCommandDescription :: CreateApplicationCommand -> Text
createApplicationCommandName :: CreateApplicationCommand -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandName),
              (Key
"description", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
createApplicationCommandDescription),
              (Key
"options", [InternalApplicationCommandOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalApplicationCommandOption] -> Value)
-> Maybe [InternalApplicationCommandOption] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalApplicationCommandOption]
createApplicationCommandOptions),
              (Key
"default_permission", 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
createApplicationCommandDefaultPermission),
              (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
createApplicationCommandType)
            ]
      ]

-- | Create the basics for a chat input (slash command). Use record overwriting
-- to enter the other values. The name needs to be all lower case letters, and
-- between 1 and 32 characters. The description has to be non-empty and less
-- than or equal to 100 characters.
createApplicationCommandChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand
createApplicationCommandChatInput :: Text -> Text -> Maybe CreateApplicationCommand
createApplicationCommandChatInput Text
name Text
desc
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
name Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
desc) Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 Bool -> Bool -> Bool
&& Text -> Int
T.length Text
desc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> Maybe ApplicationCommandType
-> CreateApplicationCommand
CreateApplicationCommand Text
name Text
desc Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeChatInput)
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing
  where
    l :: Int
l = Text -> Int
T.length Text
name

-- | Create the basics for a user command. Use record overwriting to enter the
-- other values. The name needs to be between 1 and 32 characters.
createApplicationCommandUser :: T.Text -> Maybe CreateApplicationCommand
createApplicationCommandUser :: Text -> Maybe CreateApplicationCommand
createApplicationCommandUser Text
name
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> Maybe ApplicationCommandType
-> CreateApplicationCommand
CreateApplicationCommand Text
name Text
"" Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeUser)
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing
  where
    l :: Int
l = Text -> Int
T.length Text
name

-- | Create the basics for a message command. Use record overwriting to enter
-- the other values. The name needs to be between 1 and 32 characters.
createApplicationCommandMessage :: T.Text -> Maybe CreateApplicationCommand
createApplicationCommandMessage :: Text -> Maybe CreateApplicationCommand
createApplicationCommandMessage Text
name
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a. a -> Maybe a
Just (CreateApplicationCommand -> Maybe CreateApplicationCommand)
-> CreateApplicationCommand -> Maybe CreateApplicationCommand
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> Maybe ApplicationCommandType
-> CreateApplicationCommand
CreateApplicationCommand Text
name Text
"" Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing (ApplicationCommandType -> Maybe ApplicationCommandType
forall a. a -> Maybe a
Just ApplicationCommandType
ApplicationCommandTypeMessage)
  | Bool
otherwise = Maybe CreateApplicationCommand
forall a. Maybe a
Nothing
  where
    l :: Int
l = Text -> Int
T.length Text
name

-- | Data type to be used when editing application commands. The specification
-- is below. See `CreateApplicationCommand` for an explanation for the
-- parameters.
--
-- https://discord.com/developers/docs/interactions/application-commands#edit-global-application-command
data EditApplicationCommand = EditApplicationCommand
  { EditApplicationCommand -> Maybe Text
editApplicationCommandName :: Maybe T.Text,
    EditApplicationCommand -> Maybe Text
editApplicationCommandDescription :: Maybe T.Text,
    EditApplicationCommand -> Maybe [InternalApplicationCommandOption]
editApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],
    EditApplicationCommand -> Maybe Bool
editApplicationCommandDefaultPermission :: Maybe Bool,
    EditApplicationCommand -> Maybe ApplicationCommandType
editApplicationCommandType :: Maybe ApplicationCommandType
  }

instance Default EditApplicationCommand where
  def :: EditApplicationCommand
def = Maybe Text
-> Maybe Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> Maybe ApplicationCommandType
-> EditApplicationCommand
EditApplicationCommand Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [InternalApplicationCommandOption]
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe ApplicationCommandType
forall a. Maybe a
Nothing

instance ToJSON EditApplicationCommand where
  toJSON :: EditApplicationCommand -> Value
toJSON EditApplicationCommand {Maybe Bool
Maybe [InternalApplicationCommandOption]
Maybe Text
Maybe ApplicationCommandType
editApplicationCommandType :: Maybe ApplicationCommandType
editApplicationCommandDefaultPermission :: Maybe Bool
editApplicationCommandOptions :: Maybe [InternalApplicationCommandOption]
editApplicationCommandDescription :: Maybe Text
editApplicationCommandName :: Maybe Text
editApplicationCommandType :: EditApplicationCommand -> Maybe ApplicationCommandType
editApplicationCommandDefaultPermission :: EditApplicationCommand -> Maybe Bool
editApplicationCommandOptions :: EditApplicationCommand -> Maybe [InternalApplicationCommandOption]
editApplicationCommandDescription :: EditApplicationCommand -> Maybe Text
editApplicationCommandName :: EditApplicationCommand -> Maybe Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
editApplicationCommandName),
              (Key
"description", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
editApplicationCommandDescription),
              (Key
"options", [InternalApplicationCommandOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalApplicationCommandOption] -> Value)
-> Maybe [InternalApplicationCommandOption] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalApplicationCommandOption]
editApplicationCommandOptions),
              (Key
"default_permission", 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
editApplicationCommandDefaultPermission),
              (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
editApplicationCommandType)
            ]
      ]

-- | The full information about an application command, obtainable with the
-- various get requests. In theory, you never need to construct one of these -
-- so if you are, reconsider what you're doing.
--
-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-structure
data InternalApplicationCommand = InternalApplicationCommand
  { -- | Unique id of the command.
    InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandId :: ApplicationCommandId,
    -- | The type of the command.
    InternalApplicationCommand -> Maybe ApplicationCommandType
internalApplicationCommandType :: Maybe ApplicationCommandType,
    -- | Unique id of the parent application (the bot).
    InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandApplicationId :: ApplicationId,
    -- | The guild id of the command if not global.
    InternalApplicationCommand -> Maybe ApplicationCommandId
internalApplicationCommandGuildId :: Maybe GuildId,
    -- | Must be 1-32 characters.
    InternalApplicationCommand -> Text
internalApplicationCommandName :: T.Text,
    -- | Must be empty for USER and MESSAGE commands, otherwise 1-100 chars.
    InternalApplicationCommand -> Text
internalApplicationCommandDescription :: T.Text,
    -- | CHAT_INPUT only, parameters to command
    InternalApplicationCommand
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],
    -- | whether the command is enabled by default when the app is added to a
    -- guild. Defaults to true.
    InternalApplicationCommand -> Maybe Bool
internalApplicationCommandDefaultPermission :: Maybe Bool,
    InternalApplicationCommand -> ApplicationCommandId
internalApplicationCommandVersion :: Snowflake
  }
  deriving (Int -> InternalApplicationCommand -> ShowS
[InternalApplicationCommand] -> ShowS
InternalApplicationCommand -> String
(Int -> InternalApplicationCommand -> ShowS)
-> (InternalApplicationCommand -> String)
-> ([InternalApplicationCommand] -> ShowS)
-> Show InternalApplicationCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalApplicationCommand] -> ShowS
$cshowList :: [InternalApplicationCommand] -> ShowS
show :: InternalApplicationCommand -> String
$cshow :: InternalApplicationCommand -> String
showsPrec :: Int -> InternalApplicationCommand -> ShowS
$cshowsPrec :: Int -> InternalApplicationCommand -> ShowS
Show, InternalApplicationCommand -> InternalApplicationCommand -> Bool
(InternalApplicationCommand -> InternalApplicationCommand -> Bool)
-> (InternalApplicationCommand
    -> InternalApplicationCommand -> Bool)
-> Eq InternalApplicationCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalApplicationCommand -> InternalApplicationCommand -> Bool
$c/= :: InternalApplicationCommand -> InternalApplicationCommand -> Bool
== :: InternalApplicationCommand -> InternalApplicationCommand -> Bool
$c== :: InternalApplicationCommand -> InternalApplicationCommand -> Bool
Eq, ReadPrec [InternalApplicationCommand]
ReadPrec InternalApplicationCommand
Int -> ReadS InternalApplicationCommand
ReadS [InternalApplicationCommand]
(Int -> ReadS InternalApplicationCommand)
-> ReadS [InternalApplicationCommand]
-> ReadPrec InternalApplicationCommand
-> ReadPrec [InternalApplicationCommand]
-> Read InternalApplicationCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalApplicationCommand]
$creadListPrec :: ReadPrec [InternalApplicationCommand]
readPrec :: ReadPrec InternalApplicationCommand
$creadPrec :: ReadPrec InternalApplicationCommand
readList :: ReadS [InternalApplicationCommand]
$creadList :: ReadS [InternalApplicationCommand]
readsPrec :: Int -> ReadS InternalApplicationCommand
$creadsPrec :: Int -> ReadS InternalApplicationCommand
Read)

instance FromJSON InternalApplicationCommand where
  parseJSON :: Value -> Parser InternalApplicationCommand
parseJSON =
    String
-> (Object -> Parser InternalApplicationCommand)
-> Value
-> Parser InternalApplicationCommand
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InternalApplicationCommand"
      ( \Object
v ->
          ApplicationCommandId
-> Maybe ApplicationCommandType
-> ApplicationCommandId
-> Maybe ApplicationCommandId
-> Text
-> Text
-> Maybe [InternalApplicationCommandOption]
-> Maybe Bool
-> ApplicationCommandId
-> InternalApplicationCommand
InternalApplicationCommand
            (ApplicationCommandId
 -> Maybe ApplicationCommandType
 -> ApplicationCommandId
 -> Maybe ApplicationCommandId
 -> Text
 -> Text
 -> Maybe [InternalApplicationCommandOption]
 -> Maybe Bool
 -> ApplicationCommandId
 -> InternalApplicationCommand)
-> Parser ApplicationCommandId
-> Parser
     (Maybe ApplicationCommandType
      -> ApplicationCommandId
      -> Maybe ApplicationCommandId
      -> Text
      -> Text
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (Maybe ApplicationCommandType
   -> ApplicationCommandId
   -> Maybe ApplicationCommandId
   -> Text
   -> Text
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser (Maybe ApplicationCommandType)
-> Parser
     (ApplicationCommandId
      -> Maybe ApplicationCommandId
      -> Text
      -> Text
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
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
  (ApplicationCommandId
   -> Maybe ApplicationCommandId
   -> Text
   -> Text
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser ApplicationCommandId
-> Parser
     (Maybe ApplicationCommandId
      -> Text
      -> Text
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
            Parser
  (Maybe ApplicationCommandId
   -> Text
   -> Text
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser (Maybe ApplicationCommandId)
-> Parser
     (Text
      -> Text
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe ApplicationCommandId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"guild_id"
            Parser
  (Text
   -> Text
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser Text
-> Parser
     (Text
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser
  (Text
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser Text
-> Parser
     (Maybe [InternalApplicationCommandOption]
      -> Maybe Bool
      -> ApplicationCommandId
      -> InternalApplicationCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
            Parser
  (Maybe [InternalApplicationCommandOption]
   -> Maybe Bool
   -> ApplicationCommandId
   -> InternalApplicationCommand)
-> Parser (Maybe [InternalApplicationCommandOption])
-> Parser
     (Maybe Bool -> ApplicationCommandId -> InternalApplicationCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [InternalApplicationCommandOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Parser
  (Maybe Bool -> ApplicationCommandId -> InternalApplicationCommand)
-> Parser (Maybe Bool)
-> Parser (ApplicationCommandId -> InternalApplicationCommand)
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
"default_permission"
            Parser (ApplicationCommandId -> InternalApplicationCommand)
-> Parser ApplicationCommandId -> Parser InternalApplicationCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
      )

-- | This is the structure that designates different options for slash commands.
--
-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-structure
data InternalApplicationCommandOption = InternalApplicationCommandOption
  { -- | What the type of this option is.
    InternalApplicationCommandOption -> ApplicationCommandOptionType
internalApplicationCommandOptionType :: ApplicationCommandOptionType,
    -- | The name of the option . 1-32 characters
    InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: T.Text,
    -- | 1-100 characters
    InternalApplicationCommandOption -> Text
internalApplicationCommandOptionDescription :: T.Text,
    -- | Is the parameter required? default false
    InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionRequired :: Maybe Bool,
    -- | If specified, these are the only valid options to choose from. Type
    -- depends on optionType, and can only be specified for STRING, INTEGER or
    -- NUMBER types.
    InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice],
    -- | If the option type is a subcommand or subcommand group type, these are
    -- the parameters to the subcommand.
    InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption],
    -- | If option is channel type, these are the only channel types allowed.
    InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType],
    -- | If option is number type, minimum value for the number
    InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific,
    -- | if option is number type, maximum value for the number
    InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMaxVal :: Maybe Scientific,
    -- | Enable auto complete interactions. may not be set to true if choices is present.
    InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionAutocomplete :: Maybe Bool
  }
  deriving (Int -> InternalApplicationCommandOption -> ShowS
[InternalApplicationCommandOption] -> ShowS
InternalApplicationCommandOption -> String
(Int -> InternalApplicationCommandOption -> ShowS)
-> (InternalApplicationCommandOption -> String)
-> ([InternalApplicationCommandOption] -> ShowS)
-> Show InternalApplicationCommandOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalApplicationCommandOption] -> ShowS
$cshowList :: [InternalApplicationCommandOption] -> ShowS
show :: InternalApplicationCommandOption -> String
$cshow :: InternalApplicationCommandOption -> String
showsPrec :: Int -> InternalApplicationCommandOption -> ShowS
$cshowsPrec :: Int -> InternalApplicationCommandOption -> ShowS
Show, InternalApplicationCommandOption
-> InternalApplicationCommandOption -> Bool
(InternalApplicationCommandOption
 -> InternalApplicationCommandOption -> Bool)
-> (InternalApplicationCommandOption
    -> InternalApplicationCommandOption -> Bool)
-> Eq InternalApplicationCommandOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalApplicationCommandOption
-> InternalApplicationCommandOption -> Bool
$c/= :: InternalApplicationCommandOption
-> InternalApplicationCommandOption -> Bool
== :: InternalApplicationCommandOption
-> InternalApplicationCommandOption -> Bool
$c== :: InternalApplicationCommandOption
-> InternalApplicationCommandOption -> Bool
Eq, ReadPrec [InternalApplicationCommandOption]
ReadPrec InternalApplicationCommandOption
Int -> ReadS InternalApplicationCommandOption
ReadS [InternalApplicationCommandOption]
(Int -> ReadS InternalApplicationCommandOption)
-> ReadS [InternalApplicationCommandOption]
-> ReadPrec InternalApplicationCommandOption
-> ReadPrec [InternalApplicationCommandOption]
-> Read InternalApplicationCommandOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalApplicationCommandOption]
$creadListPrec :: ReadPrec [InternalApplicationCommandOption]
readPrec :: ReadPrec InternalApplicationCommandOption
$creadPrec :: ReadPrec InternalApplicationCommandOption
readList :: ReadS [InternalApplicationCommandOption]
$creadList :: ReadS [InternalApplicationCommandOption]
readsPrec :: Int -> ReadS InternalApplicationCommandOption
$creadsPrec :: Int -> ReadS InternalApplicationCommandOption
Read)

instance ToJSON InternalApplicationCommandOption where
  toJSON :: InternalApplicationCommandOption -> Value
toJSON InternalApplicationCommandOption {Maybe Bool
Maybe [ApplicationCommandChannelType]
Maybe [InternalApplicationCommandOptionChoice]
Maybe [InternalApplicationCommandOption]
Maybe Scientific
Text
ApplicationCommandOptionType
internalApplicationCommandOptionAutocomplete :: Maybe Bool
internalApplicationCommandOptionMaxVal :: Maybe Scientific
internalApplicationCommandOptionMinVal :: Maybe Scientific
internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: Maybe Bool
internalApplicationCommandOptionDescription :: Text
internalApplicationCommandOptionName :: Text
internalApplicationCommandOptionType :: ApplicationCommandOptionType
internalApplicationCommandOptionAutocomplete :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionMaxVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionMinVal :: InternalApplicationCommandOption -> Maybe Scientific
internalApplicationCommandOptionChannelTypes :: InternalApplicationCommandOption
-> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionOptions :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionChoices :: InternalApplicationCommandOption
-> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionRequired :: InternalApplicationCommandOption -> Maybe Bool
internalApplicationCommandOptionDescription :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionName :: InternalApplicationCommandOption -> Text
internalApplicationCommandOptionType :: InternalApplicationCommandOption -> ApplicationCommandOptionType
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", ApplicationCommandOptionType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandOptionType
internalApplicationCommandOptionType),
              (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
internalApplicationCommandOptionName),
              (Key
"description", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
internalApplicationCommandOptionDescription),
              (Key
"required", 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
internalApplicationCommandOptionRequired),
              (Key
"choices", [InternalApplicationCommandOptionChoice] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalApplicationCommandOptionChoice] -> Value)
-> Maybe [InternalApplicationCommandOptionChoice] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalApplicationCommandOptionChoice]
internalApplicationCommandOptionChoices),
              (Key
"options", [InternalApplicationCommandOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InternalApplicationCommandOption] -> Value)
-> Maybe [InternalApplicationCommandOption] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [InternalApplicationCommandOption]
internalApplicationCommandOptionOptions),
              (Key
"channel_types", [ApplicationCommandChannelType] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ApplicationCommandChannelType] -> Value)
-> Maybe [ApplicationCommandChannelType] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [ApplicationCommandChannelType]
internalApplicationCommandOptionChannelTypes),
              (Key
"min_val", Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
internalApplicationCommandOptionMinVal),
              (Key
"max_val", Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (Scientific -> Value) -> Maybe Scientific -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Scientific
internalApplicationCommandOptionMaxVal),
              (Key
"autocomplete", 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
internalApplicationCommandOptionAutocomplete)
            ]
      ]

instance FromJSON InternalApplicationCommandOption where
  parseJSON :: Value -> Parser InternalApplicationCommandOption
parseJSON =
    String
-> (Object -> Parser InternalApplicationCommandOption)
-> Value
-> Parser InternalApplicationCommandOption
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"InternalApplicationCommandOption"
      ( \Object
v ->
          ApplicationCommandOptionType
-> Text
-> Text
-> Maybe Bool
-> Maybe [InternalApplicationCommandOptionChoice]
-> Maybe [InternalApplicationCommandOption]
-> Maybe [ApplicationCommandChannelType]
-> Maybe Scientific
-> Maybe Scientific
-> Maybe Bool
-> InternalApplicationCommandOption
InternalApplicationCommandOption
            (ApplicationCommandOptionType
 -> Text
 -> Text
 -> Maybe Bool
 -> Maybe [InternalApplicationCommandOptionChoice]
 -> Maybe [InternalApplicationCommandOption]
 -> Maybe [ApplicationCommandChannelType]
 -> Maybe Scientific
 -> Maybe Scientific
 -> Maybe Bool
 -> InternalApplicationCommandOption)
-> Parser ApplicationCommandOptionType
-> Parser
     (Text
      -> Text
      -> Maybe Bool
      -> Maybe [InternalApplicationCommandOptionChoice]
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandOptionType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser
  (Text
   -> Text
   -> Maybe Bool
   -> Maybe [InternalApplicationCommandOptionChoice]
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser Text
-> Parser
     (Text
      -> Maybe Bool
      -> Maybe [InternalApplicationCommandOptionChoice]
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser
  (Text
   -> Maybe Bool
   -> Maybe [InternalApplicationCommandOptionChoice]
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Maybe [InternalApplicationCommandOptionChoice]
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
            Parser
  (Maybe Bool
   -> Maybe [InternalApplicationCommandOptionChoice]
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [InternalApplicationCommandOptionChoice]
      -> Maybe [InternalApplicationCommandOption]
      -> Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
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
"required"
            Parser
  (Maybe [InternalApplicationCommandOptionChoice]
   -> Maybe [InternalApplicationCommandOption]
   -> Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser (Maybe [InternalApplicationCommandOptionChoice])
-> Parser
     (Maybe [InternalApplicationCommandOption]
      -> Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object
-> Key -> Parser (Maybe [InternalApplicationCommandOptionChoice])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"choices"
            Parser
  (Maybe [InternalApplicationCommandOption]
   -> Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser (Maybe [InternalApplicationCommandOption])
-> Parser
     (Maybe [ApplicationCommandChannelType]
      -> Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [InternalApplicationCommandOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
            Parser
  (Maybe [ApplicationCommandChannelType]
   -> Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser (Maybe [ApplicationCommandChannelType])
-> Parser
     (Maybe Scientific
      -> Maybe Scientific
      -> Maybe Bool
      -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [ApplicationCommandChannelType])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"channel_types"
            Parser
  (Maybe Scientific
   -> Maybe Scientific
   -> Maybe Bool
   -> InternalApplicationCommandOption)
-> Parser (Maybe Scientific)
-> Parser
     (Maybe Scientific
      -> Maybe Bool -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_val"
            Parser
  (Maybe Scientific
   -> Maybe Bool -> InternalApplicationCommandOption)
-> Parser (Maybe Scientific)
-> Parser (Maybe Bool -> InternalApplicationCommandOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Scientific)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_val"
            Parser (Maybe Bool -> InternalApplicationCommandOption)
-> Parser (Maybe Bool) -> Parser InternalApplicationCommandOption
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
"autocomplete"
      )

-- | What type of command option. Can represent a wide variety of types, so
-- please check out the documentation below.
--
-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-type
data ApplicationCommandOptionType
  = -- | A subcommand. It can take further options, excluding sub commands and
    -- sub command groups.
    ApplicationCommandOptionTypeSubcommand
  | -- | A subcommand group. It can take further options, excluding sub command
    -- groups.
    ApplicationCommandOptionTypeSubcommandGroup
  | -- | Can typically be provided with default values.
    ApplicationCommandOptionTypeString
  | -- | Can typically be provided with default values, and possibly with
    -- minimum and maximum values.
    ApplicationCommandOptionTypeInteger
  | ApplicationCommandOptionTypeBoolean
  | ApplicationCommandOptionTypeUser
  | -- | Can be limited in the types of the channel allowed.
    ApplicationCommandOptionTypeChannel
  | ApplicationCommandOptionTypeRole
  | -- | Users and roles.
    ApplicationCommandOptionTypeMentionable
  | -- | Can typically be provided with default values, and possibly with
    -- minimum and maximum values. Represents a double.
    ApplicationCommandOptionTypeNumber
  deriving (Int -> ApplicationCommandOptionType -> ShowS
[ApplicationCommandOptionType] -> ShowS
ApplicationCommandOptionType -> String
(Int -> ApplicationCommandOptionType -> ShowS)
-> (ApplicationCommandOptionType -> String)
-> ([ApplicationCommandOptionType] -> ShowS)
-> Show ApplicationCommandOptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandOptionType] -> ShowS
$cshowList :: [ApplicationCommandOptionType] -> ShowS
show :: ApplicationCommandOptionType -> String
$cshow :: ApplicationCommandOptionType -> String
showsPrec :: Int -> ApplicationCommandOptionType -> ShowS
$cshowsPrec :: Int -> ApplicationCommandOptionType -> ShowS
Show, ReadPrec [ApplicationCommandOptionType]
ReadPrec ApplicationCommandOptionType
Int -> ReadS ApplicationCommandOptionType
ReadS [ApplicationCommandOptionType]
(Int -> ReadS ApplicationCommandOptionType)
-> ReadS [ApplicationCommandOptionType]
-> ReadPrec ApplicationCommandOptionType
-> ReadPrec [ApplicationCommandOptionType]
-> Read ApplicationCommandOptionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandOptionType]
$creadListPrec :: ReadPrec [ApplicationCommandOptionType]
readPrec :: ReadPrec ApplicationCommandOptionType
$creadPrec :: ReadPrec ApplicationCommandOptionType
readList :: ReadS [ApplicationCommandOptionType]
$creadList :: ReadS [ApplicationCommandOptionType]
readsPrec :: Int -> ReadS ApplicationCommandOptionType
$creadsPrec :: Int -> ReadS ApplicationCommandOptionType
Read, Typeable ApplicationCommandOptionType
DataType
Constr
Typeable ApplicationCommandOptionType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ApplicationCommandOptionType
    -> c ApplicationCommandOptionType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ApplicationCommandOptionType)
-> (ApplicationCommandOptionType -> Constr)
-> (ApplicationCommandOptionType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ApplicationCommandOptionType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApplicationCommandOptionType))
-> ((forall b. Data b => b -> b)
    -> ApplicationCommandOptionType -> ApplicationCommandOptionType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandOptionType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandOptionType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ApplicationCommandOptionType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ApplicationCommandOptionType
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandOptionType -> m ApplicationCommandOptionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandOptionType -> m ApplicationCommandOptionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandOptionType -> m ApplicationCommandOptionType)
-> Data ApplicationCommandOptionType
ApplicationCommandOptionType -> DataType
ApplicationCommandOptionType -> Constr
(forall b. Data b => b -> b)
-> ApplicationCommandOptionType -> ApplicationCommandOptionType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandOptionType
-> c ApplicationCommandOptionType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandOptionType
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)
-> ApplicationCommandOptionType
-> u
forall u.
(forall d. Data d => d -> u) -> ApplicationCommandOptionType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandOptionType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandOptionType
-> c ApplicationCommandOptionType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandOptionType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandOptionType)
$cApplicationCommandOptionTypeNumber :: Constr
$cApplicationCommandOptionTypeMentionable :: Constr
$cApplicationCommandOptionTypeRole :: Constr
$cApplicationCommandOptionTypeChannel :: Constr
$cApplicationCommandOptionTypeUser :: Constr
$cApplicationCommandOptionTypeBoolean :: Constr
$cApplicationCommandOptionTypeInteger :: Constr
$cApplicationCommandOptionTypeString :: Constr
$cApplicationCommandOptionTypeSubcommandGroup :: Constr
$cApplicationCommandOptionTypeSubcommand :: Constr
$tApplicationCommandOptionType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
gmapMp :: (forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
gmapM :: (forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandOptionType -> m ApplicationCommandOptionType
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandOptionType
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandOptionType
-> u
gmapQ :: (forall d. Data d => d -> u) -> ApplicationCommandOptionType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplicationCommandOptionType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandOptionType
-> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandOptionType -> ApplicationCommandOptionType
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandOptionType -> ApplicationCommandOptionType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandOptionType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandOptionType)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandOptionType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandOptionType)
dataTypeOf :: ApplicationCommandOptionType -> DataType
$cdataTypeOf :: ApplicationCommandOptionType -> DataType
toConstr :: ApplicationCommandOptionType -> Constr
$ctoConstr :: ApplicationCommandOptionType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandOptionType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplicationCommandOptionType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandOptionType
-> c ApplicationCommandOptionType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandOptionType
-> c ApplicationCommandOptionType
$cp1Data :: Typeable ApplicationCommandOptionType
Data, ApplicationCommandOptionType
-> ApplicationCommandOptionType -> Bool
(ApplicationCommandOptionType
 -> ApplicationCommandOptionType -> Bool)
-> (ApplicationCommandOptionType
    -> ApplicationCommandOptionType -> Bool)
-> Eq ApplicationCommandOptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandOptionType
-> ApplicationCommandOptionType -> Bool
$c/= :: ApplicationCommandOptionType
-> ApplicationCommandOptionType -> Bool
== :: ApplicationCommandOptionType
-> ApplicationCommandOptionType -> Bool
$c== :: ApplicationCommandOptionType
-> ApplicationCommandOptionType -> Bool
Eq)

instance Enum ApplicationCommandOptionType where
  fromEnum :: ApplicationCommandOptionType -> Int
fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand = Int
1
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommandGroup = Int
2
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeString = Int
3
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeInteger = Int
4
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeBoolean = Int
5
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeUser = Int
6
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeChannel = Int
7
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeRole = Int
8
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeMentionable = Int
9
  fromEnum ApplicationCommandOptionType
ApplicationCommandOptionTypeNumber = Int
10
  toEnum :: Int -> ApplicationCommandOptionType
toEnum Int
a = Maybe ApplicationCommandOptionType -> ApplicationCommandOptionType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ApplicationCommandOptionType
 -> ApplicationCommandOptionType)
-> Maybe ApplicationCommandOptionType
-> ApplicationCommandOptionType
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, ApplicationCommandOptionType)]
-> Maybe ApplicationCommandOptionType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, ApplicationCommandOptionType)]
table
    where
      table :: [(Int, ApplicationCommandOptionType)]
table = ApplicationCommandOptionType
-> [(Int, ApplicationCommandOptionType)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable ApplicationCommandOptionType
ApplicationCommandOptionTypeSubcommand

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

instance FromJSON ApplicationCommandOptionType where
  parseJSON :: Value -> Parser ApplicationCommandOptionType
parseJSON = String
-> (Scientific -> Parser ApplicationCommandOptionType)
-> Value
-> Parser ApplicationCommandOptionType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ApplicationCommandOptionType" (ApplicationCommandOptionType -> Parser ApplicationCommandOptionType
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandOptionType
 -> Parser ApplicationCommandOptionType)
-> (Scientific -> ApplicationCommandOptionType)
-> Scientific
-> Parser ApplicationCommandOptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplicationCommandOptionType
forall a. Enum a => Int -> a
toEnum (Int -> ApplicationCommandOptionType)
-> (Scientific -> Int)
-> Scientific
-> ApplicationCommandOptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round)

-- | Utility data type to store strings or number types.
data StringNumberValue = StringNumberValueString T.Text | StringNumberValueNumber Scientific | StringNumberValueInteger Integer
  deriving (Int -> StringNumberValue -> ShowS
[StringNumberValue] -> ShowS
StringNumberValue -> String
(Int -> StringNumberValue -> ShowS)
-> (StringNumberValue -> String)
-> ([StringNumberValue] -> ShowS)
-> Show StringNumberValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringNumberValue] -> ShowS
$cshowList :: [StringNumberValue] -> ShowS
show :: StringNumberValue -> String
$cshow :: StringNumberValue -> String
showsPrec :: Int -> StringNumberValue -> ShowS
$cshowsPrec :: Int -> StringNumberValue -> ShowS
Show, ReadPrec [StringNumberValue]
ReadPrec StringNumberValue
Int -> ReadS StringNumberValue
ReadS [StringNumberValue]
(Int -> ReadS StringNumberValue)
-> ReadS [StringNumberValue]
-> ReadPrec StringNumberValue
-> ReadPrec [StringNumberValue]
-> Read StringNumberValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StringNumberValue]
$creadListPrec :: ReadPrec [StringNumberValue]
readPrec :: ReadPrec StringNumberValue
$creadPrec :: ReadPrec StringNumberValue
readList :: ReadS [StringNumberValue]
$creadList :: ReadS [StringNumberValue]
readsPrec :: Int -> ReadS StringNumberValue
$creadsPrec :: Int -> ReadS StringNumberValue
Read, StringNumberValue -> StringNumberValue -> Bool
(StringNumberValue -> StringNumberValue -> Bool)
-> (StringNumberValue -> StringNumberValue -> Bool)
-> Eq StringNumberValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringNumberValue -> StringNumberValue -> Bool
$c/= :: StringNumberValue -> StringNumberValue -> Bool
== :: StringNumberValue -> StringNumberValue -> Bool
$c== :: StringNumberValue -> StringNumberValue -> Bool
Eq)

instance ToJSON StringNumberValue where
  toJSON :: StringNumberValue -> Value
toJSON (StringNumberValueString Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
  toJSON (StringNumberValueNumber Scientific
i) = Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON Scientific
i
  toJSON (StringNumberValueInteger Integer
i) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i

instance FromJSON StringNumberValue where
  parseJSON :: Value -> Parser StringNumberValue
parseJSON (String Text
t) = StringNumberValue -> Parser StringNumberValue
forall (m :: * -> *) a. Monad m => a -> m a
return (StringNumberValue -> Parser StringNumberValue)
-> StringNumberValue -> Parser StringNumberValue
forall a b. (a -> b) -> a -> b
$ Text -> StringNumberValue
StringNumberValueString Text
t
  parseJSON Value
v = (Integer -> StringNumberValue
StringNumberValueInteger (Integer -> StringNumberValue)
-> Parser Integer -> Parser StringNumberValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser StringNumberValue
-> Parser StringNumberValue -> Parser StringNumberValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Scientific -> StringNumberValue
StringNumberValueNumber (Scientific -> StringNumberValue)
-> Parser Scientific -> Parser StringNumberValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Scientific
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

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

instance Functor Choice where
  fmap :: (a -> b) -> Choice a -> Choice b
fmap a -> b
f (Choice Text
s a
a) = Text -> b -> Choice b
forall a. Text -> a -> Choice a
Choice Text
s (a -> b
f a
a)

type InternalApplicationCommandOptionChoice = Choice StringNumberValue

-- | The choices for a particular option.
-- data InternalApplicationCommandOptionChoice = InternalApplicationCommandOptionChoice
--   { internalApplicationCommandOptionChoiceName :: T.Text,
--     internalApplicationCommandOptionChoiceValue :: StringNumberValue
--   }
--   deriving (Show, Read, Eq)
instance (ToJSON a) => ToJSON (Choice a) where
  toJSON :: Choice a -> Value
toJSON Choice {a
Text
choiceValue :: a
choiceName :: Text
choiceValue :: forall a. Choice a -> a
choiceName :: forall a. Choice a -> Text
..} = [Pair] -> Value
object [(Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
choiceName), (Key
"value", a -> Value
forall a. ToJSON a => a -> Value
toJSON a
choiceValue)]

instance (FromJSON a) => FromJSON (Choice a) where
  parseJSON :: Value -> Parser (Choice a)
parseJSON =
    String
-> (Object -> Parser (Choice a)) -> Value -> Parser (Choice a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Choice"
      ( \Object
v ->
          Text -> a -> Choice a
forall a. Text -> a -> Choice a
Choice
            (Text -> a -> Choice a) -> Parser Text -> Parser (a -> Choice a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
            Parser (a -> Choice a) -> Parser a -> Parser (Choice a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      )

-- | The different channel types.
--
-- https://discord.com/developers/docs/resources/channel#channel-object-channel-types
data ApplicationCommandChannelType
  = -- | A text channel in a server.
    ApplicationCommandChannelTypeGuildText
  | -- | A direct message between users.
    ApplicationCommandChannelTypeDM
  | -- | A voice channel in a server.
    ApplicationCommandChannelTypeGuildVoice
  | -- | A direct message between multiple users.
    ApplicationCommandChannelTypeGroupDM
  | -- | An organizational category that contains up to 50 channels.
    ApplicationCommandChannelTypeGuildCategory
  | -- | A channel that users can follow and crosspost into their own server.
    ApplicationCommandChannelTypeGuildNews
  | -- | A channel in which game developers can sell their game on discord.
    ApplicationCommandChannelTypeGuildStore
  | -- | A temporary sub-channel within a guild_news channel.
    ApplicationCommandChannelTypeGuildNewsThread
  | -- | A temporary sub-channel within a guild_text channel
    ApplicationCommandChannelTypeGuildPublicThread
  | -- | A temporary sub-channel within a GUILD_TEXT channel that is only
    -- viewable by those invited and those with the MANAGE_THREADS permission
    ApplicationCommandChannelTypeGuildPrivateThread
  | -- | A voice channel for hosting events with an audience.
    ApplicationCommandChannelTypeGuildStageVoice
  deriving (Int -> ApplicationCommandChannelType -> ShowS
[ApplicationCommandChannelType] -> ShowS
ApplicationCommandChannelType -> String
(Int -> ApplicationCommandChannelType -> ShowS)
-> (ApplicationCommandChannelType -> String)
-> ([ApplicationCommandChannelType] -> ShowS)
-> Show ApplicationCommandChannelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandChannelType] -> ShowS
$cshowList :: [ApplicationCommandChannelType] -> ShowS
show :: ApplicationCommandChannelType -> String
$cshow :: ApplicationCommandChannelType -> String
showsPrec :: Int -> ApplicationCommandChannelType -> ShowS
$cshowsPrec :: Int -> ApplicationCommandChannelType -> ShowS
Show, ReadPrec [ApplicationCommandChannelType]
ReadPrec ApplicationCommandChannelType
Int -> ReadS ApplicationCommandChannelType
ReadS [ApplicationCommandChannelType]
(Int -> ReadS ApplicationCommandChannelType)
-> ReadS [ApplicationCommandChannelType]
-> ReadPrec ApplicationCommandChannelType
-> ReadPrec [ApplicationCommandChannelType]
-> Read ApplicationCommandChannelType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandChannelType]
$creadListPrec :: ReadPrec [ApplicationCommandChannelType]
readPrec :: ReadPrec ApplicationCommandChannelType
$creadPrec :: ReadPrec ApplicationCommandChannelType
readList :: ReadS [ApplicationCommandChannelType]
$creadList :: ReadS [ApplicationCommandChannelType]
readsPrec :: Int -> ReadS ApplicationCommandChannelType
$creadsPrec :: Int -> ReadS ApplicationCommandChannelType
Read, Typeable ApplicationCommandChannelType
DataType
Constr
Typeable ApplicationCommandChannelType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ApplicationCommandChannelType
    -> c ApplicationCommandChannelType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ApplicationCommandChannelType)
-> (ApplicationCommandChannelType -> Constr)
-> (ApplicationCommandChannelType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ApplicationCommandChannelType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApplicationCommandChannelType))
-> ((forall b. Data b => b -> b)
    -> ApplicationCommandChannelType -> ApplicationCommandChannelType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandChannelType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandChannelType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ApplicationCommandChannelType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ApplicationCommandChannelType
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandChannelType
    -> m ApplicationCommandChannelType)
-> Data ApplicationCommandChannelType
ApplicationCommandChannelType -> DataType
ApplicationCommandChannelType -> Constr
(forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
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)
-> ApplicationCommandChannelType
-> u
forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
$cApplicationCommandChannelTypeGuildStageVoice :: Constr
$cApplicationCommandChannelTypeGuildPrivateThread :: Constr
$cApplicationCommandChannelTypeGuildPublicThread :: Constr
$cApplicationCommandChannelTypeGuildNewsThread :: Constr
$cApplicationCommandChannelTypeGuildStore :: Constr
$cApplicationCommandChannelTypeGuildNews :: Constr
$cApplicationCommandChannelTypeGuildCategory :: Constr
$cApplicationCommandChannelTypeGroupDM :: Constr
$cApplicationCommandChannelTypeGuildVoice :: Constr
$cApplicationCommandChannelTypeDM :: Constr
$cApplicationCommandChannelTypeGuildText :: Constr
$tApplicationCommandChannelType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapMp :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapM :: (forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandChannelType -> m ApplicationCommandChannelType
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandChannelType
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandChannelType
-> u
gmapQ :: (forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandChannelType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandChannelType
-> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandChannelType -> ApplicationCommandChannelType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandChannelType)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandChannelType)
dataTypeOf :: ApplicationCommandChannelType -> DataType
$cdataTypeOf :: ApplicationCommandChannelType -> DataType
toConstr :: ApplicationCommandChannelType -> Constr
$ctoConstr :: ApplicationCommandChannelType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandChannelType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandChannelType
-> c ApplicationCommandChannelType
$cp1Data :: Typeable ApplicationCommandChannelType
Data, ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
(ApplicationCommandChannelType
 -> ApplicationCommandChannelType -> Bool)
-> (ApplicationCommandChannelType
    -> ApplicationCommandChannelType -> Bool)
-> Eq ApplicationCommandChannelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
$c/= :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
== :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
$c== :: ApplicationCommandChannelType
-> ApplicationCommandChannelType -> Bool
Eq)

instance Enum ApplicationCommandChannelType where
  fromEnum :: ApplicationCommandChannelType -> Int
fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildText = Int
0
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeDM = Int
1
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildVoice = Int
2
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGroupDM = Int
3
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildCategory = Int
4
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildNews = Int
5
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildStore = Int
6
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildNewsThread = Int
10
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildPublicThread = Int
11
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildPrivateThread = Int
12
  fromEnum ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildStageVoice = Int
13
  toEnum :: Int -> ApplicationCommandChannelType
toEnum Int
a = Maybe ApplicationCommandChannelType
-> ApplicationCommandChannelType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ApplicationCommandChannelType
 -> ApplicationCommandChannelType)
-> Maybe ApplicationCommandChannelType
-> ApplicationCommandChannelType
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, ApplicationCommandChannelType)]
-> Maybe ApplicationCommandChannelType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, ApplicationCommandChannelType)]
table
    where
      table :: [(Int, ApplicationCommandChannelType)]
table = ApplicationCommandChannelType
-> [(Int, ApplicationCommandChannelType)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable ApplicationCommandChannelType
ApplicationCommandChannelTypeGuildText

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

instance FromJSON ApplicationCommandChannelType where
  parseJSON :: Value -> Parser ApplicationCommandChannelType
parseJSON = String
-> (Scientific -> Parser ApplicationCommandChannelType)
-> Value
-> Parser ApplicationCommandChannelType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ApplicationCommandChannelType" (ApplicationCommandChannelType
-> Parser ApplicationCommandChannelType
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandChannelType
 -> Parser ApplicationCommandChannelType)
-> (Scientific -> ApplicationCommandChannelType)
-> Scientific
-> Parser ApplicationCommandChannelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplicationCommandChannelType
forall a. Enum a => Int -> a
toEnum (Int -> ApplicationCommandChannelType)
-> (Scientific -> Int)
-> Scientific
-> ApplicationCommandChannelType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round)

data GuildApplicationCommandPermissions = GuildApplicationCommandPermissions
  { -- | The id of the command
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsId :: ApplicationCommandId,
    -- | The id of the application
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: ApplicationId,
    -- | The id of the guild
    GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsGuildId :: GuildId,
    -- | The permissions for the command in the guild
    GuildApplicationCommandPermissions
-> [ApplicationCommandPermissions]
guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
  }
  deriving (Int -> GuildApplicationCommandPermissions -> ShowS
[GuildApplicationCommandPermissions] -> ShowS
GuildApplicationCommandPermissions -> String
(Int -> GuildApplicationCommandPermissions -> ShowS)
-> (GuildApplicationCommandPermissions -> String)
-> ([GuildApplicationCommandPermissions] -> ShowS)
-> Show GuildApplicationCommandPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuildApplicationCommandPermissions] -> ShowS
$cshowList :: [GuildApplicationCommandPermissions] -> ShowS
show :: GuildApplicationCommandPermissions -> String
$cshow :: GuildApplicationCommandPermissions -> String
showsPrec :: Int -> GuildApplicationCommandPermissions -> ShowS
$cshowsPrec :: Int -> GuildApplicationCommandPermissions -> ShowS
Show, GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
(GuildApplicationCommandPermissions
 -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> Eq GuildApplicationCommandPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c/= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
== :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c== :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
Eq, Eq GuildApplicationCommandPermissions
Eq GuildApplicationCommandPermissions
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Ordering)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions -> Bool)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions)
-> (GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions
    -> GuildApplicationCommandPermissions)
-> Ord GuildApplicationCommandPermissions
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
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 :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
$cmin :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
max :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
$cmax :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions
>= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c>= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
> :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c> :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
<= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c<= :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
< :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
$c< :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Bool
compare :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
$ccompare :: GuildApplicationCommandPermissions
-> GuildApplicationCommandPermissions -> Ordering
$cp1Ord :: Eq GuildApplicationCommandPermissions
Ord, ReadPrec [GuildApplicationCommandPermissions]
ReadPrec GuildApplicationCommandPermissions
Int -> ReadS GuildApplicationCommandPermissions
ReadS [GuildApplicationCommandPermissions]
(Int -> ReadS GuildApplicationCommandPermissions)
-> ReadS [GuildApplicationCommandPermissions]
-> ReadPrec GuildApplicationCommandPermissions
-> ReadPrec [GuildApplicationCommandPermissions]
-> Read GuildApplicationCommandPermissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GuildApplicationCommandPermissions]
$creadListPrec :: ReadPrec [GuildApplicationCommandPermissions]
readPrec :: ReadPrec GuildApplicationCommandPermissions
$creadPrec :: ReadPrec GuildApplicationCommandPermissions
readList :: ReadS [GuildApplicationCommandPermissions]
$creadList :: ReadS [GuildApplicationCommandPermissions]
readsPrec :: Int -> ReadS GuildApplicationCommandPermissions
$creadsPrec :: Int -> ReadS GuildApplicationCommandPermissions
Read)

instance FromJSON GuildApplicationCommandPermissions where
  parseJSON :: Value -> Parser GuildApplicationCommandPermissions
parseJSON =
    String
-> (Object -> Parser GuildApplicationCommandPermissions)
-> Value
-> Parser GuildApplicationCommandPermissions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"GuildApplicationCommandPermissions"
      ( \Object
v ->
          ApplicationCommandId
-> ApplicationCommandId
-> ApplicationCommandId
-> [ApplicationCommandPermissions]
-> GuildApplicationCommandPermissions
GuildApplicationCommandPermissions
            (ApplicationCommandId
 -> ApplicationCommandId
 -> ApplicationCommandId
 -> [ApplicationCommandPermissions]
 -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationCommandId
      -> ApplicationCommandId
      -> [ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (ApplicationCommandId
   -> ApplicationCommandId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationCommandId
      -> [ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"application_id"
            Parser
  (ApplicationCommandId
   -> [ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     ([ApplicationCommandPermissions]
      -> GuildApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guild_id"
            Parser
  ([ApplicationCommandPermissions]
   -> GuildApplicationCommandPermissions)
-> Parser [ApplicationCommandPermissions]
-> Parser GuildApplicationCommandPermissions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ApplicationCommandPermissions]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permissions"
      )

instance ToJSON GuildApplicationCommandPermissions where
  toJSON :: GuildApplicationCommandPermissions -> Value
toJSON GuildApplicationCommandPermissions {[ApplicationCommandPermissions]
ApplicationCommandId
guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]
guildApplicationCommandPermissionsGuildId :: ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: ApplicationCommandId
guildApplicationCommandPermissionsId :: ApplicationCommandId
guildApplicationCommandPermissionsPermissions :: GuildApplicationCommandPermissions
-> [ApplicationCommandPermissions]
guildApplicationCommandPermissionsGuildId :: GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsApplicationId :: GuildApplicationCommandPermissions -> ApplicationCommandId
guildApplicationCommandPermissionsId :: GuildApplicationCommandPermissions -> ApplicationCommandId
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsId),
              (Key
"application_id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsApplicationId),
              (Key
"guild_id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
guildApplicationCommandPermissionsGuildId),
              (Key
"permissions", [ApplicationCommandPermissions] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON [ApplicationCommandPermissions]
guildApplicationCommandPermissionsPermissions)
            ]
      ]

data ApplicationCommandPermissions = ApplicationCommandPermissions
  { -- | The id of the role or user
    ApplicationCommandPermissions -> ApplicationCommandId
applicationCommandPermissionsId :: Snowflake,
    -- | Choose either role or user
    ApplicationCommandPermissions -> ApplicationCommandPermissionType
applicationCommandPermissionsType :: ApplicationCommandPermissionType,
    -- | Whether to allow or not
    ApplicationCommandPermissions -> Bool
applicationCommandPermissionsPermission :: Bool
  }
  deriving (Int -> ApplicationCommandPermissions -> ShowS
[ApplicationCommandPermissions] -> ShowS
ApplicationCommandPermissions -> String
(Int -> ApplicationCommandPermissions -> ShowS)
-> (ApplicationCommandPermissions -> String)
-> ([ApplicationCommandPermissions] -> ShowS)
-> Show ApplicationCommandPermissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandPermissions] -> ShowS
$cshowList :: [ApplicationCommandPermissions] -> ShowS
show :: ApplicationCommandPermissions -> String
$cshow :: ApplicationCommandPermissions -> String
showsPrec :: Int -> ApplicationCommandPermissions -> ShowS
$cshowsPrec :: Int -> ApplicationCommandPermissions -> ShowS
Show, ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
(ApplicationCommandPermissions
 -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> Eq ApplicationCommandPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c/= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c== :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
Eq, Eq ApplicationCommandPermissions
Eq ApplicationCommandPermissions
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Ordering)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> Bool)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> ApplicationCommandPermissions)
-> (ApplicationCommandPermissions
    -> ApplicationCommandPermissions -> ApplicationCommandPermissions)
-> Ord ApplicationCommandPermissions
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
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 :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
$cmin :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
max :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
$cmax :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> ApplicationCommandPermissions
>= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c>= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
> :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c> :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
<= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c<= :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
< :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
$c< :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Bool
compare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
$ccompare :: ApplicationCommandPermissions
-> ApplicationCommandPermissions -> Ordering
$cp1Ord :: Eq ApplicationCommandPermissions
Ord, ReadPrec [ApplicationCommandPermissions]
ReadPrec ApplicationCommandPermissions
Int -> ReadS ApplicationCommandPermissions
ReadS [ApplicationCommandPermissions]
(Int -> ReadS ApplicationCommandPermissions)
-> ReadS [ApplicationCommandPermissions]
-> ReadPrec ApplicationCommandPermissions
-> ReadPrec [ApplicationCommandPermissions]
-> Read ApplicationCommandPermissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandPermissions]
$creadListPrec :: ReadPrec [ApplicationCommandPermissions]
readPrec :: ReadPrec ApplicationCommandPermissions
$creadPrec :: ReadPrec ApplicationCommandPermissions
readList :: ReadS [ApplicationCommandPermissions]
$creadList :: ReadS [ApplicationCommandPermissions]
readsPrec :: Int -> ReadS ApplicationCommandPermissions
$creadsPrec :: Int -> ReadS ApplicationCommandPermissions
Read)

instance FromJSON ApplicationCommandPermissions where
  parseJSON :: Value -> Parser ApplicationCommandPermissions
parseJSON =
    String
-> (Object -> Parser ApplicationCommandPermissions)
-> Value
-> Parser ApplicationCommandPermissions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ApplicationCommandPermissions"
      ( \Object
v ->
          ApplicationCommandId
-> ApplicationCommandPermissionType
-> Bool
-> ApplicationCommandPermissions
ApplicationCommandPermissions
            (ApplicationCommandId
 -> ApplicationCommandPermissionType
 -> Bool
 -> ApplicationCommandPermissions)
-> Parser ApplicationCommandId
-> Parser
     (ApplicationCommandPermissionType
      -> Bool -> ApplicationCommandPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ApplicationCommandId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            Parser
  (ApplicationCommandPermissionType
   -> Bool -> ApplicationCommandPermissions)
-> Parser ApplicationCommandPermissionType
-> Parser (Bool -> ApplicationCommandPermissions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ApplicationCommandPermissionType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
            Parser (Bool -> ApplicationCommandPermissions)
-> Parser Bool -> Parser ApplicationCommandPermissions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission"
      )

instance ToJSON ApplicationCommandPermissions where
  toJSON :: ApplicationCommandPermissions -> Value
toJSON ApplicationCommandPermissions {Bool
ApplicationCommandId
ApplicationCommandPermissionType
applicationCommandPermissionsPermission :: Bool
applicationCommandPermissionsType :: ApplicationCommandPermissionType
applicationCommandPermissionsId :: ApplicationCommandId
applicationCommandPermissionsPermission :: ApplicationCommandPermissions -> Bool
applicationCommandPermissionsType :: ApplicationCommandPermissions -> ApplicationCommandPermissionType
applicationCommandPermissionsId :: ApplicationCommandPermissions -> ApplicationCommandId
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", ApplicationCommandId -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandId
applicationCommandPermissionsId),
              (Key
"type", ApplicationCommandPermissionType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ApplicationCommandPermissionType
applicationCommandPermissionsType),
              (Key
"permission", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
applicationCommandPermissionsPermission)
            ]
      ]

data ApplicationCommandPermissionType
  = ApplicationCommandPermissionTypeRole
  | ApplicationCommandPermissionTypeUser
  deriving (Int -> ApplicationCommandPermissionType -> ShowS
[ApplicationCommandPermissionType] -> ShowS
ApplicationCommandPermissionType -> String
(Int -> ApplicationCommandPermissionType -> ShowS)
-> (ApplicationCommandPermissionType -> String)
-> ([ApplicationCommandPermissionType] -> ShowS)
-> Show ApplicationCommandPermissionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationCommandPermissionType] -> ShowS
$cshowList :: [ApplicationCommandPermissionType] -> ShowS
show :: ApplicationCommandPermissionType -> String
$cshow :: ApplicationCommandPermissionType -> String
showsPrec :: Int -> ApplicationCommandPermissionType -> ShowS
$cshowsPrec :: Int -> ApplicationCommandPermissionType -> ShowS
Show, ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
(ApplicationCommandPermissionType
 -> ApplicationCommandPermissionType -> Bool)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Bool)
-> Eq ApplicationCommandPermissionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c/= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
== :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c== :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
Eq, Eq ApplicationCommandPermissionType
Eq ApplicationCommandPermissionType
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Ordering)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Bool)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Bool)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Bool)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType -> Bool)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType)
-> (ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType)
-> Ord ApplicationCommandPermissionType
ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Ordering
ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
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 :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
$cmin :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
max :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
$cmax :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
>= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c>= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
> :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c> :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
<= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c<= :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
< :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
$c< :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Bool
compare :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Ordering
$ccompare :: ApplicationCommandPermissionType
-> ApplicationCommandPermissionType -> Ordering
$cp1Ord :: Eq ApplicationCommandPermissionType
Ord, ReadPrec [ApplicationCommandPermissionType]
ReadPrec ApplicationCommandPermissionType
Int -> ReadS ApplicationCommandPermissionType
ReadS [ApplicationCommandPermissionType]
(Int -> ReadS ApplicationCommandPermissionType)
-> ReadS [ApplicationCommandPermissionType]
-> ReadPrec ApplicationCommandPermissionType
-> ReadPrec [ApplicationCommandPermissionType]
-> Read ApplicationCommandPermissionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationCommandPermissionType]
$creadListPrec :: ReadPrec [ApplicationCommandPermissionType]
readPrec :: ReadPrec ApplicationCommandPermissionType
$creadPrec :: ReadPrec ApplicationCommandPermissionType
readList :: ReadS [ApplicationCommandPermissionType]
$creadList :: ReadS [ApplicationCommandPermissionType]
readsPrec :: Int -> ReadS ApplicationCommandPermissionType
$creadsPrec :: Int -> ReadS ApplicationCommandPermissionType
Read, Typeable ApplicationCommandPermissionType
DataType
Constr
Typeable ApplicationCommandPermissionType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ApplicationCommandPermissionType
    -> c ApplicationCommandPermissionType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c ApplicationCommandPermissionType)
-> (ApplicationCommandPermissionType -> Constr)
-> (ApplicationCommandPermissionType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c ApplicationCommandPermissionType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ApplicationCommandPermissionType))
-> ((forall b. Data b => b -> b)
    -> ApplicationCommandPermissionType
    -> ApplicationCommandPermissionType)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandPermissionType
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ApplicationCommandPermissionType
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> ApplicationCommandPermissionType -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> ApplicationCommandPermissionType
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandPermissionType
    -> m ApplicationCommandPermissionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandPermissionType
    -> m ApplicationCommandPermissionType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ApplicationCommandPermissionType
    -> m ApplicationCommandPermissionType)
-> Data ApplicationCommandPermissionType
ApplicationCommandPermissionType -> DataType
ApplicationCommandPermissionType -> Constr
(forall b. Data b => b -> b)
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandPermissionType
-> c ApplicationCommandPermissionType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandPermissionType
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)
-> ApplicationCommandPermissionType
-> u
forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandPermissionType -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandPermissionType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandPermissionType
-> c ApplicationCommandPermissionType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandPermissionType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandPermissionType)
$cApplicationCommandPermissionTypeUser :: Constr
$cApplicationCommandPermissionTypeRole :: Constr
$tApplicationCommandPermissionType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
gmapMp :: (forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
gmapM :: (forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplicationCommandPermissionType
-> m ApplicationCommandPermissionType
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandPermissionType
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> ApplicationCommandPermissionType
-> u
gmapQ :: (forall d. Data d => d -> u)
-> ApplicationCommandPermissionType -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> ApplicationCommandPermissionType -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplicationCommandPermissionType
-> r
gmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
$cgmapT :: (forall b. Data b => b -> b)
-> ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandPermissionType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplicationCommandPermissionType)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandPermissionType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplicationCommandPermissionType)
dataTypeOf :: ApplicationCommandPermissionType -> DataType
$cdataTypeOf :: ApplicationCommandPermissionType -> DataType
toConstr :: ApplicationCommandPermissionType -> Constr
$ctoConstr :: ApplicationCommandPermissionType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandPermissionType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c ApplicationCommandPermissionType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandPermissionType
-> c ApplicationCommandPermissionType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplicationCommandPermissionType
-> c ApplicationCommandPermissionType
$cp1Data :: Typeable ApplicationCommandPermissionType
Data)

instance Enum ApplicationCommandPermissionType where
  fromEnum :: ApplicationCommandPermissionType -> Int
fromEnum ApplicationCommandPermissionType
ApplicationCommandPermissionTypeRole = Int
1
  fromEnum ApplicationCommandPermissionType
ApplicationCommandPermissionTypeUser = Int
2
  toEnum :: Int -> ApplicationCommandPermissionType
toEnum Int
a = Maybe ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ApplicationCommandPermissionType
 -> ApplicationCommandPermissionType)
-> Maybe ApplicationCommandPermissionType
-> ApplicationCommandPermissionType
forall a b. (a -> b) -> a -> b
$ Int
-> [(Int, ApplicationCommandPermissionType)]
-> Maybe ApplicationCommandPermissionType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, ApplicationCommandPermissionType)]
table
    where
      table :: [(Int, ApplicationCommandPermissionType)]
table = ApplicationCommandPermissionType
-> [(Int, ApplicationCommandPermissionType)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable ApplicationCommandPermissionType
ApplicationCommandPermissionTypeRole

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

instance FromJSON ApplicationCommandPermissionType where
  parseJSON :: Value -> Parser ApplicationCommandPermissionType
parseJSON = String
-> (Scientific -> Parser ApplicationCommandPermissionType)
-> Value
-> Parser ApplicationCommandPermissionType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"ApplicationCommandPermissionType" (ApplicationCommandPermissionType
-> Parser ApplicationCommandPermissionType
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicationCommandPermissionType
 -> Parser ApplicationCommandPermissionType)
-> (Scientific -> ApplicationCommandPermissionType)
-> Scientific
-> Parser ApplicationCommandPermissionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ApplicationCommandPermissionType
forall a. Enum a => Int -> a
toEnum (Int -> ApplicationCommandPermissionType)
-> (Scientific -> Int)
-> Scientific
-> ApplicationCommandPermissionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round)