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

-- | Message components
module Discord.Internal.Types.Components
  ( ActionRow (..),
    Button (..),
    ButtonStyle (..),
    mkButton,
    SelectMenu (..),
    mkSelectMenu,
    SelectOption (..),
    mkSelectOption,
    TextInput (..),
    mkTextInput,
  )
where

import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Foldable (Foldable (toList))
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Discord.Internal.Types.Emoji (Emoji)
import Discord.Internal.Types.Prelude (toMaybeJSON)

-- | Container for other message Components
data ActionRow = ActionRowButtons [Button] | ActionRowSelectMenu SelectMenu
  deriving (Int -> ActionRow -> ShowS
[ActionRow] -> ShowS
ActionRow -> String
(Int -> ActionRow -> ShowS)
-> (ActionRow -> String)
-> ([ActionRow] -> ShowS)
-> Show ActionRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionRow] -> ShowS
$cshowList :: [ActionRow] -> ShowS
show :: ActionRow -> String
$cshow :: ActionRow -> String
showsPrec :: Int -> ActionRow -> ShowS
$cshowsPrec :: Int -> ActionRow -> ShowS
Show, ReadPrec [ActionRow]
ReadPrec ActionRow
Int -> ReadS ActionRow
ReadS [ActionRow]
(Int -> ReadS ActionRow)
-> ReadS [ActionRow]
-> ReadPrec ActionRow
-> ReadPrec [ActionRow]
-> Read ActionRow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActionRow]
$creadListPrec :: ReadPrec [ActionRow]
readPrec :: ReadPrec ActionRow
$creadPrec :: ReadPrec ActionRow
readList :: ReadS [ActionRow]
$creadList :: ReadS [ActionRow]
readsPrec :: Int -> ReadS ActionRow
$creadsPrec :: Int -> ReadS ActionRow
Read, ActionRow -> ActionRow -> Bool
(ActionRow -> ActionRow -> Bool)
-> (ActionRow -> ActionRow -> Bool) -> Eq ActionRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionRow -> ActionRow -> Bool
$c/= :: ActionRow -> ActionRow -> Bool
== :: ActionRow -> ActionRow -> Bool
$c== :: ActionRow -> ActionRow -> Bool
Eq, Eq ActionRow
Eq ActionRow
-> (ActionRow -> ActionRow -> Ordering)
-> (ActionRow -> ActionRow -> Bool)
-> (ActionRow -> ActionRow -> Bool)
-> (ActionRow -> ActionRow -> Bool)
-> (ActionRow -> ActionRow -> Bool)
-> (ActionRow -> ActionRow -> ActionRow)
-> (ActionRow -> ActionRow -> ActionRow)
-> Ord ActionRow
ActionRow -> ActionRow -> Bool
ActionRow -> ActionRow -> Ordering
ActionRow -> ActionRow -> ActionRow
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 :: ActionRow -> ActionRow -> ActionRow
$cmin :: ActionRow -> ActionRow -> ActionRow
max :: ActionRow -> ActionRow -> ActionRow
$cmax :: ActionRow -> ActionRow -> ActionRow
>= :: ActionRow -> ActionRow -> Bool
$c>= :: ActionRow -> ActionRow -> Bool
> :: ActionRow -> ActionRow -> Bool
$c> :: ActionRow -> ActionRow -> Bool
<= :: ActionRow -> ActionRow -> Bool
$c<= :: ActionRow -> ActionRow -> Bool
< :: ActionRow -> ActionRow -> Bool
$c< :: ActionRow -> ActionRow -> Bool
compare :: ActionRow -> ActionRow -> Ordering
$ccompare :: ActionRow -> ActionRow -> Ordering
$cp1Ord :: Eq ActionRow
Ord)

instance FromJSON ActionRow where
  parseJSON :: Value -> Parser ActionRow
