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

module Discord.Internal.Types.Components where

import Data.Aeson
import Data.Data (Data)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T
import Data.Tuple (swap)
import Discord.Internal.Types.Prelude (EmojiId, Internals (..), RoleId, makeTable, toMaybeJSON)
import Discord.Internal.Types.User (User)
import qualified Network.HTTP.Req as R

-- | Component type for a button, split into URL button and not URL button.
--
-- Don't directly send button components - they need to be within an action row.
data ComponentButton
  = ComponentButton
      { ComponentButton -> Text
componentButtonCustomId :: T.Text,
        ComponentButton -> Bool
componentButtonDisabled :: Bool,
        ComponentButton -> ButtonStyle
componentButtonStyle :: ButtonStyle,
        ComponentButton -> Text
componentButtonLabel :: T.Text,
        ComponentButton -> Maybe Emoji
componentButtonEmoji :: Maybe Emoji
      }
  | ComponentButtonUrl
      { ComponentButton -> Url 'Https
componentButtonUrl :: R.Url 'R.Https,
        componentButtonDisabled :: Bool,
        componentButtonLabel :: T.Text,
        componentButtonEmoji :: Maybe Emoji
      }
  deriving (Int -> ComponentButton -> ShowS
[ComponentButton] -> ShowS
ComponentButton -> String
(Int -> ComponentButton -> ShowS)
-> (ComponentButton -> String)
-> ([ComponentButton] -> ShowS)
-> Show ComponentButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentButton] -> ShowS
$cshowList :: [ComponentButton] -> ShowS
show :: ComponentButton -> String
$cshow :: ComponentButton -> String
showsPrec :: Int -> ComponentButton -> ShowS
$cshowsPrec :: Int -> ComponentButton -> ShowS
Show, ComponentButton -> ComponentButton -> Bool
(ComponentButton -> ComponentButton -> Bool)
-> (ComponentButton -> ComponentButton -> Bool)
-> Eq ComponentButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentButton -> ComponentButton -> Bool
$c/= :: ComponentButton -> ComponentButton -> Bool
== :: ComponentButton -> ComponentButton -> Bool
$c== :: ComponentButton -> ComponentButton -> Bool
Eq)

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

buttonStyles :: [(ButtonStyle, InternalButtonStyle)]
buttonStyles :: [(ButtonStyle, InternalButtonStyle)]
buttonStyles =
  [ (ButtonStyle
ButtonStylePrimary, InternalButtonStyle
InternalButtonStylePrimary),
    (ButtonStyle
ButtonStyleSecondary, InternalButtonStyle
InternalButtonStyleSecondary),
    (ButtonStyle
ButtonStyleSuccess, InternalButtonStyle
InternalButtonStyleSuccess),
    (ButtonStyle
ButtonStyleDanger, InternalButtonStyle
InternalButtonStyleDanger)
  ]

instance Internals ButtonStyle InternalButtonStyle where
  toInternal :: ButtonStyle -> InternalButtonStyle
toInternal ButtonStyle
a = Maybe InternalButtonStyle -> InternalButtonStyle
forall a. HasCallStack => Maybe a -> a
fromJust (ButtonStyle
-> [(ButtonStyle, InternalButtonStyle)]
-> Maybe InternalButtonStyle
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ButtonStyle
a [(ButtonStyle, InternalButtonStyle)]
buttonStyles)
  fromInternal :: InternalButtonStyle -> Maybe ButtonStyle
fromInternal InternalButtonStyle
b = InternalButtonStyle
-> [(InternalButtonStyle, ButtonStyle)] -> Maybe ButtonStyle
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup InternalButtonStyle
b ((ButtonStyle, InternalButtonStyle)
-> (InternalButtonStyle, ButtonStyle)
forall a b. (a, b) -> (b, a)
swap ((ButtonStyle, InternalButtonStyle)
 -> (InternalButtonStyle, ButtonStyle))
-> [(ButtonStyle, InternalButtonStyle)]
-> [(InternalButtonStyle, ButtonStyle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ButtonStyle, InternalButtonStyle)]
buttonStyles)

-- | Component type for a select menus.
--
-- Don't directly send select menus - they need to be within an action row.
data ComponentSelectMenu = ComponentSelectMenu
  { ComponentSelectMenu -> Text
componentSelectMenuCustomId :: T.Text,
    ComponentSelectMenu -> Bool
componentSelectMenuDisabled :: Bool,
    ComponentSelectMenu -> [SelectOption]
componentSelectMenuOptions :: [SelectOption],
    ComponentSelectMenu -> Maybe Text
componentSelectMenuPlaceholder :: Maybe T.Text,
    ComponentSelectMenu -> Maybe Integer
componentSelectMenuMinValues :: Maybe Integer,
    ComponentSelectMenu -> Maybe Integer
componentSelectMenuMaxValues :: Maybe Integer
  }
  deriving (Int -> ComponentSelectMenu -> ShowS
[ComponentSelectMenu] -> ShowS
ComponentSelectMenu -> String
(Int -> ComponentSelectMenu -> ShowS)
-> (ComponentSelectMenu -> String)
-> ([ComponentSelectMenu] -> ShowS)
-> Show ComponentSelectMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentSelectMenu] -> ShowS
$cshowList :: [ComponentSelectMenu] -> ShowS
show :: ComponentSelectMenu -> String
$cshow :: ComponentSelectMenu -> String
showsPrec :: Int -> ComponentSelectMenu -> ShowS
$cshowsPrec :: Int -> ComponentSelectMenu -> ShowS
Show, ComponentSelectMenu -> ComponentSelectMenu -> Bool
(ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> (ComponentSelectMenu -> ComponentSelectMenu -> Bool)
-> Eq ComponentSelectMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c/= :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
== :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
$c== :: ComponentSelectMenu -> ComponentSelectMenu -> Bool
Eq, ReadPrec [ComponentSelectMenu]
ReadPrec ComponentSelectMenu
Int -> ReadS ComponentSelectMenu
ReadS [ComponentSelectMenu]
(Int -> ReadS ComponentSelectMenu)
-> ReadS [ComponentSelectMenu]
-> ReadPrec ComponentSelectMenu
-> ReadPrec [ComponentSelectMenu]
-> Read ComponentSelectMenu
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentSelectMenu]
$creadListPrec :: ReadPrec [ComponentSelectMenu]
readPrec :: ReadPrec ComponentSelectMenu
$creadPrec :: ReadPrec ComponentSelectMenu
readList :: ReadS [ComponentSelectMenu]
$creadList :: ReadS [ComponentSelectMenu]
readsPrec :: Int -> ReadS ComponentSelectMenu
$creadsPrec :: Int -> ReadS ComponentSelectMenu
Read)

data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu
  deriving (Int -> ComponentActionRow -> ShowS
[ComponentActionRow] -> ShowS
ComponentActionRow -> String
(Int -> ComponentActionRow -> ShowS)
-> (ComponentActionRow -> String)
-> ([ComponentActionRow] -> ShowS)
-> Show ComponentActionRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentActionRow] -> ShowS
$cshowList :: [ComponentActionRow] -> ShowS
show :: ComponentActionRow -> String
$cshow :: ComponentActionRow -> String
showsPrec :: Int -> ComponentActionRow -> ShowS
$cshowsPrec :: Int -> ComponentActionRow -> ShowS
Show, ComponentActionRow -> ComponentActionRow -> Bool
(ComponentActionRow -> ComponentActionRow -> Bool)
-> (ComponentActionRow -> ComponentActionRow -> Bool)
-> Eq ComponentActionRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentActionRow -> ComponentActionRow -> Bool
$c/= :: ComponentActionRow -> ComponentActionRow -> Bool
== :: ComponentActionRow -> ComponentActionRow -> Bool
$c== :: ComponentActionRow -> ComponentActionRow -> Bool
Eq)

validPartialEmoji :: Emoji -> Maybe Emoji
validPartialEmoji :: Emoji -> Maybe Emoji
validPartialEmoji Emoji {Maybe Bool
Maybe [RoleId]
Maybe RoleId
Maybe User
Text
emojiAnimated :: Emoji -> Maybe Bool
emojiManaged :: Emoji -> Maybe Bool
emojiUser :: Emoji -> Maybe User
emojiRoles :: Emoji -> Maybe [RoleId]
emojiName :: Emoji -> Text
emojiId :: Emoji -> Maybe RoleId
emojiAnimated :: Maybe Bool
emojiManaged :: Maybe Bool
emojiUser :: Maybe User
emojiRoles :: Maybe [RoleId]
emojiName :: Text
emojiId :: Maybe RoleId
..} = do
  RoleId
eid <- Maybe RoleId
emojiId
  Bool
ean <- Maybe Bool
emojiAnimated
  Emoji -> Maybe Emoji
forall (m :: * -> *) a. Monad m => a -> m a
return (Emoji -> Maybe Emoji) -> Emoji -> Maybe Emoji
forall a b. (a -> b) -> a -> b
$ Maybe RoleId
-> Text
-> Maybe [RoleId]
-> Maybe User
-> Maybe Bool
-> Maybe Bool
-> Emoji
Emoji (RoleId -> Maybe RoleId
forall a. a -> Maybe a
Just RoleId
eid) Text
emojiName Maybe [RoleId]
forall a. Maybe a
Nothing Maybe User
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ean)

instance Internals ComponentActionRow Component where
  toInternal :: ComponentActionRow -> Component
toInternal (ComponentActionRowButton [ComponentButton]
as) = ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component ComponentType
ComponentTypeActionRow Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe InternalButtonStyle
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [SelectOption]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing ([Component] -> Maybe [Component]
forall a. a -> Maybe a
Just (ComponentButton -> Component
toInternal' (ComponentButton -> Component) -> [ComponentButton] -> [Component]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentButton]
as))
    where
      toInternal' :: ComponentButton -> Component
toInternal' ComponentButtonUrl {Bool
Maybe Emoji
Text
Url 'Https
componentButtonEmoji :: Maybe Emoji
componentButtonLabel :: Text
componentButtonDisabled :: Bool
componentButtonUrl :: Url 'Https
componentButtonUrl :: ComponentButton -> Url 'Https
componentButtonEmoji :: ComponentButton -> Maybe Emoji
componentButtonLabel :: ComponentButton -> Text
componentButtonDisabled :: ComponentButton -> Bool
..} = ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component ComponentType
ComponentTypeButton Maybe Text
forall a. Maybe a
Nothing (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
componentButtonDisabled) (InternalButtonStyle -> Maybe InternalButtonStyle
forall a. a -> Maybe a
Just InternalButtonStyle
InternalButtonStyleLink) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
componentButtonLabel) Maybe Emoji
componentButtonEmoji (Text -> Maybe Text
forall a. a -> Maybe a
Just (Url 'Https -> Text
forall (scheme :: Scheme). Url scheme -> Text
R.renderUrl Url 'Https
componentButtonUrl)) Maybe [SelectOption]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe [Component]
forall a. Maybe a
Nothing
      toInternal' ComponentButton {Bool
Maybe Emoji
Text
ButtonStyle
componentButtonEmoji :: Maybe Emoji
componentButtonLabel :: Text
componentButtonStyle :: ButtonStyle
componentButtonDisabled :: Bool
componentButtonCustomId :: Text
componentButtonEmoji :: ComponentButton -> Maybe Emoji
componentButtonLabel :: ComponentButton -> Text
componentButtonStyle :: ComponentButton -> ButtonStyle
componentButtonDisabled :: ComponentButton -> Bool
componentButtonCustomId :: ComponentButton -> Text
..} = ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component ComponentType
ComponentTypeButton (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
componentButtonCustomId) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
componentButtonDisabled) (InternalButtonStyle -> Maybe InternalButtonStyle
forall a. a -> Maybe a
Just (ButtonStyle -> InternalButtonStyle
forall a b. Internals a b => a -> b
toInternal ButtonStyle
componentButtonStyle)) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
componentButtonLabel) Maybe Emoji
componentButtonEmoji Maybe Text
forall a. Maybe a
Nothing Maybe [SelectOption]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe [Component]
forall a. Maybe a
Nothing
  toInternal (ComponentActionRowSelectMenu ComponentSelectMenu {Bool
[SelectOption]
Maybe Integer
Maybe Text
Text
componentSelectMenuMaxValues :: Maybe Integer
componentSelectMenuMinValues :: Maybe Integer
componentSelectMenuPlaceholder :: Maybe Text
componentSelectMenuOptions :: [SelectOption]
componentSelectMenuDisabled :: Bool
componentSelectMenuCustomId :: Text
componentSelectMenuMaxValues :: ComponentSelectMenu -> Maybe Integer
componentSelectMenuMinValues :: ComponentSelectMenu -> Maybe Integer
componentSelectMenuPlaceholder :: ComponentSelectMenu -> Maybe Text
componentSelectMenuOptions :: ComponentSelectMenu -> [SelectOption]
componentSelectMenuDisabled :: ComponentSelectMenu -> Bool
componentSelectMenuCustomId :: ComponentSelectMenu -> Text
..}) = ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component ComponentType
ComponentTypeActionRow Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe InternalButtonStyle
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe [SelectOption]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing ([Component] -> Maybe [Component]
forall a. a -> Maybe a
Just [ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component ComponentType
ComponentTypeSelectMenu (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
componentSelectMenuCustomId) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
componentSelectMenuDisabled) Maybe InternalButtonStyle
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing ([SelectOption] -> Maybe [SelectOption]
forall a. a -> Maybe a
Just [SelectOption]
componentSelectMenuOptions) Maybe Text
componentSelectMenuPlaceholder Maybe Integer
componentSelectMenuMinValues Maybe Integer
componentSelectMenuMaxValues Maybe [Component]
forall a. Maybe a
Nothing])

  fromInternal :: Component -> Maybe ComponentActionRow