parseJSON =
    String -> (Object -> Parser ActionRow) -> Value -> Parser ActionRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"ActionRow"
      ( \Object
cs -> do
          Int
t <- Object
cs Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
          case Int
t of
            Int
1 -> do
              Array
a <- Object
cs Object -> Text -> Parser Array
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"components" :: Parser Array
              let a' :: [Value]
a' = Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a
              case [Value]
a' of
                [] -> ActionRow -> Parser ActionRow
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionRow -> Parser ActionRow) -> ActionRow -> Parser ActionRow
forall a b. (a -> b) -> a -> b
$ [Button] -> ActionRow
ActionRowButtons []
                (Value
c : [Value]
_) ->
                  String -> (Object -> Parser ActionRow) -> Value -> Parser ActionRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
                    String
"ActionRow item"
                    ( \Object
v -> do
                        Int
t' <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
                        case Int
t' of
                          Int
2 -> [Button] -> ActionRow
ActionRowButtons ([Button] -> ActionRow) -> Parser [Button] -> Parser ActionRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Button) -> [Value] -> Parser [Button]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Button
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
a'
                          Int
3 -> SelectMenu -> ActionRow
ActionRowSelectMenu (SelectMenu -> ActionRow) -> Parser SelectMenu -> Parser ActionRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SelectMenu
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c
                          Int
_ -> String -> Parser ActionRow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActionRow) -> String -> Parser ActionRow
forall a b. (a -> b) -> a -> b
$ String
"unknown component type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t
                    )
                    Value
c
            Int
_ -> String -> Parser ActionRow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActionRow) -> String -> Parser ActionRow
forall a b. (a -> b) -> a -> b
$ String
"expected action row type (1), got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t
      )

instance ToJSON ActionRow where
  toJSON :: ActionRow -> Value
toJSON (ActionRowButtons [Button]
bs) = [Pair] -> Value
object [(Text
"type", Scientific -> Value
Number Scientific
1), (Text
"components", [Button] -> Value
forall a. ToJSON a => a -> Value
toJSON [Button]
bs)]
  toJSON (ActionRowSelectMenu SelectMenu
bs) = [Pair] -> Value
object [(Text
"type", Scientific -> Value
Number Scientific
1), (Text
"components", [SelectMenu] -> Value
forall a. ToJSON a => a -> Value
toJSON [SelectMenu
bs])]

-- | 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 Button
  = Button
      { -- | Dev indentifier
        Button -> Text
buttonCustomId :: T.Text,
        -- | Whether the button is disabled
        Button -> Bool
buttonDisabled :: Bool,
        -- | What is the style of the button
        Button -> ButtonStyle
buttonStyle :: ButtonStyle,
        -- | What is the user-facing label of the button
        Button -> Maybe Text
buttonLabel :: Maybe T.Text,
        -- | What emoji is displayed on the button
        Button -> Maybe Emoji
buttonEmoji :: Maybe Emoji
      }
  | ButtonUrl
      { -- | The url for the button. If this is not a valid url, everything will
        -- break
        Button -> Text
buttonUrl :: T.Text,
        -- | Whether the button is disabled
        buttonDisabled :: Bool,
        -- | What is the user-facing label of the button
        buttonLabel :: Maybe T.Text,
        -- | What emoji is displayed on the button
        buttonEmoji :: Maybe Emoji
      }
  deriving (Int -> Button -> ShowS
[Button] -> ShowS
Button -> String
(Int -> Button -> ShowS)
-> (Button -> String) -> ([Button] -> ShowS) -> Show Button
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Button] -> ShowS
$cshowList :: [Button] -> ShowS
show :: Button -> String
$cshow :: Button -> String
showsPrec :: Int -> Button -> ShowS
$cshowsPrec :: Int -> Button -> ShowS
Show, ReadPrec [Button]
ReadPrec Button
Int -> ReadS Button
ReadS [Button]
(Int -> ReadS Button)
-> ReadS [Button]
-> ReadPrec Button
-> ReadPrec [Button]
-> Read Button
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Button]
$creadListPrec :: ReadPrec [Button]
readPrec :: ReadPrec Button
$creadPrec :: ReadPrec Button
readList :: ReadS [Button]
$creadList :: ReadS [Button]
readsPrec :: Int -> ReadS Button
$creadsPrec :: Int -> ReadS Button
Read, Button -> Button -> Bool
(Button -> Button -> Bool)
-> (Button -> Button -> Bool) -> Eq Button
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Button -> Button -> Bool
$c/= :: Button -> Button -> Bool
== :: Button -> Button -> Bool
$c== :: Button -> Button -> Bool
Eq, Eq Button
Eq Button
-> (Button -> Button -> Ordering)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Bool)
-> (Button -> Button -> Button)
-> (Button -> Button -> Button)
-> Ord Button
Button -> Button -> Bool
Button -> Button -> Ordering
Button -> Button -> Button
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 :: Button -> Button -> Button
$cmin :: Button -> Button -> Button
max :: Button -> Button -> Button
$cmax :: Button -> Button -> Button
>= :: Button -> Button -> Bool
$c>= :: Button -> Button -> Bool
> :: Button -> Button -> Bool
$c> :: Button -> Button -> Bool
<= :: Button -> Button -> Bool
$c<= :: Button -> Button -> Bool
< :: Button -> Button -> Bool
$c< :: Button -> Button -> Bool
compare :: Button -> Button -> Ordering
$ccompare :: Button -> Button -> Ordering
$cp1Ord :: Eq Button
Ord)