fromInternal Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeActionRow, componentComponents :: Component -> Maybe [Component]
componentComponents = (Just (Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeSelectMenu, Maybe Bool
Maybe Integer
Maybe [SelectOption]
Maybe [Component]
Maybe Text
Maybe Emoji
Maybe InternalButtonStyle
componentMaxValues :: Component -> Maybe Integer
componentMinValues :: Component -> Maybe Integer
componentPlaceholder :: Component -> Maybe Text
componentOptions :: Component -> Maybe [SelectOption]
componentUrl :: Component -> Maybe Text
componentEmoji :: Component -> Maybe Emoji
componentLabel :: Component -> Maybe Text
componentStyle :: Component -> Maybe InternalButtonStyle
componentDisabled :: Component -> Maybe Bool
componentCustomId :: Component -> Maybe Text
componentComponents :: Maybe [Component]
componentMaxValues :: Maybe Integer
componentMinValues :: Maybe Integer
componentPlaceholder :: Maybe Text
componentOptions :: Maybe [SelectOption]
componentUrl :: Maybe Text
componentEmoji :: Maybe Emoji
componentLabel :: Maybe Text
componentStyle :: Maybe InternalButtonStyle
componentDisabled :: Maybe Bool
componentCustomId :: Maybe Text
componentComponents :: Component -> Maybe [Component]
..} : [Component]
_))} = do
    Text
cid <- Maybe Text
componentCustomId
    Bool
cd <- Maybe Bool
componentDisabled
    [SelectOption]
co <- Maybe [SelectOption]
componentOptions
    ComponentActionRow -> Maybe ComponentActionRow
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentActionRow -> Maybe ComponentActionRow)
-> ComponentActionRow -> Maybe ComponentActionRow
forall a b. (a -> b) -> a -> b
$ ComponentSelectMenu -> ComponentActionRow
ComponentActionRowSelectMenu (ComponentSelectMenu -> ComponentActionRow)
-> ComponentSelectMenu -> ComponentActionRow
forall a b. (a -> b) -> a -> b
$ Text
-> Bool
-> [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> ComponentSelectMenu
ComponentSelectMenu Text
cid Bool
cd [SelectOption]
co Maybe Text
componentPlaceholder Maybe Integer
componentMinValues Maybe Integer
componentMaxValues
  fromInternal Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeActionRow, componentComponents :: Component -> Maybe [Component]
componentComponents = Maybe [Component]
compComps} = Maybe [Component]
compComps Maybe [Component]
-> ([Component] -> Maybe [ComponentButton])
-> Maybe [ComponentButton]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Component -> Maybe ComponentButton)
-> [Component] -> Maybe [ComponentButton]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Component -> Maybe ComponentButton
fromInternal' Maybe [ComponentButton]
-> ([ComponentButton] -> Maybe ComponentActionRow)
-> Maybe ComponentActionRow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ComponentActionRow -> Maybe ComponentActionRow
forall a. a -> Maybe a
Just (ComponentActionRow -> Maybe ComponentActionRow)
-> ([ComponentButton] -> ComponentActionRow)
-> [ComponentButton]
-> Maybe ComponentActionRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComponentButton] -> ComponentActionRow
ComponentActionRowButton
    where
      fromInternal' :: Component -> Maybe ComponentButton
fromInternal' Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeButton, componentStyle :: Component -> Maybe InternalButtonStyle
componentStyle = Just InternalButtonStyle
InternalButtonStyleLink, Maybe Bool
Maybe Integer
Maybe [SelectOption]
Maybe [Component]
Maybe Text
Maybe Emoji
componentComponents :: Maybe [Component]
componentMaxValues :: Maybe Integer
componentMinValues :: Maybe Integer
componentPlaceholder :: Maybe Text
componentOptions :: Maybe [SelectOption]
componentUrl :: Maybe Text
componentEmoji :: Maybe Emoji
componentLabel :: Maybe Text
componentDisabled :: Maybe Bool
componentCustomId :: Maybe Text
componentMaxValues :: Component -> Maybe Integer
componentMinValues :: Component -> Maybe Integer
componentPlaceholder :: Component -> Maybe Text
componentOptions :: Component -> Maybe [SelectOption]
componentUrl :: Component -> Maybe Text
componentEmoji :: Component -> Maybe Emoji
componentLabel :: Component -> Maybe Text
componentDisabled :: Component -> Maybe Bool
componentCustomId :: Component -> Maybe Text
componentComponents :: Component -> Maybe [Component]
..} = do
        Url 'Https
url <- Text -> Url 'Https
R.https (Text -> Url 'Https) -> Maybe Text -> Maybe (Url 'Https)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
componentUrl
        Text
label <- Maybe Text
componentLabel
        ComponentButton -> Maybe ComponentButton
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentButton -> Maybe ComponentButton)
-> ComponentButton -> Maybe ComponentButton
forall a b. (a -> b) -> a -> b
$ Url 'Https -> Bool -> Text -> Maybe Emoji -> ComponentButton
ComponentButtonUrl Url 'Https
url (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
componentDisabled) Text
label Maybe Emoji
componentEmoji
      fromInternal' Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeButton, Maybe Bool
Maybe Integer
Maybe [SelectOption]
Maybe [Component]
Maybe Text
Maybe Emoji
Maybe InternalButtonStyle
componentComponents :: Maybe [Component]
componentMaxValues :: Maybe Integer
componentMinValues :: Maybe Integer
componentPlaceholder :: Maybe Text
componentOptions :: Maybe [SelectOption]
componentUrl :: Maybe Text
componentEmoji :: Maybe Emoji
componentLabel :: Maybe Text
componentStyle :: Maybe InternalButtonStyle
componentDisabled :: Maybe Bool
componentCustomId :: Maybe Text
componentMaxValues :: Component -> Maybe Integer
componentMinValues :: Component -> Maybe Integer
componentPlaceholder :: Component -> Maybe Text
componentOptions :: Component -> Maybe [SelectOption]
componentUrl :: Component -> Maybe Text
componentEmoji :: Component -> Maybe Emoji
componentLabel :: Component -> Maybe Text
componentStyle :: Component -> Maybe InternalButtonStyle
componentDisabled :: Component -> Maybe Bool
componentCustomId :: Component -> Maybe Text
componentComponents :: Component -> Maybe [Component]
..} = do
        Text
customId <- Maybe Text
componentCustomId
        Text
label <- Maybe Text
componentLabel
        ButtonStyle