-- | Takes the label and the custom id of the button that is to be generated.
mkButton :: T.Text -> T.Text -> Button
mkButton :: Text -> Text -> Button
mkButton Text
label Text
customId = Text -> Bool -> ButtonStyle -> Maybe Text -> Maybe Emoji -> Button
Button Text
customId Bool
False ButtonStyle
ButtonStyleSecondary (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
label) Maybe Emoji
forall a. Maybe a
Nothing

instance FromJSON Button where
  parseJSON :: Value -> Parser Button
parseJSON =
    String -> (Object -> Parser Button) -> Value -> Parser Button
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"Button"
      ( \Object
v -> do
          Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
          case Int
t of
            Int
2 -> do
              Bool
disabled <- Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"disabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
              Maybe Text
label <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"label"
              Maybe Emoji
partialEmoji <- Object
v Object -> Text -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"emoji"
              Scientific
style <- Object
v Object -> Text -> Parser Scientific
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"style" :: Parser Scientific
              case Scientific
style of
                Scientific
5 ->
                  Text -> Bool -> Maybe Text -> Maybe Emoji -> Button
ButtonUrl
                    (Text -> Bool -> Maybe Text -> Maybe Emoji -> Button)
-> Parser Text
-> Parser (Bool -> Maybe Text -> Maybe Emoji -> Button)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
                    Parser (Bool -> Maybe Text -> Maybe Emoji -> Button)
-> Parser Bool -> Parser (Maybe Text -> Maybe Emoji -> Button)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
disabled
                    Parser (Maybe Text -> Maybe Emoji -> Button)
-> Parser (Maybe Text) -> Parser (Maybe Emoji -> Button)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
label
                    Parser (Maybe Emoji -> Button)
-> Parser (Maybe Emoji) -> Parser Button
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Emoji -> Parser (Maybe Emoji)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Emoji
partialEmoji
                Scientific
_ ->
                  Text -> Bool -> ButtonStyle -> Maybe Text -> Maybe Emoji -> Button
Button
                    (Text
 -> Bool -> ButtonStyle -> Maybe Text -> Maybe Emoji -> Button)
-> Parser Text
-> Parser
     (Bool -> ButtonStyle -> Maybe Text -> Maybe Emoji -> Button)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"custom_id"
                    Parser (Bool -> ButtonStyle -> Maybe Text -> Maybe Emoji -> Button)
-> Parser Bool
-> Parser (ButtonStyle -> Maybe Text -> Maybe Emoji -> Button)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
disabled
                    Parser (ButtonStyle -> Maybe Text -> Maybe Emoji -> Button)
-> Parser ButtonStyle
-> Parser (Maybe Text -> Maybe Emoji -> Button)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ButtonStyle
forall a. FromJSON a => Value -> Parser a
parseJSON (Scientific -> Value
Number Scientific
style)
                    Parser (Maybe Text -> Maybe Emoji -> Button)
-> Parser (Maybe Text) -> Parser (Maybe Emoji -> Button)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
label
                    Parser (Maybe Emoji -> Button)
-> Parser (Maybe Emoji) -> Parser Button
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Emoji -> Parser (Maybe Emoji)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Emoji
partialEmoji
            Int
_ -> String -> Parser Button
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected button type, got a different component"
      )

instance ToJSON Button where
  toJSON :: Button -> Value
toJSON ButtonUrl {Bool
Maybe Text
Maybe Emoji
Text
buttonEmoji :: Maybe Emoji
buttonLabel :: Maybe Text
buttonDisabled :: Bool
buttonUrl :: Text
buttonUrl :: Button -> Text
buttonEmoji :: Button -> Maybe Emoji
buttonLabel :: Button -> Maybe Text
buttonDisabled :: Button -> Bool
..} =
    [Pair] -> Value
object
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2),
              (Text
"style", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
5),
              (Text
"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
buttonLabel),
              (Text
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
buttonDisabled),
              (Text
"url", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
buttonUrl),
              (Text
"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
buttonEmoji)
            ]
      ]
  toJSON Button {Bool
Maybe Text
Maybe Emoji
Text
ButtonStyle
buttonEmoji :: Maybe Emoji
buttonLabel :: Maybe Text
buttonStyle :: ButtonStyle
buttonDisabled :: Bool
buttonCustomId :: Text
buttonEmoji :: Button -> Maybe Emoji
buttonLabel :: Button -> Maybe Text
buttonStyle :: Button -> ButtonStyle
buttonDisabled :: Button -> Bool
buttonCustomId :: Button -> Text
..} =
    [Pair] -> Value
object
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
2),
              (Text
"style", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ButtonStyle -> Value
forall a. ToJSON a => a -> Value
toJSON ButtonStyle
buttonStyle),
              (Text
"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
buttonLabel),
              (Text
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
buttonDisabled),
              (Text
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
buttonCustomId),
              (Text
"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
buttonEmoji)
            ]
      ]

-- | Buttton colors.
data ButtonStyle
  = -- | Blurple button
    ButtonStylePrimary
  | -- | Grey button
    ButtonStyleSecondary
  | -- | Green button
    ButtonStyleSuccess
  | -- | Red button
    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, 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, 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, Eq ButtonStyle
Eq ButtonStyle
-> (ButtonStyle -> ButtonStyle -> Ordering)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> Bool)
-> (ButtonStyle -> ButtonStyle -> ButtonStyle)
-> (ButtonStyle -> ButtonStyle -> ButtonStyle)
-> Ord ButtonStyle
ButtonStyle -> ButtonStyle -> Bool
ButtonStyle -> ButtonStyle -> Ordering
ButtonStyle -> ButtonStyle -> ButtonStyle
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 :: ButtonStyle -> ButtonStyle -> ButtonStyle
$cmin :: ButtonStyle -> ButtonStyle -> ButtonStyle
max :: ButtonStyle -> ButtonStyle -> ButtonStyle
$cmax :: ButtonStyle -> ButtonStyle -> ButtonStyle
>= :: ButtonStyle -> ButtonStyle -> Bool
$c>= :: ButtonStyle -> ButtonStyle -> Bool
> :: ButtonStyle -> ButtonStyle -> Bool
$c> :: ButtonStyle -> ButtonStyle -> Bool
<= :: ButtonStyle -> ButtonStyle -> Bool
$c<= :: ButtonStyle -> ButtonStyle -> Bool
< :: ButtonStyle -> ButtonStyle -> Bool
$c< :: ButtonStyle -> ButtonStyle -> Bool
compare :: ButtonStyle -> ButtonStyle -> Ordering
$ccompare :: ButtonStyle -> ButtonStyle -> Ordering
$cp1Ord :: Eq ButtonStyle
Ord)

instance FromJSON ButtonStyle where
  parseJSON :: Value -> Parser ButtonStyle
parseJSON =
    String
-> (Scientific -> Parser ButtonStyle)
-> Value
-> Parser ButtonStyle
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific
      String
"ButtonStyle"
      ( \case
          Scientific
1 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStylePrimary
          Scientific
2 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleSecondary
          Scientific
3 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleSuccess
          Scientific
4 -> ButtonStyle -> Parser ButtonStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ButtonStyle
ButtonStyleDanger
          Scientific
_ -> String -> Parser ButtonStyle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unrecognised non-url button style"
      )

instance ToJSON ButtonStyle where
  toJSON :: ButtonStyle -> Value