style <- Maybe InternalButtonStyle
componentStyle Maybe InternalButtonStyle
-> (InternalButtonStyle -> Maybe ButtonStyle) -> Maybe ButtonStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InternalButtonStyle -> Maybe ButtonStyle
forall a b. Internals a b => b -> Maybe a
fromInternal
        ComponentButton -> Maybe ComponentButton
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentButton -> Maybe ComponentButton)
-> ComponentButton -> Maybe ComponentButton
forall a b. (a -> b) -> a -> b
$ Text
-> Bool -> ButtonStyle -> Text -> Maybe Emoji -> ComponentButton
ComponentButton Text
customId (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
componentDisabled) ButtonStyle
style Text
label Maybe Emoji
componentEmoji
      fromInternal' Component
_ = Maybe ComponentButton
forall a. Maybe a
Nothing
  fromInternal Component
_ = Maybe ComponentActionRow
forall a. Maybe a
Nothing

data Component = Component
  { Component -> ComponentType
componentType :: ComponentType,
    -- | Buttons and Select Menus only
    Component -> Maybe Text
componentCustomId :: Maybe T.Text,
    -- | Buttons and Select Menus only
    Component -> Maybe Bool
componentDisabled :: Maybe Bool,
    -- | Button only
    Component -> Maybe InternalButtonStyle
componentStyle :: Maybe InternalButtonStyle,
    -- | Button only
    Component -> Maybe Text
componentLabel :: Maybe T.Text,
    -- | Button only
    Component -> Maybe Emoji
componentEmoji :: Maybe Emoji,
    -- | Button only, link buttons only
    Component -> Maybe Text
componentUrl :: Maybe T.Text,
    -- | Select Menus only, max 25
    Component -> Maybe [SelectOption]
componentOptions :: Maybe [SelectOption],
    -- | Select Menus only, max 100 chars
    Component -> Maybe Text
componentPlaceholder :: Maybe T.Text,
    -- | Select Menus only, min values to choose, default 1
    Component -> Maybe Integer
componentMinValues :: Maybe Integer,
    -- | Select Menus only, max values to choose, default 1
    Component -> Maybe Integer
componentMaxValues :: Maybe Integer,
    -- | Action Rows only
    Component -> Maybe [Component]
componentComponents :: Maybe [Component]
  }
  deriving (Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show, Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Eq Component
Eq Component
-> (Component -> Component -> Ordering)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Component)
-> (Component -> Component -> Component)
-> Ord Component
Component -> Component -> Bool
Component -> Component -> Ordering
Component -> Component -> Component
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 :: Component -> Component -> Component
$cmin :: Component -> Component -> Component
max :: Component -> Component -> Component
$cmax :: Component -> Component -> Component
>= :: Component -> Component -> Bool
$c>= :: Component -> Component -> Bool
> :: Component -> Component -> Bool
$c> :: Component -> Component -> Bool
<= :: Component -> Component -> Bool
$c<= :: Component -> Component -> Bool
< :: Component -> Component -> Bool
$c< :: Component -> Component -> Bool
compare :: Component -> Component -> Ordering
$ccompare :: Component -> Component -> Ordering
$cp1Ord :: Eq Component
Ord, ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [Component]
(Int -> ReadS Component)
-> ReadS [Component]
-> ReadPrec Component
-> ReadPrec [Component]
-> Read Component
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Component]
$creadListPrec :: ReadPrec [Component]
readPrec :: ReadPrec Component
$creadPrec :: ReadPrec Component
readList :: ReadS [Component]
$creadList :: ReadS [Component]
readsPrec :: Int -> ReadS Component
$creadsPrec :: Int -> ReadS Component
Read)

instance FromJSON Component where
  parseJSON :: Value -> Parser Component
parseJSON = String -> (Object -> Parser Component) -> Value -> Parser Component
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Component" ((Object -> Parser Component) -> Value -> Parser Component)
-> (Object -> Parser Component) -> Value -> Parser Component
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ComponentType
-> Maybe Text
-> Maybe Bool
-> Maybe InternalButtonStyle
-> Maybe Text
-> Maybe Emoji
-> Maybe Text
-> Maybe [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe [Component]
-> Component
Component (ComponentType
 -> Maybe Text
 -> Maybe Bool
 -> Maybe InternalButtonStyle
 -> Maybe Text
 -> Maybe Emoji
 -> Maybe Text
 -> Maybe [SelectOption]
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe [Component]
 -> Component)
-> Parser ComponentType
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe InternalButtonStyle
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ComponentType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe InternalButtonStyle
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe InternalButtonStyle
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_id"
      Parser
  (Maybe Bool
   -> Maybe InternalButtonStyle
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Bool)
-> Parser
     (Maybe InternalButtonStyle
      -> Maybe Text
      -> Maybe Emoji
      -> Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled"
      Parser
  (Maybe InternalButtonStyle
   -> Maybe Text
   -> Maybe Emoji
   -> Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe InternalButtonStyle)
-> Parser
     (Maybe Text
      -> Maybe Emoji
      -> Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe InternalButtonStyle)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
      Parser
  (Maybe Text
   -> Maybe Emoji
   -> Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Text)
-> Parser
     (Maybe Emoji
      -> Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"
      Parser
  (Maybe Emoji
   -> Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Emoji)
-> Parser
     (Maybe Text
      -> Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      Parser
  (Maybe Text
   -> Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Text)
-> Parser
     (Maybe [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
      Parser
  (Maybe [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe [SelectOption])
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe [Component]
      -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [SelectOption])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe [Component]
   -> Component)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer -> Maybe Integer -> Maybe [Component] -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placeholder"
      Parser
  (Maybe Integer -> Maybe Integer -> Maybe [Component] -> Component)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe [Component] -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min_values"
      Parser (Maybe Integer -> Maybe [Component] -> Component)
-> Parser (Maybe Integer)
-> Parser (Maybe [Component] -> Component)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_values"
      Parser (Maybe [Component] -> Component)
-> Parser (Maybe [Component]) -> Parser Component
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Component])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"components"

instance ToJSON Component where
  toJSON :: Component -> Value
toJSON Component {Maybe Bool
Maybe Integer
Maybe [SelectOption]
Maybe [Component]
Maybe Text
Maybe Emoji
Maybe InternalButtonStyle
ComponentType
componentComponents :: Maybe [Component]
componentMaxValues :: Maybe Integer
componentMinValues :: Maybe Integer
componentPlaceholder :: Maybe Text
componentOptions :: Maybe [SelectOption]
componentUrl :: Maybe Text
componentEmoji :: Maybe Emoji
componentLabel :: Maybe Text
componentStyle :: Maybe InternalButtonStyle
componentDisabled :: Maybe Bool
componentCustomId :: Maybe Text
componentType :: ComponentType
componentMaxValues :: Component -> Maybe Integer
componentMinValues :: Component -> Maybe Integer
componentPlaceholder :: Component -> Maybe Text
componentOptions :: Component -> Maybe [SelectOption]
componentUrl :: Component -> Maybe Text
componentEmoji :: Component -> Maybe Emoji
componentLabel :: Component -> Maybe Text
componentStyle :: Component -> Maybe InternalButtonStyle
componentDisabled :: Component -> Maybe Bool
componentCustomId :: Component -> Maybe Text
componentComponents :: Component -> Maybe [Component]
componentType :: Component -> ComponentType
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"type", ComponentType -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON ComponentType
componentType),
              (Key
"custom_id", 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
componentCustomId),
              (Key
"disabled", 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
componentDisabled),
              (Key
"style", InternalButtonStyle -> Value
forall a. ToJSON a => a -> Value
toJSON (InternalButtonStyle -> Value)
-> Maybe InternalButtonStyle -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe InternalButtonStyle
componentStyle),
              (Key
"label", 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
componentLabel),
              (Key
"emoji", Emoji -> Value
forall a. ToJSON a => a -> Value
toJSON (Emoji -> Value) -> Maybe Emoji -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Emoji
componentEmoji),
              (Key
"url", 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
componentUrl),
              (Key
"options", [SelectOption] -> Value
forall a. ToJSON a => a -> Value
toJSON ([SelectOption] -> Value) -> Maybe [SelectOption] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [SelectOption]
componentOptions),
              (Key
"placeholder", 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
componentPlaceholder),
              (Key
"min_values", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentMinValues),
              (Key
"max_values", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
componentMaxValues),
              (Key
"components", [Component] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Component] -> Value) -> Maybe [Component] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Component]
componentComponents)
            ]
      ]