toJSON ButtonStyle
ButtonStylePrimary = Scientific -> Value
Number Scientific
1
  toJSON ButtonStyle
ButtonStyleSecondary = Scientific -> Value
Number Scientific
2
  toJSON ButtonStyle
ButtonStyleSuccess = Scientific -> Value
Number Scientific
3
  toJSON ButtonStyle
ButtonStyleDanger = Scientific -> Value
Number Scientific
4

-- | Component type for a select menu.
--
-- Don't directly send select menus - they need to be within an action row.
data SelectMenu = SelectMenu
  { -- | Dev identifier
    SelectMenu -> Text
selectMenuCustomId :: T.Text,
    -- | Whether the select menu is disabled
    SelectMenu -> Bool
selectMenuDisabled :: Bool,
    -- | What options are in this select menu (up to 25)
    SelectMenu -> [SelectOption]
selectMenuOptions :: [SelectOption],
    -- | Placeholder text if nothing is selected
    SelectMenu -> Maybe Text
selectMenuPlaceholder :: Maybe T.Text,
    -- | Minimum number of values to select (def 1, min 0, max 25)
    SelectMenu -> Maybe Integer
selectMenuMinValues :: Maybe Integer,
    -- | Maximum number of values to select (def 1, max 25)
    SelectMenu -> Maybe Integer
selectMenuMaxValues :: Maybe Integer
  }
  deriving (Int -> SelectMenu -> ShowS
[SelectMenu] -> ShowS
SelectMenu -> String
(Int -> SelectMenu -> ShowS)
-> (SelectMenu -> String)
-> ([SelectMenu] -> ShowS)
-> Show SelectMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectMenu] -> ShowS
$cshowList :: [SelectMenu] -> ShowS
show :: SelectMenu -> String
$cshow :: SelectMenu -> String
showsPrec :: Int -> SelectMenu -> ShowS
$cshowsPrec :: Int -> SelectMenu -> ShowS
Show, ReadPrec [SelectMenu]
ReadPrec SelectMenu
Int -> ReadS SelectMenu
ReadS [SelectMenu]
(Int -> ReadS SelectMenu)
-> ReadS [SelectMenu]
-> ReadPrec SelectMenu
-> ReadPrec [SelectMenu]
-> Read SelectMenu
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelectMenu]
$creadListPrec :: ReadPrec [SelectMenu]
readPrec :: ReadPrec SelectMenu
$creadPrec :: ReadPrec SelectMenu
readList :: ReadS [SelectMenu]
$creadList :: ReadS [SelectMenu]
readsPrec :: Int -> ReadS SelectMenu
$creadsPrec :: Int -> ReadS SelectMenu
Read, SelectMenu -> SelectMenu -> Bool
(SelectMenu -> SelectMenu -> Bool)
-> (SelectMenu -> SelectMenu -> Bool) -> Eq SelectMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectMenu -> SelectMenu -> Bool
$c/= :: SelectMenu -> SelectMenu -> Bool
== :: SelectMenu -> SelectMenu -> Bool
$c== :: SelectMenu -> SelectMenu -> Bool
Eq, Eq SelectMenu
Eq SelectMenu
-> (SelectMenu -> SelectMenu -> Ordering)
-> (SelectMenu -> SelectMenu -> Bool)
-> (SelectMenu -> SelectMenu -> Bool)
-> (SelectMenu -> SelectMenu -> Bool)
-> (SelectMenu -> SelectMenu -> Bool)
-> (SelectMenu -> SelectMenu -> SelectMenu)
-> (SelectMenu -> SelectMenu -> SelectMenu)
-> Ord SelectMenu
SelectMenu -> SelectMenu -> Bool
SelectMenu -> SelectMenu -> Ordering
SelectMenu -> SelectMenu -> SelectMenu
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 :: SelectMenu -> SelectMenu -> SelectMenu
$cmin :: SelectMenu -> SelectMenu -> SelectMenu
max :: SelectMenu -> SelectMenu -> SelectMenu
$cmax :: SelectMenu -> SelectMenu -> SelectMenu
>= :: SelectMenu -> SelectMenu -> Bool
$c>= :: SelectMenu -> SelectMenu -> Bool
> :: SelectMenu -> SelectMenu -> Bool
$c> :: SelectMenu -> SelectMenu -> Bool
<= :: SelectMenu -> SelectMenu -> Bool
$c<= :: SelectMenu -> SelectMenu -> Bool
< :: SelectMenu -> SelectMenu -> Bool
$c< :: SelectMenu -> SelectMenu -> Bool
compare :: SelectMenu -> SelectMenu -> Ordering
$ccompare :: SelectMenu -> SelectMenu -> Ordering
$cp1Ord :: Eq SelectMenu
Ord)

-- | Takes the custom id and the options of the select menu that is to be
-- generated.
mkSelectMenu :: T.Text -> [SelectOption] -> SelectMenu
mkSelectMenu :: Text -> [SelectOption] -> SelectMenu
mkSelectMenu Text
customId [SelectOption]
sos = Text
-> Bool
-> [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> SelectMenu
SelectMenu Text
customId Bool
False [SelectOption]
sos Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

instance FromJSON SelectMenu where
  parseJSON :: Value -> Parser SelectMenu
parseJSON =
    String
-> (Object -> Parser SelectMenu) -> Value -> Parser SelectMenu
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"SelectMenu"
      ( \Object
v ->
          do
            Int
t <- Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
            case Int
t of
              Int
3 ->
                Text
-> Bool
-> [SelectOption]
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> SelectMenu
SelectMenu
                  (Text
 -> Bool
 -> [SelectOption]
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> SelectMenu)
-> Parser Text
-> Parser
     (Bool
      -> [SelectOption]
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> SelectMenu)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"custom_id"
                  Parser
  (Bool
   -> [SelectOption]
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> SelectMenu)
-> Parser Bool
-> Parser
     ([SelectOption]
      -> Maybe Text -> Maybe Integer -> Maybe Integer -> SelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"disabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
                  Parser
  ([SelectOption]
   -> Maybe Text -> Maybe Integer -> Maybe Integer -> SelectMenu)
-> Parser [SelectOption]
-> Parser
     (Maybe Text -> Maybe Integer -> Maybe Integer -> SelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [SelectOption]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"options"
                  Parser (Maybe Text -> Maybe Integer -> Maybe Integer -> SelectMenu)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Integer -> SelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"placeholder"
                  Parser (Maybe Integer -> Maybe Integer -> SelectMenu)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> SelectMenu)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"min_values"
                  Parser (Maybe Integer -> SelectMenu)
-> Parser (Maybe Integer) -> Parser SelectMenu
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"max_values"
              Int
_ -> String -> Parser SelectMenu
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected select menu type, got different component"
      )

instance ToJSON SelectMenu where
  toJSON :: SelectMenu -> Value
toJSON SelectMenu {Bool
[SelectOption]
Maybe Integer
Maybe Text
Text
selectMenuMaxValues :: Maybe Integer
selectMenuMinValues :: Maybe Integer
selectMenuPlaceholder :: Maybe Text
selectMenuOptions :: [SelectOption]
selectMenuDisabled :: Bool
selectMenuCustomId :: Text
selectMenuMaxValues :: SelectMenu -> Maybe Integer
selectMenuMinValues :: SelectMenu -> Maybe Integer
selectMenuPlaceholder :: SelectMenu -> Maybe Text
selectMenuOptions :: SelectMenu -> [SelectOption]
selectMenuDisabled :: SelectMenu -> Bool
selectMenuCustomId :: SelectMenu -> Text
..} =
    [Pair] -> Value
object
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
3),
              (Text
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectMenuCustomId),
              (Text
"disabled", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
selectMenuDisabled),
              (Text
"options", [SelectOption] -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON [SelectOption]
selectMenuOptions),
              (Text
"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
selectMenuPlaceholder),
              (Text
"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
selectMenuMinValues),
              (Text
"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
selectMenuMaxValues)
            ]
      ]

-- | A single option in a select menu.
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, 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, 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)