-- | The different types of components
data ComponentType
  = -- | A container for other components
    ComponentTypeActionRow
  | -- | A button
    ComponentTypeButton
  | -- | A select menu for picking from choices
    ComponentTypeSelectMenu
  deriving (Int -> ComponentType -> ShowS
[ComponentType] -> ShowS
ComponentType -> String
(Int -> ComponentType -> ShowS)
-> (ComponentType -> String)
-> ([ComponentType] -> ShowS)
-> Show ComponentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentType] -> ShowS
$cshowList :: [ComponentType] -> ShowS
show :: ComponentType -> String
$cshow :: ComponentType -> String
showsPrec :: Int -> ComponentType -> ShowS
$cshowsPrec :: Int -> ComponentType -> ShowS
Show, ReadPrec [ComponentType]
ReadPrec ComponentType
Int -> ReadS ComponentType
ReadS [ComponentType]
(Int -> ReadS ComponentType)
-> ReadS [ComponentType]
-> ReadPrec ComponentType
-> ReadPrec [ComponentType]
-> Read ComponentType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentType]
$creadListPrec :: ReadPrec [ComponentType]
readPrec :: ReadPrec ComponentType
$creadPrec :: ReadPrec ComponentType
readList :: ReadS [ComponentType]
$creadList :: ReadS [ComponentType]
readsPrec :: Int -> ReadS ComponentType
$creadsPrec :: Int -> ReadS ComponentType
Read, ComponentType -> ComponentType -> Bool
(ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool) -> Eq ComponentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentType -> ComponentType -> Bool
$c/= :: ComponentType -> ComponentType -> Bool
== :: ComponentType -> ComponentType -> Bool
$c== :: ComponentType -> ComponentType -> Bool
Eq, Eq ComponentType
Eq ComponentType
-> (ComponentType -> ComponentType -> Ordering)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> Bool)
-> (ComponentType -> ComponentType -> ComponentType)
-> (ComponentType -> ComponentType -> ComponentType)
-> Ord ComponentType
ComponentType -> ComponentType -> Bool
ComponentType -> ComponentType -> Ordering
ComponentType -> ComponentType -> ComponentType
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 :: ComponentType -> ComponentType -> ComponentType
$cmin :: ComponentType -> ComponentType -> ComponentType
max :: ComponentType -> ComponentType -> ComponentType
$cmax :: ComponentType -> ComponentType -> ComponentType
>= :: ComponentType -> ComponentType -> Bool
$c>= :: ComponentType -> ComponentType -> Bool
> :: ComponentType -> ComponentType -> Bool
$c> :: ComponentType -> ComponentType -> Bool
<= :: ComponentType -> ComponentType -> Bool
$c<= :: ComponentType -> ComponentType -> Bool
< :: ComponentType -> ComponentType -> Bool
$c< :: ComponentType -> ComponentType -> Bool
compare :: ComponentType -> ComponentType -> Ordering
$ccompare :: ComponentType -> ComponentType -> Ordering
$cp1Ord :: Eq ComponentType
Ord, Typeable ComponentType
DataType
Constr
Typeable ComponentType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ComponentType -> c ComponentType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ComponentType)
-> (ComponentType -> Constr)
-> (ComponentType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ComponentType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ComponentType))
-> ((forall b. Data b => b -> b) -> ComponentType -> ComponentType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ComponentType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ComponentType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ComponentType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ComponentType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType)
-> Data ComponentType
ComponentType -> DataType
ComponentType -> Constr
(forall b. Data b => b -> b) -> ComponentType -> ComponentType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComponentType -> c ComponentType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComponentType
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) -> ComponentType -> u
forall u. (forall d. Data d => d -> u) -> ComponentType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComponentType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComponentType -> c ComponentType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComponentType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComponentType)
$cComponentTypeSelectMenu :: Constr
$cComponentTypeButton :: Constr
$cComponentTypeActionRow :: Constr
$tComponentType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
gmapMp :: (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
gmapM :: (forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ComponentType -> m ComponentType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ComponentType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ComponentType -> u
gmapQ :: (forall d. Data d => d -> u) -> ComponentType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ComponentType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComponentType -> r
gmapT :: (forall b. Data b => b -> b) -> ComponentType -> ComponentType
$cgmapT :: (forall b. Data b => b -> b) -> ComponentType -> ComponentType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComponentType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComponentType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ComponentType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComponentType)
dataTypeOf :: ComponentType -> DataType
$cdataTypeOf :: ComponentType -> DataType
toConstr :: ComponentType -> Constr
$ctoConstr :: ComponentType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComponentType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComponentType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComponentType -> c ComponentType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComponentType -> c ComponentType
$cp1Data :: Typeable ComponentType
Data)

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

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

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