-- | Make a select option from the given label and value.
mkSelectOption :: T.Text -> T.Text -> SelectOption
mkSelectOption :: Text -> Text -> SelectOption
mkSelectOption Text
label Text
value = Text
-> Text -> Maybe Text -> Maybe Emoji -> Maybe Bool -> SelectOption
SelectOption Text
label Text
value Maybe Text
forall a. Maybe a
Nothing Maybe Emoji
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Emoji)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"label", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionLabel),
              (Text
"value", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
selectOptionValue),
              (Text
"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),
              (Text
"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),
              (Text
"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)
            ]
      ]

data TextInput = TextInput
  { -- | Dev identifier
    TextInput -> Text
textInputCustomId :: T.Text,
    -- | What style to use (short or paragraph)
    TextInput -> Bool
textInputIsParagraph :: Bool,
    -- | The label for this component
    TextInput -> Text
textInputLabel :: T.Text,
    -- | The minimum input length for a text input (0-4000)
    TextInput -> Maybe Integer
textInputMinLength :: Maybe Integer,
    -- | The maximum input length for a text input (1-4000)
    TextInput -> Maybe Integer
textInputMaxLength :: Maybe Integer,
    -- | Whether this component is required to be filled
    TextInput -> Bool
textInputRequired :: Bool,
    -- | The prefilled value for this component (max 4000)
    TextInput -> Text
textInputValue :: T.Text,
    -- | Placeholder text if empty (max 4000)
    TextInput -> Text
textInputPlaceholder :: T.Text
  }
  deriving (Int -> TextInput -> ShowS
[TextInput] -> ShowS
TextInput -> String
(Int -> TextInput -> ShowS)
-> (TextInput -> String)
-> ([TextInput] -> ShowS)
-> Show TextInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextInput] -> ShowS
$cshowList :: [TextInput] -> ShowS
show :: TextInput -> String
$cshow :: TextInput -> String
showsPrec :: Int -> TextInput -> ShowS
$cshowsPrec :: Int -> TextInput -> ShowS
Show, ReadPrec [TextInput]
ReadPrec TextInput
Int -> ReadS TextInput
ReadS [TextInput]
(Int -> ReadS TextInput)
-> ReadS [TextInput]
-> ReadPrec TextInput
-> ReadPrec [TextInput]
-> Read TextInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextInput]
$creadListPrec :: ReadPrec [TextInput]
readPrec :: ReadPrec TextInput
$creadPrec :: ReadPrec TextInput
readList :: ReadS [TextInput]
$creadList :: ReadS [TextInput]
readsPrec :: Int -> ReadS TextInput
$creadsPrec :: Int -> ReadS TextInput
Read, TextInput -> TextInput -> Bool
(TextInput -> TextInput -> Bool)
-> (TextInput -> TextInput -> Bool) -> Eq TextInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextInput -> TextInput -> Bool
$c/= :: TextInput -> TextInput -> Bool
== :: TextInput -> TextInput -> Bool
$c== :: TextInput -> TextInput -> Bool
Eq, Eq TextInput
Eq TextInput
-> (TextInput -> TextInput -> Ordering)
-> (TextInput -> TextInput -> Bool)
-> (TextInput -> TextInput -> Bool)
-> (TextInput -> TextInput -> Bool)
-> (TextInput -> TextInput -> Bool)
-> (TextInput -> TextInput -> TextInput)
-> (TextInput -> TextInput -> TextInput)
-> Ord TextInput
TextInput -> TextInput -> Bool
TextInput -> TextInput -> Ordering
TextInput -> TextInput -> TextInput
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 :: TextInput -> TextInput -> TextInput
$cmin :: TextInput -> TextInput -> TextInput
max :: TextInput -> TextInput -> TextInput
$cmax :: TextInput -> TextInput -> TextInput
>= :: TextInput -> TextInput -> Bool
$c>= :: TextInput -> TextInput -> Bool
> :: TextInput -> TextInput -> Bool
$c> :: TextInput -> TextInput -> Bool
<= :: TextInput -> TextInput -> Bool
$c<= :: TextInput -> TextInput -> Bool
< :: TextInput -> TextInput -> Bool
$c< :: TextInput -> TextInput -> Bool
compare :: TextInput -> TextInput -> Ordering
$ccompare :: TextInput -> TextInput -> Ordering
$cp1Ord :: Eq TextInput
Ord)

instance ToJSON TextInput where
  toJSON :: TextInput -> Value