data InternalButtonStyle
  = -- | Blurple button
    InternalButtonStylePrimary
  | -- | Grey button
    InternalButtonStyleSecondary
  | -- | Green button
    InternalButtonStyleSuccess
  | -- | Red button
    InternalButtonStyleDanger
  | -- | Grey button, navigates to URL
    InternalButtonStyleLink
  deriving (Int -> InternalButtonStyle -> ShowS
[InternalButtonStyle] -> ShowS
InternalButtonStyle -> String
(Int -> InternalButtonStyle -> ShowS)
-> (InternalButtonStyle -> String)
-> ([InternalButtonStyle] -> ShowS)
-> Show InternalButtonStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalButtonStyle] -> ShowS
$cshowList :: [InternalButtonStyle] -> ShowS
show :: InternalButtonStyle -> String
$cshow :: InternalButtonStyle -> String
showsPrec :: Int -> InternalButtonStyle -> ShowS
$cshowsPrec :: Int -> InternalButtonStyle -> ShowS
Show, ReadPrec [InternalButtonStyle]
ReadPrec InternalButtonStyle
Int -> ReadS InternalButtonStyle
ReadS [InternalButtonStyle]
(Int -> ReadS InternalButtonStyle)
-> ReadS [InternalButtonStyle]
-> ReadPrec InternalButtonStyle
-> ReadPrec [InternalButtonStyle]
-> Read InternalButtonStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalButtonStyle]
$creadListPrec :: ReadPrec [InternalButtonStyle]
readPrec :: ReadPrec InternalButtonStyle
$creadPrec :: ReadPrec InternalButtonStyle
readList :: ReadS [InternalButtonStyle]
$creadList :: ReadS [InternalButtonStyle]
readsPrec :: Int -> ReadS InternalButtonStyle
$creadsPrec :: Int -> ReadS InternalButtonStyle
Read, InternalButtonStyle -> InternalButtonStyle -> Bool
(InternalButtonStyle -> InternalButtonStyle -> Bool)
-> (InternalButtonStyle -> InternalButtonStyle -> Bool)
-> Eq InternalButtonStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c/= :: InternalButtonStyle -> InternalButtonStyle -> Bool
== :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c== :: InternalButtonStyle -> InternalButtonStyle -> Bool
Eq, Eq InternalButtonStyle
Eq InternalButtonStyle
-> (InternalButtonStyle -> InternalButtonStyle -> Ordering)
-> (InternalButtonStyle -> InternalButtonStyle -> Bool)
-> (InternalButtonStyle -> InternalButtonStyle -> Bool)
-> (InternalButtonStyle -> InternalButtonStyle -> Bool)
-> (InternalButtonStyle -> InternalButtonStyle -> Bool)
-> (InternalButtonStyle
    -> InternalButtonStyle -> InternalButtonStyle)
-> (InternalButtonStyle
    -> InternalButtonStyle -> InternalButtonStyle)
-> Ord InternalButtonStyle
InternalButtonStyle -> InternalButtonStyle -> Bool
InternalButtonStyle -> InternalButtonStyle -> Ordering
InternalButtonStyle -> InternalButtonStyle -> InternalButtonStyle
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 :: InternalButtonStyle -> InternalButtonStyle -> InternalButtonStyle
$cmin :: InternalButtonStyle -> InternalButtonStyle -> InternalButtonStyle
max :: InternalButtonStyle -> InternalButtonStyle -> InternalButtonStyle
$cmax :: InternalButtonStyle -> InternalButtonStyle -> InternalButtonStyle
>= :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c>= :: InternalButtonStyle -> InternalButtonStyle -> Bool
> :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c> :: InternalButtonStyle -> InternalButtonStyle -> Bool
<= :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c<= :: InternalButtonStyle -> InternalButtonStyle -> Bool
< :: InternalButtonStyle -> InternalButtonStyle -> Bool
$c< :: InternalButtonStyle -> InternalButtonStyle -> Bool
compare :: InternalButtonStyle -> InternalButtonStyle -> Ordering
$ccompare :: InternalButtonStyle -> InternalButtonStyle -> Ordering
$cp1Ord :: Eq InternalButtonStyle
Ord, Typeable InternalButtonStyle
DataType
Constr
Typeable InternalButtonStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InternalButtonStyle
    -> c InternalButtonStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InternalButtonStyle)
-> (InternalButtonStyle -> Constr)
-> (InternalButtonStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InternalButtonStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InternalButtonStyle))
-> ((forall b. Data b => b -> b)
    -> InternalButtonStyle -> InternalButtonStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InternalButtonStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InternalButtonStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InternalButtonStyle -> m InternalButtonStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InternalButtonStyle -> m InternalButtonStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InternalButtonStyle -> m InternalButtonStyle)
-> Data InternalButtonStyle
InternalButtonStyle -> DataType
InternalButtonStyle -> Constr
(forall b. Data b => b -> b)
-> InternalButtonStyle -> InternalButtonStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalButtonStyle
-> c InternalButtonStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalButtonStyle
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) -> InternalButtonStyle -> u
forall u.
(forall d. Data d => d -> u) -> InternalButtonStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalButtonStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalButtonStyle
-> c InternalButtonStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InternalButtonStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalButtonStyle)
$cInternalButtonStyleLink :: Constr
$cInternalButtonStyleDanger :: Constr
$cInternalButtonStyleSuccess :: Constr
$cInternalButtonStyleSecondary :: Constr
$cInternalButtonStylePrimary :: Constr
$tInternalButtonStyle :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
gmapMp :: (forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
gmapM :: (forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InternalButtonStyle -> m InternalButtonStyle
gmapQi :: Int -> (forall d. Data d => d -> u) -> InternalButtonStyle -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InternalButtonStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> InternalButtonStyle -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> InternalButtonStyle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InternalButtonStyle -> r
gmapT :: (forall b. Data b => b -> b)
-> InternalButtonStyle -> InternalButtonStyle
$cgmapT :: (forall b. Data b => b -> b)
-> InternalButtonStyle -> InternalButtonStyle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalButtonStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InternalButtonStyle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InternalButtonStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InternalButtonStyle)
dataTypeOf :: InternalButtonStyle -> DataType
$cdataTypeOf :: InternalButtonStyle -> DataType
toConstr :: InternalButtonStyle -> Constr
$ctoConstr :: InternalButtonStyle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalButtonStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InternalButtonStyle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalButtonStyle
-> c InternalButtonStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> InternalButtonStyle
-> c InternalButtonStyle
$cp1Data :: Typeable InternalButtonStyle
Data)

instance Enum InternalButtonStyle where
  fromEnum :: InternalButtonStyle -> Int
fromEnum InternalButtonStyle
InternalButtonStylePrimary = Int
1
  fromEnum InternalButtonStyle
InternalButtonStyleSecondary = Int
2
  fromEnum InternalButtonStyle
InternalButtonStyleSuccess = Int
3
  fromEnum InternalButtonStyle
InternalButtonStyleDanger = Int
4
  fromEnum InternalButtonStyle
InternalButtonStyleLink = Int
5
  toEnum :: Int -> InternalButtonStyle
toEnum Int
a = Maybe InternalButtonStyle -> InternalButtonStyle
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InternalButtonStyle -> InternalButtonStyle)
-> Maybe InternalButtonStyle -> InternalButtonStyle
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, InternalButtonStyle)] -> Maybe InternalButtonStyle
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, InternalButtonStyle)]
table
    where
      table :: [(Int, InternalButtonStyle)]
table = InternalButtonStyle -> [(Int, InternalButtonStyle)]
forall t. (Data t, Enum t) => t -> [(Int, t)]
makeTable InternalButtonStyle
InternalButtonStylePrimary

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

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

-- | Represents an emoticon (emoji)
data Emoji = Emoji
  { -- | The emoji id
    Emoji -> Maybe RoleId
emojiId :: Maybe EmojiId,
    -- | The emoji name
    Emoji -> Text
emojiName :: T.Text,
    -- | Roles the emoji is active for
    Emoji -> Maybe [RoleId]
emojiRoles :: Maybe [RoleId],
    -- | User that created this emoji
    Emoji -> Maybe User
emojiUser :: Maybe User,
    -- | Whether this emoji is managed
    Emoji -> Maybe Bool
emojiManaged :: Maybe Bool,
    -- | Whether this emoji is animated
    Emoji -> Maybe Bool
emojiAnimated :: Maybe Bool
  }
  deriving (Int -> Emoji -> ShowS
[Emoji] -> ShowS
Emoji -> String
(Int -> Emoji -> ShowS)
-> (Emoji -> String) -> ([Emoji] -> ShowS) -> Show Emoji
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emoji] -> ShowS
$cshowList :: [Emoji] -> ShowS
show :: Emoji -> String
$cshow :: Emoji -> String
showsPrec :: Int -> Emoji -> ShowS
$cshowsPrec :: Int -> Emoji -> ShowS
Show, ReadPrec [Emoji]
ReadPrec Emoji
Int -> ReadS Emoji
ReadS [Emoji]
(Int -> ReadS Emoji)
-> ReadS [Emoji]
-> ReadPrec Emoji
-> ReadPrec [Emoji]
-> Read Emoji
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Emoji]
$creadListPrec :: ReadPrec [Emoji]
readPrec :: ReadPrec Emoji
$creadPrec :: ReadPrec Emoji
readList :: ReadS [Emoji]
$creadList :: ReadS [Emoji]
readsPrec :: Int -> ReadS Emoji
$creadsPrec :: Int -> ReadS Emoji
Read, Emoji -> Emoji -> Bool
(Emoji -> Emoji -> Bool) -> (Emoji -> Emoji -> Bool) -> Eq Emoji
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Emoji -> Emoji -> Bool
$c/= :: Emoji -> Emoji -> Bool
== :: Emoji -> Emoji -> Bool
$c== :: Emoji -> Emoji -> Bool
Eq, Eq Emoji
Eq Emoji
-> (Emoji -> Emoji -> Ordering)
-> (Emoji -> Emoji -> Bool)
-> (Emoji -> Emoji -> Bool)
-> (Emoji -> Emoji -> Bool)
-> (Emoji -> Emoji -> Bool)
-> (Emoji -> Emoji -> Emoji)
-> (Emoji -> Emoji -> Emoji)
-> Ord Emoji
Emoji -> Emoji -> Bool
Emoji -> Emoji -> Ordering
Emoji -> Emoji -> Emoji
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 :: Emoji -> Emoji -> Emoji
$cmin :: Emoji -> Emoji -> Emoji
max :: Emoji -> Emoji -> Emoji
$cmax :: Emoji -> Emoji -> Emoji
>= :: Emoji -> Emoji -> Bool
$c>= :: Emoji -> Emoji -> Bool
> :: Emoji -> Emoji -> Bool
$c> :: Emoji -> Emoji -> Bool
<= :: Emoji -> Emoji -> Bool
$c<= :: Emoji -> Emoji -> Bool
< :: Emoji -> Emoji -> Bool
$c< :: Emoji -> Emoji -> Bool
compare :: Emoji -> Emoji -> Ordering
$ccompare :: Emoji -> Emoji -> Ordering
$cp1Ord :: Eq Emoji
Ord)

instance FromJSON Emoji where
  parseJSON :: Value -> Parser Emoji
parseJSON = String -> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Emoji" ((Object -> Parser Emoji) -> Value -> Parser Emoji)
-> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe RoleId
-> Text
-> Maybe [RoleId]
-> Maybe User
-> Maybe Bool
-> Maybe Bool
-> Emoji
Emoji (Maybe RoleId
 -> Text
 -> Maybe [RoleId]
 -> Maybe User
 -> Maybe Bool
 -> Maybe Bool
 -> Emoji)
-> Parser (Maybe RoleId)
-> Parser
     (Text
      -> Maybe [RoleId]
      -> Maybe User
      -> Maybe Bool
      -> Maybe Bool
      -> Emoji)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe RoleId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
      Parser
  (Text
   -> Maybe [RoleId]
   -> Maybe User
   -> Maybe Bool
   -> Maybe Bool
   -> Emoji)
-> Parser Text
-> Parser
     (Maybe [RoleId] -> Maybe User -> Maybe Bool -> Maybe Bool -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Maybe [RoleId] -> Maybe User -> Maybe Bool -> Maybe Bool -> Emoji)
-> Parser (Maybe [RoleId])
-> Parser (Maybe User -> Maybe Bool -> Maybe Bool -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [RoleId])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
      Parser (Maybe User -> Maybe Bool -> Maybe Bool -> Emoji)
-> Parser (Maybe User)
-> Parser (Maybe Bool -> Maybe Bool -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user"
      Parser (Maybe Bool -> Maybe Bool -> Emoji)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> Emoji)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"managed"
      Parser (Maybe Bool -> Emoji) -> Parser (Maybe Bool) -> Parser Emoji
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"animated"

instance ToJSON Emoji where
  toJSON :: Emoji -> Value
toJSON Emoji {Maybe Bool
Maybe [RoleId]
Maybe RoleId
Maybe User
Text
emojiAnimated :: Maybe Bool
emojiManaged :: Maybe Bool
emojiUser :: Maybe User
emojiRoles :: Maybe [RoleId]
emojiName :: Text
emojiId :: Maybe RoleId
emojiAnimated :: Emoji -> Maybe Bool
emojiManaged :: Emoji -> Maybe Bool
emojiUser :: Emoji -> Maybe User
emojiRoles :: Emoji -> Maybe [RoleId]
emojiName :: Emoji -> Text
emojiId :: Emoji -> Maybe RoleId
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"id", RoleId -> Value
forall a. ToJSON a => a -> Value
toJSON (RoleId -> Value) -> Maybe RoleId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RoleId
emojiId),
              (Key
"name", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
emojiName),
              (Key
"roles", [RoleId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([RoleId] -> Value) -> Maybe [RoleId] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [RoleId]
emojiRoles),
              (Key
"user", User -> Value
forall a. ToJSON a => a -> Value
toJSON (User -> Value) -> Maybe User -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe User
emojiUser),
              (Key
"managed", 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
emojiManaged),
              (Key
"animated", 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
emojiAnimated)
            ]
      ]