toJSON TextInput {Bool
Maybe Integer
Text
textInputPlaceholder :: Text
textInputValue :: Text
textInputRequired :: Bool
textInputMaxLength :: Maybe Integer
textInputMinLength :: Maybe Integer
textInputLabel :: Text
textInputIsParagraph :: Bool
textInputCustomId :: Text
textInputPlaceholder :: TextInput -> Text
textInputValue :: TextInput -> Text
textInputRequired :: TextInput -> Bool
textInputMaxLength :: TextInput -> Maybe Integer
textInputMinLength :: TextInput -> Maybe Integer
textInputLabel :: TextInput -> Text
textInputIsParagraph :: TextInput -> Bool
textInputCustomId :: TextInput -> Text
..} =
    [Pair] -> Value
object
      [ (Text
name, Value
value)
        | (Text
name, Just Value
value) <-
            [ (Text
"type", Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Number Scientific
4),
              (Text
"custom_id", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
textInputCustomId),
              (Text
"style", Int -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
textInputIsParagraph)),
              (Text
"label", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
textInputLabel),
              (Text
"min_length", 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
textInputMinLength),
              (Text
"max_length", 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
textInputMaxLength),
              (Text
"required", Bool -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Bool
textInputRequired),
              (Text
"value", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
textInputValue),
              (Text
"placeholder", Text -> Maybe Value
forall a. ToJSON a => a -> Maybe Value
toMaybeJSON Text
textInputPlaceholder)
            ]
      ]

instance FromJSON TextInput where
  parseJSON :: Value -> Parser TextInput
parseJSON = String -> (Object -> Parser TextInput) -> Value -> Parser TextInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextInput" ((Object -> Parser TextInput) -> Value -> Parser TextInput)
-> (Object -> Parser TextInput) -> Value -> Parser TextInput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Int
t <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type" :: Parser Int
    case Int
t of
      Int
4 ->
        Text
-> Bool
-> Text
-> Maybe Integer
-> Maybe Integer
-> Bool
-> Text
-> Text
-> TextInput
TextInput (Text
 -> Bool
 -> Text
 -> Maybe Integer
 -> Maybe Integer
 -> Bool
 -> Text
 -> Text
 -> TextInput)
-> Parser Text
-> Parser
     (Bool
      -> Text
      -> Maybe Integer
      -> Maybe Integer
      -> Bool
      -> Text
      -> Text
      -> TextInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"custom_id"
          Parser
  (Bool
   -> Text
   -> Maybe Integer
   -> Maybe Integer
   -> Bool
   -> Text
   -> Text
   -> TextInput)
-> Parser Bool
-> Parser
     (Text
      -> Maybe Integer
      -> Maybe Integer
      -> Bool
      -> Text
      -> Text
      -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Bool) -> Parser Int -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
2 :: Int)) (Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"style" Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
1)
          Parser
  (Text
   -> Maybe Integer
   -> Maybe Integer
   -> Bool
   -> Text
   -> Text
   -> TextInput)
-> Parser Text
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Bool -> Text -> Text -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"label" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
          Parser
  (Maybe Integer
   -> Maybe Integer -> Bool -> Text -> Text -> TextInput)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Bool -> Text -> Text -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"min_length"
          Parser (Maybe Integer -> Bool -> Text -> Text -> TextInput)
-> Parser (Maybe Integer)
-> Parser (Bool -> Text -> Text -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"max_length"
          Parser (Bool -> Text -> Text -> TextInput)
-> Parser Bool -> Parser (Text -> Text -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"required" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
          Parser (Text -> Text -> TextInput)
-> Parser Text -> Parser (Text -> TextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"value" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
          Parser (Text -> TextInput) -> Parser Text -> Parser TextInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"placeholder" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Int
_ -> String -> Parser TextInput
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected text input, found other type of component"

-- | Create a text input from an id and a label
mkTextInput :: T.Text -> T.Text -> TextInput
mkTextInput :: Text -> Text -> TextInput
mkTextInput Text
cid Text
label = Text
-> Bool
-> Text
-> Maybe Integer
-> Maybe Integer
-> Bool
-> Text
-> Text
-> TextInput
TextInput Text
cid Bool
False Text
label Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Bool
True Text
"" Text
""