data SelectOption = SelectOption
  { -- | User facing option name
    SelectOption -> Text
selectOptionLabel :: T.Text,
    -- | Dev facing option value
    SelectOption -> Text
selectOptionValue :: T.Text,
    -- | additional description
    SelectOption -> Maybe Text
selectOptionDescription :: Maybe T.Text,
    -- | A partial emoji to show with the object (id, name, animated)
    SelectOption -> Maybe Emoji
selectOptionEmoji :: Maybe Emoji,
    -- | Use this value by default
    SelectOption -> Maybe Bool
selectOptionDefault :: Maybe Bool
  }
  deriving (Int -> SelectOption -> ShowS
[SelectOption] -> ShowS
SelectOption -> String
(Int -> SelectOption -> ShowS)
-> (SelectOption -> String)
-> ([SelectOption] -> ShowS)
-> Show SelectOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectOption] -> ShowS
$cshowList :: [SelectOption] -> ShowS
show :: SelectOption -> String
$cshow :: SelectOption -> String
showsPrec :: Int -> SelectOption -> ShowS
$cshowsPrec :: Int -> SelectOption -> ShowS
Show, SelectOption -> SelectOption -> Bool
(SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool) -> Eq SelectOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectOption -> SelectOption -> Bool
$c/= :: SelectOption -> SelectOption -> Bool
== :: SelectOption -> SelectOption -> Bool
$c== :: SelectOption -> SelectOption -> Bool
Eq, Eq SelectOption
Eq SelectOption
-> (SelectOption -> SelectOption -> Ordering)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> Bool)
-> (SelectOption -> SelectOption -> SelectOption)
-> (SelectOption -> SelectOption -> SelectOption)
-> Ord SelectOption
SelectOption -> SelectOption -> Bool
SelectOption -> SelectOption -> Ordering
SelectOption -> SelectOption -> SelectOption
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 :: SelectOption -> SelectOption -> SelectOption
$cmin :: SelectOption -> SelectOption -> SelectOption
max :: SelectOption -> SelectOption -> SelectOption
$cmax :: SelectOption -> SelectOption -> SelectOption
>= :: SelectOption -> SelectOption -> Bool
$c>= :: SelectOption -> SelectOption -> Bool
> :: SelectOption -> SelectOption -> Bool
$c> :: SelectOption -> SelectOption -> Bool
<= :: SelectOption -> SelectOption -> Bool
$c<= :: SelectOption -> SelectOption -> Bool
< :: SelectOption -> SelectOption -> Bool
$c< :: SelectOption -> SelectOption -> Bool
compare :: SelectOption -> SelectOption -> Ordering
$ccompare :: SelectOption -> SelectOption -> Ordering
$cp1Ord :: Eq SelectOption
Ord, ReadPrec [SelectOption]
ReadPrec SelectOption
Int -> ReadS SelectOption
ReadS [SelectOption]
(Int -> ReadS SelectOption)
-> ReadS [SelectOption]
-> ReadPrec SelectOption
-> ReadPrec [SelectOption]
-> Read SelectOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelectOption]
$creadListPrec :: ReadPrec [SelectOption]
readPrec :: ReadPrec SelectOption
$creadPrec :: ReadPrec SelectOption
readList :: ReadS [SelectOption]
$creadList :: ReadS [SelectOption]
readsPrec :: Int -> ReadS SelectOption
$creadsPrec :: Int -> ReadS SelectOption
Read)

instance FromJSON SelectOption where
  parseJSON :: Value -> Parser SelectOption
parseJSON = String
-> (Object -> Parser SelectOption) -> Value -> Parser SelectOption
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SelectOption" ((Object -> Parser SelectOption) -> Value -> Parser SelectOption)
-> (Object -> Parser SelectOption) -> Value -> Parser SelectOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption
SelectOption (Text
 -> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser Text
-> Parser
     (Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
      Parser
  (Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser Text
-> Parser (Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Parser (Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser (Maybe Text)
-> Parser (Maybe Emoji -> Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Maybe Emoji -> Maybe Bool -> SelectOption)
-> Parser (Maybe Emoji) -> Parser (Maybe Bool -> SelectOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emoji"
      Parser (Maybe Bool -> SelectOption)
-> Parser (Maybe Bool) -> Parser SelectOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default"

instance ToJSON SelectOption where
  toJSON :: SelectOption -> Value
toJSON SelectOption {Maybe Bool
Maybe Text
Maybe Emoji
Text
selectOptionDefault :: Maybe Bool
selectOptionEmoji :: Maybe Emoji
selectOptionDescription :: Maybe Text
selectOptionValue :: Text
selectOptionLabel :: Text
selectOptionDefault :: SelectOption -> Maybe Bool
selectOptionEmoji :: SelectOption -> Maybe Emoji
selectOptionDescription :: SelectOption -> Maybe Text
selectOptionValue :: SelectOption -> Text
selectOptionLabel :: SelectOption -> Text
..} =
    [Pair] -> Value
object
      [ (Key
name, Value
value)
        | (Key
name, Just Value
value) <-
            [ (Key
"label", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionLabel),
              (Key
"value", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionValue),
              (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
selectOptionDescription),
              (Key
"emoji", Emoji -> Value
forall a. ToJSON a => a -> Value
toJSON (Emoji -> Value) -> Maybe Emoji -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Emoji
selectOptionEmoji),
              (Key
"default", 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
selectOptionDefault)
            ]
      ]

filterOutIncorrectEmoji :: Component -> Component
filterOutIncorrectEmoji :: Component -> Component
filterOutIncorrectEmoji c :: Component
c@Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeActionRow, componentComponents :: Component -> Maybe [Component]
componentComponents = (Just [Component]
cs)} = Component
c {componentComponents :: Maybe [Component]
componentComponents = [Component] -> Maybe [Component]
forall a. a -> Maybe a
Just (Component -> Component
filterOutIncorrectEmoji (Component -> Component) -> [Component] -> [Component]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Component]
cs)}
filterOutIncorrectEmoji c :: Component
c@Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeSelectMenu, componentOptions :: Component -> Maybe [SelectOption]
componentOptions = (Just [SelectOption]
os)} = Component
c {componentOptions :: Maybe [SelectOption]
componentOptions = [SelectOption] -> Maybe [SelectOption]
forall a. a -> Maybe a
Just ((\SelectOption
so -> SelectOption
so {selectOptionEmoji :: Maybe Emoji
selectOptionEmoji = SelectOption -> Maybe Emoji
selectOptionEmoji SelectOption
so Maybe Emoji -> (Emoji -> Maybe Emoji) -> Maybe Emoji
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Emoji -> Maybe Emoji
validPartialEmoji}) (SelectOption -> SelectOption) -> [SelectOption] -> [SelectOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SelectOption]
os)}
filterOutIncorrectEmoji c :: Component
c@Component {componentType :: Component -> ComponentType
componentType = ComponentType
ComponentTypeButton, componentEmoji :: Component -> Maybe Emoji
componentEmoji = (Just Emoji
e)} = Component
c {componentEmoji :: Maybe Emoji
componentEmoji = Emoji -> Maybe Emoji
validPartialEmoji Emoji
e}
filterOutIncorrectEmoji Component
c = Component
c